From ffe1e71b9964f4721da278c13de0fc4ed2117031 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 14 Feb 2023 12:27:55 +0000 Subject: [PATCH 001/125] Removing Bc-Jet.f90 --- src/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index e4b58ed29..4719ec310 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -20,7 +20,6 @@ add_executable(xcompact3d BC-Channel-flow.f90 BC-Cylinder.f90 BC-dbg-schemes.f90 - BC-Jet.f90 BC-Lock-exchange.f90 BC-Mixing-layer.f90 BC-Periodic-hill.f90 From 9eb5571cfb7818a9d8dfd5a4e036e20d71c1e0d8 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Fri, 15 Sep 2023 14:42:18 +0100 Subject: [PATCH 002/125] added utils for ellipsoids - not functional yet --- .vscode/settings.json | 3 + src/BC-Cylinder.f90 | 22 ++++++-- src/acl_utils.f90 | 127 ++++++++++++++++++++++++++++++++++++++++++ src/genepsi3d.f90 | 1 + 4 files changed, 149 insertions(+), 4 deletions(-) create mode 100644 .vscode/settings.json diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 000000000..63e4335fc --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,3 @@ +{ + "fortran.fortls.disabled": true +} \ No newline at end of file diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index 749a73f3d..5f7740405 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -26,6 +26,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) use param, only : one, two, ten use ibm_param use dbg_schemes, only: sqrt_prec + use actuator_line_model_utils, only: EllipsoidalRadius implicit none @@ -35,9 +36,10 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) real(mytype) :: dx real(mytype) :: remp integer :: i,j,k - real(mytype) :: xm,ym,r,rads2,kcon + real(mytype) :: xm,ym,zm,r,rads2,kcon real(mytype) :: zeromach - real(mytype) :: cexx,ceyy,dist_axi + real(mytype) :: cexx,ceyy,cezz,dist_axi + real(mytype) :: point(3), ce(3), orientation(4), shape(3) zeromach=one do while ((one + zeromach / two) .gt. one) @@ -45,6 +47,10 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) end do zeromach = ten*zeromach + orientation=[1.0, 0.0, 0.0, 0.0] + shape=[1.0, 1.0, 1.0] + + ! Intitialise epsi epsi(:,:,:)=zero @@ -55,23 +61,31 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) if (t.ne.0.) then cexx=cex+ubcx*(t-ifirst*dt) ceyy=cey+ubcy*(t-ifirst*dt) + cezz=cez+ubcz*(t-ifirst*dt) else cexx=cex ceyy=cey + cezz=cez endif + + 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 -! +! do k=nzi,nzf + zm=(real(xstart(3)+k-2,mytype))*dz do j=nyi,nyf ym=yp(j) do i=nxi,nxf xm=real(i-1,mytype)*dx - r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) + point=[xm, ym, zm] + call EllipsoidalRadius(point, ce, orientation, shape, r) + ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) if (r-ra.gt.zeromach) then cycle endif + write(*,*) i, j, k epsi(i,j,k)=remp enddo enddo diff --git a/src/acl_utils.f90 b/src/acl_utils.f90 index a64ccc36d..2175780b2 100644 --- a/src/acl_utils.f90 +++ b/src/acl_utils.f90 @@ -130,6 +130,133 @@ subroutine QuatRot(vx,vy,vz,Theta,Rx,Ry,Rz,Ox,Oy,Oz,vRx,vRy,vRz) end subroutine QuatRot + + + subroutine NormalizeQuaternion(quaternion) + real(mytype), intent(in) :: 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) + + ! Normalize the quaternion + normalizedQuaternion = quaternion / magnitude + + end subroutine NormalizeQuaternion + + subroutine QuaternionConjugate(q) + real(mytype), intent(inout) :: q(4) + + q = [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) + integer :: i + + !translate point to body frame + trans_point = point-centre + + call QuaternionConjugate(orientation) + + !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_prec(scaled_point(1)**two+scaled_point(2)**two+scaled_point(3)**two) + + 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, velocity) + real(mytype), intent(in) :: point(3), center(3), angularVelocity(3) + real(mytype), intent(out) :: velocity(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(angularVelocity, distance, crossed) + + ! Calculate the velocity at the point + velocity = crossed + end subroutine CalculatePointVelocity + + + + ! subroutine CalculatePointVelocity(point, center, angularVelocity, velocity) + ! real(mytype), intent(in) :: point(3), center(3), angularVelocity(3) + ! real(mytype), intent(out) :: velocity(3) + ! real(mytype) :: distance(3) + ! real(mytype) :: crossProduct(3) + + + ! ! Compute the distance vector from the center to the point + ! distance = point - center + + ! ! Compute the cross product of angular velocity and distance vector + ! call CrossProduct(angularVelocity, distance, crossProduct) + + ! ! Calculate the velocity at the point + ! velocity = crossProduct + ! end subroutine CalculatePointVelocity + + !******************************************************************************* ! subroutine IDW(Ncol,Xcol,Ycol,Zcol,Fxcol,Fycol,Fzcol,p,Xmesh,Ymesh,Zmesh,Fxmesh,Fymesh,Fzmesh) diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index e043bffcf..f5fe56117 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -189,6 +189,7 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& integer :: numvis integer :: mpi_aux_i, code + write(*,*)'Inside gene_epsi_3D' !x-pencil ep1=zero call geomcomplex(ep1,xstart(1),xend(1),ny,xstart(2),xend(2),xstart(3),xend(3),dx,yp,dz,one) From 69a938137f22a946425797f0282881be111dfc59 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Sun, 17 Sep 2023 12:56:13 +0100 Subject: [PATCH 003/125] changing boundary conditions to be variable - x component done --- Makefile | 2 +- src/BC-Cylinder.f90 | 6 +++--- src/acl_utils.f90 | 24 +++++++++++++----------- src/derive.f90 | 20 ++++++++++---------- src/filters.f90 | 10 +++++----- src/ibm.f90 | 38 +++++++++++++++++++++++++++++++++++--- src/transeq.f90 | 30 +++++++++++++++--------------- 7 files changed, 82 insertions(+), 48 deletions(-) diff --git a/Makefile b/Makefile index 5ee4824cd..faee0029c 100644 --- a/Makefile +++ b/Makefile @@ -55,7 +55,7 @@ SRCDECOMP = $(DECOMPDIR)/decomp_2d.f90 $(DECOMPDIR)/glassman.f90 $(DECOMPDIR)/ff 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 $(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-Mixing-layer.f90 $(SRCDIR)/BC-Sandbox.f90 $(SRCDIR)/BC-Uniform.f90 $(SRCDIR)/BC-Cavity.f90 $(TURBDIR)/constants.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 +SRC = $(SRCDIR)/module_param.f90 $(SRCDIR)/variables.f90 $(SRCDIR)/BC-dbg-schemes.f90 $(TURBDIR)/constants.f90 $(TURBDIR)/acl_utils.f90 $(SRCDIR)/poisson.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-Mixing-layer.f90 $(SRCDIR)/BC-Sandbox.f90 $(SRCDIR)/BC-Uniform.f90 $(SRCDIR)/BC-Cavity.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########## diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index 5f7740405..5e17cd444 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -26,7 +26,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) use param, only : one, two, ten use ibm_param use dbg_schemes, only: sqrt_prec - use actuator_line_model_utils, only: EllipsoidalRadius + ! use actuator_line_model_utils, only: EllipsoidalRadius implicit none @@ -80,8 +80,8 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) do i=nxi,nxf xm=real(i-1,mytype)*dx point=[xm, ym, zm] - call EllipsoidalRadius(point, ce, orientation, shape, r) - ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) + ! call EllipsoidalRadius(point, ce, orientation, shape, r) + r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) if (r-ra.gt.zeromach) then cycle endif diff --git a/src/acl_utils.f90 b/src/acl_utils.f90 index 2175780b2..f449173b1 100644 --- a/src/acl_utils.f90 +++ b/src/acl_utils.f90 @@ -9,7 +9,7 @@ module actuator_line_model_utils use dbg_schemes, only: sqrt_prec, cos_prec, exp_prec, sin_prec implicit none - public QuatRot, cross, IsoKernel, AnIsoKernel, int2str + public QuatRot, cross, IsoKernel, AnIsoKernel, int2str, EllipsoidalRadius contains @@ -145,10 +145,11 @@ subroutine NormalizeQuaternion(quaternion) end subroutine NormalizeQuaternion - subroutine QuaternionConjugate(q) - real(mytype), intent(inout) :: q(4) + subroutine QuaternionConjugate(q,q_c) + real(mytype), intent(in) :: q(4) + real(mytype), intent(out):: q_c(4) - q = [q(1), -q(2), -q(3), -q(4)] + q_c = [q(1), -q(2), -q(3), -q(4)] end subroutine @@ -189,16 +190,16 @@ 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) + 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) + call QuaternionConjugate(orientation,orientation_c) !rotate point into body frame (using inverse(conjugate) of orientation) - call RotatePoint(trans_point, orientation, rotated_point) + call RotatePoint(trans_point, orientation_c, rotated_point) do i = 1,3 scaled_point(i)=rotated_point(i)/shape(i) @@ -221,8 +222,8 @@ subroutine CrossProduct(a, b, result) result(3) = a(1) * b(2) - a(2) * b(1) end subroutine CrossProduct - subroutine CalculatePointVelocity(point, center, angularVelocity, velocity) - real(mytype), intent(in) :: point(3), center(3), angularVelocity(3) + subroutine CalculatePointVelocity(point, center, angularVelocity, linearVelocity, velocity) + real(mytype), intent(in) :: point(3), center(3), angularVelocity(3), linearVelocity(3) real(mytype), intent(out) :: velocity(3) real(mytype) :: crossed(3) ! Compute the distance vector from the center to the point @@ -232,9 +233,10 @@ subroutine CalculatePointVelocity(point, center, angularVelocity, velocity) ! Compute the cross product of angular velocity and distance vector call CrossProduct(angularVelocity, distance, crossed) - + ! Calculate the velocity at the point - velocity = crossed + velocity = crossed + linearVelocity + end subroutine CalculatePointVelocity diff --git a/src/derive.f90 b/src/derive.f90 index 5ba54cddc..dc5c0b88d 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) @@ -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) diff --git a/src/filters.f90 b/src/filters.f90 index d71e96fe0..61caaa146 100644 --- a/src/filters.f90 +++ b/src/filters.f90 @@ -229,7 +229,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) @@ -300,7 +300,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) @@ -392,7 +392,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) @@ -478,7 +478,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) @@ -566,7 +566,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) diff --git a/src/ibm.f90 b/src/ibm.f90 index 7f05a985d..edf48f08c 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -401,6 +401,7 @@ subroutine cubsplx(u,lind) USE decomp_2d USE variables USE ibm_param + USE actuator_line_model_utils ! implicit none ! @@ -413,24 +414,29 @@ 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 ! 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),centre(3),angularVelocity(3),linearVelocity(3),pointVelocity(3) + real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv ! ! Initialise Arrays xa(:)=0. ya(:)=0. ! ! Impose the Correct BC - bcimp=lind +! bcimp=lind ! do k=1,xsize(3) + zm=real(xstart(3)+k-2,mytype)*dz do j=1,xsize(2) + ym=real(xstart(2)+j-2,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. + xm=real(xstart(1)+i-2,mytype)*dx nxpif=npif ia=ia+1 if (ianal.eq.0) then @@ -440,6 +446,32 @@ 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(point, centre, angularVelocity, linearVelocity, pointVelocity) + vx=pointVelocity(1) + vy=pointVelocity(2) + vz=pointVelocity(3) + if (lind.eq.0) then + bcimp=zero + elseif (lind.eq.1) then + bcimp=x_pv + 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 ya(ia)=bcimp if(xi(i,j,k).gt.0.)then ! Immersed Object inxi=0 diff --git a/src/transeq.f90 b/src/transeq.f90 index 593b6608b..292e05ea3 100644 --- a/src/transeq.f90 +++ b/src/transeq.f90 @@ -114,12 +114,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 ', dep1 #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)) @@ -146,7 +146,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(:,:,:) @@ -643,10 +643,10 @@ subroutine momentum_full_viscstress_tensor(dux1, duy1, duz1, divu3, mu1) 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(:,:,:) @@ -703,8 +703,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(:,:,:) @@ -1145,7 +1145,7 @@ subroutine scalar_settling(dphi1, phi1, is) 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 @@ -1216,7 +1216,7 @@ subroutine continuity_rhs_eq(drho1, rho1, ux1, divu3) 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 From 12dcff6af62a08599c1d35deff6f9055b56f7895 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Mon, 18 Sep 2023 11:30:33 +0100 Subject: [PATCH 004/125] minor bug fix --- src/ibm.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/ibm.f90 b/src/ibm.f90 index edf48f08c..c7a56b688 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -448,9 +448,9 @@ subroutine cubsplx(u,lind) endif point=[xm,ym,zm] call CalculatePointVelocity(point, centre, angularVelocity, linearVelocity, pointVelocity) - vx=pointVelocity(1) - vy=pointVelocity(2) - vz=pointVelocity(3) + x_pv=pointVelocity(1) + y_pv=pointVelocity(2) + z_pv=pointVelocity(3) if (lind.eq.0) then bcimp=zero elseif (lind.eq.1) then From 3964fa3ba3fba092ffcd7a2e552fa8a740101563 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Mon, 18 Sep 2023 22:58:29 +0100 Subject: [PATCH 005/125] ellip_utils added --- Makefile | 2 +- src/BC-Cylinder.f90 | 18 +- src/acl_utils.f90 | 125 +----------- src/ellip_utils.f90 | 460 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 474 insertions(+), 131 deletions(-) create mode 100644 src/ellip_utils.f90 diff --git a/Makefile b/Makefile index 5ee4824cd..970e36471 100644 --- a/Makefile +++ b/Makefile @@ -55,7 +55,7 @@ SRCDECOMP = $(DECOMPDIR)/decomp_2d.f90 $(DECOMPDIR)/glassman.f90 $(DECOMPDIR)/ff 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 $(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-Mixing-layer.f90 $(SRCDIR)/BC-Sandbox.f90 $(SRCDIR)/BC-Uniform.f90 $(SRCDIR)/BC-Cavity.f90 $(TURBDIR)/constants.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 +SRC = $(SRCDIR)/module_param.f90 $(SRCDIR)/variables.f90 $(SRCDIR)/BC-dbg-schemes.f90 $(SRCDIR)/poisson.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-Mixing-layer.f90 $(SRCDIR)/BC-Sandbox.f90 $(SRCDIR)/BC-Uniform.f90 $(SRCDIR)/BC-Cavity.f90 $(TURBDIR)/constants.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########## diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index 5f7740405..f126b867d 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -26,7 +26,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) use param, only : one, two, ten use ibm_param use dbg_schemes, only: sqrt_prec - use actuator_line_model_utils, only: EllipsoidalRadius + use ellipsoid_utils, only: EllipsoidalRadius, NormalizeQuaternion implicit none @@ -39,7 +39,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) real(mytype) :: xm,ym,zm,r,rads2,kcon real(mytype) :: zeromach real(mytype) :: cexx,ceyy,cezz,dist_axi - real(mytype) :: point(3), ce(3), orientation(4), shape(3) + real(mytype) :: point(3), ce(3), orientation(4), orientation_normalized(4),shape(3) zeromach=one do while ((one + zeromach / two) .gt. one) @@ -47,7 +47,8 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) end do zeromach = ten*zeromach - orientation=[1.0, 0.0, 0.0, 0.0] + orientation=[1.0, -1.0, 1.0, 0.0] + call NormalizeQuaternion(orientation) shape=[1.0, 1.0, 1.0] @@ -72,9 +73,10 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) ! ! 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(xstart(3)+k-2,mytype))*dz + zm=(real(k-1,mytype))*dz + ! write(*,*) k, zm do j=nyi,nyf ym=yp(j) do i=nxi,nxf @@ -82,11 +84,15 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) point=[xm, ym, zm] call EllipsoidalRadius(point, ce, orientation, shape, r) ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) + ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) + if (r-ra.gt.zeromach) then + ! write(*,*) i, j, k cycle endif - write(*,*) i, j, k + ! write(*,*) i, j, k, zm epsi(i,j,k)=remp + ! write(*,*) remp enddo enddo enddo diff --git a/src/acl_utils.f90 b/src/acl_utils.f90 index 2175780b2..7ba461c30 100644 --- a/src/acl_utils.f90 +++ b/src/acl_utils.f90 @@ -132,130 +132,7 @@ end subroutine QuatRot - subroutine NormalizeQuaternion(quaternion) - real(mytype), intent(in) :: 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) - - ! Normalize the quaternion - normalizedQuaternion = quaternion / magnitude - - end subroutine NormalizeQuaternion - - subroutine QuaternionConjugate(q) - real(mytype), intent(inout) :: q(4) - - q = [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) - integer :: i - - !translate point to body frame - trans_point = point-centre - - call QuaternionConjugate(orientation) - - !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_prec(scaled_point(1)**two+scaled_point(2)**two+scaled_point(3)**two) - - 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, velocity) - real(mytype), intent(in) :: point(3), center(3), angularVelocity(3) - real(mytype), intent(out) :: velocity(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(angularVelocity, distance, crossed) - - ! Calculate the velocity at the point - velocity = crossed - end subroutine CalculatePointVelocity - - - - ! subroutine CalculatePointVelocity(point, center, angularVelocity, velocity) - ! real(mytype), intent(in) :: point(3), center(3), angularVelocity(3) - ! real(mytype), intent(out) :: velocity(3) - ! real(mytype) :: distance(3) - ! real(mytype) :: crossProduct(3) - - - ! ! Compute the distance vector from the center to the point - ! distance = point - center - - ! ! Compute the cross product of angular velocity and distance vector - ! call CrossProduct(angularVelocity, distance, crossProduct) - - ! ! Calculate the velocity at the point - ! velocity = crossProduct - ! end subroutine CalculatePointVelocity - + !******************************************************************************* ! diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 new file mode 100644 index 000000000..dad925f1c --- /dev/null +++ b/src/ellip_utils.f90 @@ -0,0 +1,460 @@ +!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 + + 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(in) :: 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) + + ! Normalize the quaternion + normalizedQuaternion = quaternion / magnitude + + end subroutine NormalizeQuaternion + + 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_prec(scaled_point(1)**two+scaled_point(2)**two+scaled_point(3)**two) + + 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, linearVelocity, angularVelocity, velocity) + real(mytype), intent(in) :: point(3), center(3), linearVelocity(3), angularVelocity(3) + real(mytype), intent(out) :: velocity(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(angularVelocity, distance, crossed) + + ! Calculate the velocity at the point + velocity = crossed + linearVelocity + end subroutine CalculatePointVelocity + + + + ! subroutine CalculatePointVelocity(point, center, angularVelocity, velocity) + ! real(mytype), intent(in) :: point(3), center(3), angularVelocity(3) + ! real(mytype), intent(out) :: velocity(3) + ! real(mytype) :: distance(3) + ! real(mytype) :: crossProduct(3) + + + ! ! Compute the distance vector from the center to the point + ! distance = point - center + + ! ! Compute the cross product of angular velocity and distance vector + ! call CrossProduct(angularVelocity, distance, crossProduct) + + ! ! Calculate the velocity at the point + ! velocity = crossProduct + ! end subroutine CalculatePointVelocity + + + ! !******************************************************************************* + ! ! + ! subroutine IDW(Ncol,Xcol,Ycol,Zcol,Fxcol,Fycol,Fzcol,p,Xmesh,Ymesh,Zmesh,Fxmesh,Fymesh,Fzmesh) + ! ! + ! !******************************************************************************* + + ! implicit none + ! integer, intent(in) :: Ncol + ! real(mytype), dimension(Ncol), intent(in) :: Xcol,Ycol,Zcol,Fxcol,Fycol,Fzcol + ! real(mytype), intent(in) :: Xmesh,Ymesh,Zmesh + ! integer,intent(in) :: p + ! real(mytype), intent(inout) :: Fxmesh,Fymesh,Fzmesh + ! real(mytype), dimension(Ncol) :: d(Ncol), w(Ncol) + ! real(mytype) :: wsum + ! integer :: i,imin + + ! wsum=zero + ! do i=1,Ncol + ! d(i)=sqrt_prec((Xcol(i)-Xmesh)**2+(Ycol(i)-Ymesh)**2+(Zcol(i)-Zmesh)**2) + ! w(i)=one/d(i)**p + ! wsum=wsum+w(i) + ! enddo + + ! if (minval(d)<0.001_mytype) then + ! imin=minloc(d,1) + ! Fxmesh=Fxcol(imin) + ! Fymesh=Fycol(imin) + ! Fzmesh=Fzcol(imin) + ! else + ! Fxmesh=zero + ! Fymesh=zero + ! Fzmesh=zero + ! do i=1,Ncol + ! Fxmesh=Fxmesh+w(i)*Fxcol(i)/wsum + ! Fymesh=Fymesh+w(i)*Fycol(i)/wsum + ! Fzmesh=Fzmesh+w(i)*Fzcol(i)/wsum + ! enddo + ! endif + + ! end subroutine IDW + + ! !******************************************************************************* + ! ! + ! real(mytype) function IsoKernel(dr,epsilon_par,dim) + ! ! + ! !******************************************************************************* + + ! use constants + + ! implicit none + ! integer, intent(in) :: dim + ! real(mytype), intent(in) :: dr, epsilon_par + + ! if (dim==2) then + ! IsoKernel = one/(epsilon_par**2*pi)*exp_prec(-(dr/epsilon_par)**2.0) + ! else if (dim==3) then + ! IsoKernel = one/(epsilon_par**3.0*pi**1.5)*exp_prec(-(dr/epsilon_par)**2.0) + ! else + ! write(*,*) "1D source not implemented" + ! stop + ! endif + + ! end function IsoKernel + + ! !******************************************************************************* + ! ! + ! real(mytype) function AnIsoKernel(dx,dy,dz,nx,ny,nz,tx,ty,tz,sx,sy,sz,ec,et,es) + ! ! + ! !******************************************************************************* + + ! use constants + + ! implicit none + ! real(mytype), intent(in) :: dx,dy,dz,nx,ny,nz,tx,ty,tz,sx,sy,sz,ec,et,es + ! real(mytype) :: n,t,s + + ! n=dx*nx+dy*ny+dz*nz ! normal projection + ! t=dx*tx+dy*ty+dz*tz ! Chordwise projection + ! s=dx*sx+dy*sy+dz*sz ! Spanwise projection + + ! if (abs(s)<=es) then + ! AnIsoKernel = exp_prec(-((n/et)**2.0+(t/ec)**2.0))/(ec*et*pi) + ! else + ! AnIsoKernel = zero + ! endif + + ! end function AnIsoKernel + + ! !******************************************************************************* + ! ! + ! integer function FindMinimum(x,Start,End) + ! ! + ! !******************************************************************************* + + ! implicit none + ! integer, dimension(1:), intent(in) :: x + ! integer, intent(in) :: Start, End + ! integer :: Minimum + ! integer :: Location + ! integer :: i + + ! minimum = x(start) + ! Location = Start + ! do i=start+1,End + ! if (x(i) < Minimum) then + ! Minimum = x(i) + ! Location = i + ! endif + ! enddo + ! FindMinimum = Location + + ! end function FindMinimum + + ! !******************************************************************************* + ! ! + ! subroutine swap(a,b) + ! ! + ! !******************************************************************************* + + ! implicit none + ! integer, intent(inout) :: a,b + ! integer :: Temp + + ! Temp = a + ! a = b + ! b = Temp + + ! end subroutine swap + + ! !******************************************************************************* + ! ! + ! subroutine sort(x,size) + ! ! + ! !******************************************************************************* + + ! implicit none + ! integer, dimension(1:), intent(inout) :: x + ! integer, intent(in) :: size + ! integer :: i + ! integer :: Location + + ! do i=1,Size-1 + ! location=FindMinimum(x,i,size) + ! call swap(x(i),x(Location)) + ! enddo + + ! end subroutine sort + + ! !******************************************************************************* + ! ! + ! function dirname(number) + ! ! + ! !******************************************************************************* + + ! integer, intent(in) :: number + ! character(len=6) :: dirname + + ! ! Cast the (rounded) number to string using 6 digits and leading zeros + ! write (dirname, '(I6.1)') number + ! ! This is the same w/o leading zeros + ! !write (dirname, '(I6)') nint(number) + ! ! This is for one digit (no rounding) + ! !write (dirname, '(F4.1)') number + + ! end function dirname + + ! !******************************************************************************* + ! ! + ! function outdirname(number) + ! ! + ! !******************************************************************************* + + ! integer, intent(in) :: number + ! character(len=6) :: outdirname + + ! ! Cast the (rounded) number to string using 6 digits and leading zeros + ! write (outdirname, '(I6.1)') number + ! ! This is the same w/o leading zeros + ! !write (dirname, '(I6)') nint(number) + ! ! This is for one digit (no rounding) + ! !write (dirname, '(F4.1)') number + + ! end function outdirname + + ! !******************************************************************************* + ! ! + ! character(20) function int2str(num) + ! ! + ! !******************************************************************************* + + ! integer, intent(in) ::num + ! character(20) :: str + + ! ! convert integer to string using formatted write + ! write(str, '(i20)') num + ! int2str = adjustl(str) + + ! end function int2str + +end module ellipsoid_utils From 8d3f2cd8699c14e7d66563cb1a0466825a430fd5 Mon Sep 17 00:00:00 2001 From: adfboyd Date: Tue, 19 Sep 2023 17:19:55 +0200 Subject: [PATCH 006/125] adding y component --- src/BC-dbg-schemes.f90 | 32 +++++++++++++++--------------- src/derive.f90 | 20 +++++++++---------- src/ibm.f90 | 44 ++++++++++++++++++++++++++++++++++++------ src/module_param.f90 | 2 +- src/transeq.f90 | 22 ++++++++++----------- src/visu.f90 | 2 ++ 6 files changed, 78 insertions(+), 44 deletions(-) diff --git a/src/BC-dbg-schemes.f90 b/src/BC-dbg-schemes.f90 index af4272ff1..296d6aa70 100644 --- a/src/BC-dbg-schemes.f90 +++ b/src/BC-dbg-schemes.f90 @@ -411,10 +411,10 @@ subroutine debug_schemes() enddo enddo enddo - call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,zero) - call derx (dfdxp1,fxp1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,zero) - call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,zero) - call derxx (dfdxxp1,fxp1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,zero) + 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') @@ -692,8 +692,8 @@ subroutine debug_schemes() enddo enddo enddo - call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,zero) - call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,zero) + 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') @@ -847,10 +847,10 @@ subroutine debug_schemes() enddo enddo enddo - call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,zero) - call derx (dfdxp1,fxp1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,zero) - call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,zero) - call derxx (dfdxxp1,fxp1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,zero) + 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') @@ -1016,10 +1016,10 @@ subroutine debug_schemes() enddo enddo enddo - call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,zero) - call derx (dfdxp1,fxp1,di1,sx,ffxp,fsxp,fwxp,xsize(1),xsize(2),xsize(3),1,zero) - call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,zero) - call derxx (dfdxxp1,fxp1,di1,sx,sfxp,ssxp,swxp,xsize(1),xsize(2),xsize(3),1,zero) + 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') @@ -1211,8 +1211,8 @@ subroutine debug_schemes() enddo enddo enddo - call derx (dfdx1 ,fx1 ,di1,sx,ffx ,fsx ,fwx ,xsize(1),xsize(2),xsize(3),0,zero) - call derxx (dfdxx1 ,fx1 ,di1,sx,sfx ,ssx ,swx ,xsize(1),xsize(2),xsize(3),0,zero) + 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') diff --git a/src/derive.f90 b/src/derive.f90 index dc5c0b88d..77257f0a5 100644 --- a/src/derive.f90 +++ b/src/derive.f90 @@ -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) @@ -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) diff --git a/src/ibm.f90 b/src/ibm.f90 index edf48f08c..f30eaa576 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -12,6 +12,7 @@ subroutine corgp_IBM (ux,uy,uz,px,py,pz,nlock) USE param USE decomp_2d USE variables + USE actuator_line_model_utils, ONLY: CalculatePointVelocity implicit none integer :: i,j,k,nlock real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ux,uy,uz,px,py,pz @@ -448,9 +449,9 @@ subroutine cubsplx(u,lind) endif point=[xm,ym,zm] call CalculatePointVelocity(point, centre, angularVelocity, linearVelocity, pointVelocity) - vx=pointVelocity(1) - vy=pointVelocity(2) - vz=pointVelocity(3) + x_pv=pointVelocity(1) + y_pv=pointVelocity(2) + z_pv=pointVelocity(3) if (lind.eq.0) then bcimp=zero elseif (lind.eq.1) then @@ -603,23 +604,28 @@ 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 ! Identifying which BC to Impose real(mytype) :: bcimp ! Imposed BC integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf + real(mytype) :: point(3),centre(3),angularVelocity(3),linearVelocity(3),pointVelocity(3) + real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv ! ! Initialise Arrays xa(:)=0. ya(:)=0. ! ! Impose the Correct BC - bcimp=lind +! bcimp=lind ! do k=1,ysize(3) + zm=real(ystart(3)+k-2,mytype)*dz do i=1,ysize(1) + xm=real(ystart(1)+i-2,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 @@ -630,6 +636,32 @@ 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 + point=[xm,ym,zm] + call CalculatePointVelocity(point, centre, angularVelocity, linearVelocity, pointVelocity) + 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=x_pv + 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 ya(ia)=bcimp if(yi(j,i,k).gt.0.)then ! Immersed Object jy=1 diff --git a/src/module_param.f90 b/src/module_param.f90 index 49b0303cb..5836eba92 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -134,7 +134,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, only : mytype diff --git a/src/transeq.f90 b/src/transeq.f90 index 292e05ea3..0a50997d5 100644 --- a/src/transeq.f90 +++ b/src/transeq.f90 @@ -431,9 +431,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(:,:,:) @@ -636,7 +636,7 @@ subroutine momentum_full_viscstress_tensor(dux1, duy1, duz1, divu3, mu1) 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(:,:,:) @@ -908,11 +908,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(:,:,:) @@ -925,9 +925,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 @@ -1229,7 +1229,7 @@ subroutine continuity_rhs_eq(drho1, rho1, ux1, divu3) 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/visu.f90 b/src/visu.f90 index eae46ecdb..a38c82ea5 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -235,6 +235,8 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) call write_field(ux1, ".", "ux", num) call write_field(uy1, ".", "uy", num) call write_field(uz1, ".", "uz", num) + call write_field(ep1, ".", "ep1", num, skip_ibm = .true.) + ! Interpolate pressure !WORK Z-PENCILS From fc46de707dfd100afedbc56feca44022dcc3c508 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Tue, 19 Sep 2023 16:55:22 +0100 Subject: [PATCH 007/125] adding visualisation file epsilon support --- src/BC-Cylinder.f90 | 2 +- src/visu.f90 | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index f126b867d..77efcb6d8 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -49,7 +49,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) orientation=[1.0, -1.0, 1.0, 0.0] call NormalizeQuaternion(orientation) - shape=[1.0, 1.0, 1.0] + shape=[1.0, 0.6, 0.4] ! Intitialise epsi diff --git a/src/visu.f90 b/src/visu.f90 index eae46ecdb..d86610642 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -235,6 +235,8 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) call write_field(ux1, ".", "ux", num) call write_field(uy1, ".", "uy", num) call write_field(uz1, ".", "uz", num) + call write_field(ep1, ".", "ep1", num, skip_ibm = .true.) + ! Interpolate pressure !WORK Z-PENCILS From e0cd6e35308005964f2fb80bc70ad602d99677b2 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Tue, 19 Sep 2023 17:46:20 +0100 Subject: [PATCH 008/125] traced through type change of lind everywhere --- src/BC-ABL.f90 | 12 +-- src/BC-Channel-flow.f90 | 18 ++-- src/BC-Cylinder.f90 | 18 ++-- src/BC-Lock-exchange.f90 | 32 +++--- src/BC-Sandbox.f90 | 2 +- src/BC-TBL.f90 | 18 ++-- src/BC-TGV.f90 | 54 +++++------ src/BC-Uniform.f90 | 18 ++-- src/BC-dbg-schemes.f90 | 124 ++++++++++++------------ src/derive.f90 | 20 ++-- src/filters.f90 | 20 ++-- src/forces.f90 | 8 +- src/ibm.f90 | 34 ++++++- src/implicit.f90 | 12 +-- src/les_models.f90 | 204 +++++++++++++++++++-------------------- src/module_param.f90 | 12 +-- src/navier.f90 | 18 ++-- src/probes.f90 | 30 +++--- src/tools.f90 | 18 ++-- src/transeq.f90 | 116 +++++++++++----------- 20 files changed, 410 insertions(+), 378 deletions(-) diff --git a/src/BC-ABL.f90 b/src/BC-ABL.f90 index 23d6c13a5..b3961568c 100644 --- a/src/BC-ABL.f90 +++ b/src/BC-ABL.f90 @@ -310,24 +310,24 @@ subroutine wall_sgs(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 diff --git a/src/BC-Channel-flow.f90 b/src/BC-Channel-flow.f90 index c3419fd6e..02633f883 100644 --- a/src/BC-Channel-flow.f90 +++ b/src/BC-Channel-flow.f90 @@ -406,17 +406,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/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index 5e17cd444..b6a589c99 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -368,17 +368,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 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/BC-Lock-exchange.f90 b/src/BC-Lock-exchange.f90 index 39684385b..ef79e3583 100644 --- a/src/BC-Lock-exchange.f90 +++ b/src/BC-Lock-exchange.f90 @@ -429,23 +429,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) @@ -500,21 +500,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) @@ -536,16 +536,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/BC-Sandbox.f90 b/src/BC-Sandbox.f90 index 917d424b5..a60ef723f 100644 --- a/src/BC-Sandbox.f90 +++ b/src/BC-Sandbox.f90 @@ -177,7 +177,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/BC-TBL.f90 b/src/BC-TBL.f90 index 9cd7f9176..300777a4c 100644 --- a/src/BC-TBL.f90 +++ b/src/BC-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/BC-TGV.f90 b/src/BC-TGV.f90 index f0963365c..dc8dfc4ad 100644 --- a/src/BC-TGV.f90 +++ b/src/BC-TGV.f90 @@ -284,17 +284,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) @@ -355,17 +355,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) @@ -465,17 +465,17 @@ subroutine visu_tgv(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/BC-Uniform.f90 b/src/BC-Uniform.f90 index 8c1c0809f..2604be545 100644 --- a/src/BC-Uniform.f90 +++ b/src/BC-Uniform.f90 @@ -294,17 +294,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/BC-dbg-schemes.f90 b/src/BC-dbg-schemes.f90 index 296d6aa70..c208f8435 100644 --- a/src/BC-dbg-schemes.f90 +++ b/src/BC-dbg-schemes.f90 @@ -479,8 +479,8 @@ subroutine debug_schemes() enddo enddo - call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,zero) - call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) + 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') @@ -502,11 +502,11 @@ subroutine debug_schemes() enddo enddo enddo - call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,zero) - call dery (dfdyp2,fyp2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,zero) + 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,zero) - call deryy (dfdyyp2,fyp2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,zero) + 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 @@ -571,8 +571,8 @@ subroutine debug_schemes() enddo enddo - call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,zero) - call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) + 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') @@ -594,10 +594,10 @@ subroutine debug_schemes() enddo enddo enddo - call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,zero) - call derz (dfdzp3,fzp3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,zero) - call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,zero) - call derzz (dfdzzp3,fzp3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,zero) + 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') @@ -659,8 +659,8 @@ subroutine debug_schemes() enddo enddo enddo - call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,zero) - call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) + 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') @@ -719,8 +719,8 @@ subroutine debug_schemes() enddo enddo - call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,zero) - call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) + 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') @@ -741,9 +741,9 @@ subroutine debug_schemes() enddo enddo enddo - call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,zero) + 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,zero) + 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 @@ -768,8 +768,8 @@ subroutine debug_schemes() enddo enddo - call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,zero) - call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) + 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') @@ -789,8 +789,8 @@ subroutine debug_schemes() enddo enddo enddo - call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,zero) - call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,zero) + 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') @@ -813,8 +813,8 @@ subroutine debug_schemes() enddo enddo enddo - call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,zero) - call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) + 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') @@ -877,8 +877,8 @@ subroutine debug_schemes() enddo enddo - call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,zero) - call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) + 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') @@ -900,11 +900,11 @@ subroutine debug_schemes() enddo enddo enddo - call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,zero) - call dery (dfdyp2,fyp2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,zero) + 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,zero) - call deryy (dfdyyp2,fyp2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,zero) + 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 @@ -931,8 +931,8 @@ subroutine debug_schemes() enddo enddo - call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,zero) - call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) + 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') @@ -954,10 +954,10 @@ subroutine debug_schemes() enddo enddo enddo - call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,zero) - call derz (dfdzp3,fzp3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,zero) - call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,zero) - call derzz (dfdzzp3,fzp3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,zero) + 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') @@ -982,8 +982,8 @@ subroutine debug_schemes() enddo enddo enddo - call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,zero) - call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) + 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') @@ -1046,8 +1046,8 @@ subroutine debug_schemes() enddo enddo - call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,zero) - call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) + 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') @@ -1069,11 +1069,11 @@ subroutine debug_schemes() enddo enddo enddo - call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,zero) - call dery (dfdyp2,fyp2,di2,sy,ffyp,fsyp,fwyp,ppy,ysize(1),ysize(2),ysize(3),1,zero) + 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,zero) - call deryy (dfdyyp2,fyp2,di2,sy,sfyp,ssyp,swyp,ysize(1),ysize(2),ysize(3),1,zero) + 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 @@ -1100,8 +1100,8 @@ subroutine debug_schemes() enddo enddo - call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,zero) - call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) + 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') @@ -1123,10 +1123,10 @@ subroutine debug_schemes() enddo enddo enddo - call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,zero) - call derz (dfdzp3,fzp3,di3,sz,ffzp,fszp,fwzp,zsize(1),zsize(2),zsize(3),1,zero) - call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,zero) - call derzz (dfdzzp3,fzp3,di3,sz,sfzp,sszp,swzp,zsize(1),zsize(2),zsize(3),1,zero) + 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') @@ -1151,8 +1151,8 @@ subroutine debug_schemes() enddo enddo enddo - call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,zero) - call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) + 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') @@ -1274,8 +1274,8 @@ subroutine debug_schemes() enddo enddo - call filx (fiffx1 ,ffx1 ,di1,fisx,fiffx ,fifsx ,fifwx ,xsize(1),xsize(2),xsize(3),0,zero) - call filx (fiffxp1 ,ffxp1 ,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,zero) + 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') @@ -1297,9 +1297,9 @@ subroutine debug_schemes() enddo enddo enddo - call dery (dfdy2 ,fy2 ,di2,sy,ffy ,fsy ,fwy ,ppy,ysize(1),ysize(2),ysize(3),0,zero) + 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,zero) + 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 @@ -1361,8 +1361,8 @@ subroutine debug_schemes() enddo enddo - call fily (fiffy2 ,ffy2 ,di2,fisy,fiffy ,fifsy ,fifwy ,ysize(1),ysize(2),ysize(3),0,zero) - call fily (fiffyp2 ,ffyp2 ,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,zero) + 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') @@ -1383,8 +1383,8 @@ subroutine debug_schemes() enddo enddo enddo - call derz (dfdz3 ,fz3 ,di3,sz,ffz ,fsz ,fwz ,zsize(1),zsize(2),zsize(3),0,zero) - call derzz (dfdzz3 ,fz3 ,di3,sz,sfz ,ssz ,swz ,zsize(1),zsize(2),zsize(3),0,zero) + 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') @@ -1442,8 +1442,8 @@ subroutine debug_schemes() enddo enddo enddo - call filz (fiffz3 ,ffz3 ,di3,fisz,fiffz ,fifsz ,fifwz ,zsize(1),zsize(2),zsize(3),0,zero) - call filz (fiffzp3 ,ffzp3 ,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,zero) + 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') diff --git a/src/derive.f90 b/src/derive.f90 index 77257f0a5..a5a22deb5 100644 --- a/src/derive.f90 +++ b/src/derive.f90 @@ -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) @@ -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/filters.f90 b/src/filters.f90 index 61caaa146..fd7b5e1d4 100644 --- a/src/filters.f90 +++ b/src/filters.f90 @@ -614,7 +614,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) @@ -690,7 +690,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) @@ -783,7 +783,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) @@ -868,7 +868,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) @@ -954,7 +954,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) @@ -1002,7 +1002,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 @@ -1078,7 +1078,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) @@ -1168,7 +1168,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) @@ -1253,7 +1253,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) @@ -1339,7 +1339,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 66d274c45..2d0952dfa 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -253,8 +253,8 @@ subroutine force(ux1,uy1,ep1) 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 transpose_x_to_y(ta1,ta2) ! dudx call transpose_x_to_y(tb1,tb2) ! dvdx @@ -262,8 +262,8 @@ subroutine force(ux1,uy1,ep1) call transpose_x_to_y(uy1,uy2) 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) ! dudy - call dery (td2,uy2,di2,sy,ffy,fsy,fwy,ppy,ysize(1),ysize(2),ysize(3),0,ubcy) ! 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 transpose_y_to_x(tc2,tc1) ! dudy call transpose_y_to_x(td2,td1) ! dvdy diff --git a/src/ibm.f90 b/src/ibm.f90 index f30eaa576..630b22fb8 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -798,10 +798,13 @@ 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 ! Identifying which BC to Impose real(mytype) :: bcimp ! Imposed BC integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf + real(mytype) :: point(3),centre(3),angularVelocity(3),linearVelocity(3),pointVelocity(3) + real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv + ! ! Initialise Arrays xa(:)=zero @@ -811,11 +814,14 @@ subroutine cubsplz(u,lind) bcimp=lind ! do j=1,zsize(2) + ym=real(zstart(2)+j-2,mytype)*dy do i=1,zsize(1) + xm=real(zstart(1)+i-2,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 @@ -825,6 +831,32 @@ 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 + point=[xm,ym,zm] + call CalculatePointVelocity(point, centre, angularVelocity, linearVelocity, pointVelocity) + 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=x_pv + 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 ya(ia)=bcimp if(zi(k,i,j).gt.0.)then ! Immersed Object inxi=0 diff --git a/src/implicit.f90 b/src/implicit.f90 index ec5320f3d..35e9327b7 100644 --- a/src/implicit.f90 +++ b/src/implicit.f90 @@ -864,16 +864,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 @@ -1011,9 +1011,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 7a0e0a4af..b4fc6d381 100644 --- a/src/les_models.f90 +++ b/src/les_models.f90 @@ -193,9 +193,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(:,:,:) @@ -205,9 +205,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(:,:,:) @@ -218,9 +218,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(:,:,:)) @@ -390,17 +390,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, ioutput) == 0) then if (nrank==0) write(*,*) "filx ux= ", maxval(ta1), maxval(ux1f), maxval(ta1) - maxval(ux1f) @@ -429,17 +429,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, ioutput) == 0) then if (nrank==0) write(*,*) "fily ux= ", maxval(ta2), maxval(ux2f), maxval(ta2) - maxval(ux2f) @@ -471,17 +471,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, ioutput) == 0) then if (nrank==0) write(*,*) "filz ux= ", maxval(ta3), maxval(ux3f), maxval(ta3) - maxval(ux3f) @@ -535,9 +535,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 @@ -547,9 +547,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 @@ -560,9 +560,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) @@ -662,13 +662,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, ioutput) == 0) then if (nrank==0) write(*,*) "filx axx1= ", maxval(axx1), maxval(axx1f), maxval(axx1) - maxval(axx1f) @@ -690,13 +690,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, ioutput) == 0) then if (nrank==0) write(*,*) "fily axx2= ", maxval(ta2), maxval(axx2f), maxval(ta2) - maxval(axx2f) @@ -722,13 +722,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, ioutput) == 0) then if (nrank==0) write(*,*) "filz axx3= ", maxval(ta3), maxval(axx3f), maxval(ta3) - maxval(axx3f) @@ -792,13 +792,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, ioutput) == 0) then if (nrank==0) write(*,*) "filx smagC1= ", maxval(smagC1), maxval(smagC1f), maxval(smagC1) - maxval(smagC1f) @@ -905,9 +905,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) + 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(:,:,:) @@ -917,9 +917,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(:,:,:)) @@ -931,9 +931,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(:,:,:)) @@ -1071,11 +1071,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 @@ -1096,14 +1096,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) @@ -1112,14 +1112,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) @@ -1128,14 +1128,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) @@ -1144,7 +1144,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 @@ -1164,11 +1164,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 @@ -1224,25 +1224,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) @@ -1258,8 +1258,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) diff --git a/src/module_param.f90 b/src/module_param.f90 index 5836eba92..ab97a0a84 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -142,7 +142,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, only : mytype @@ -150,7 +150,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, only : mytype @@ -158,7 +158,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 @@ -186,7 +186,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, only : mytype @@ -194,7 +194,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, only : mytype @@ -202,7 +202,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 diff --git a/src/navier.f90 b/src/navier.f90 index 9caef02b6..5d9a36823 100644 --- a/src/navier.f90 +++ b/src/navier.f90 @@ -856,7 +856,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) !zero is 0. IF (imultispecies) THEN tb1(:,:,:) = (xnu / prandtl) * tb1(:,:,:) / ta1(:,:,:) @@ -871,7 +871,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) !zero is 0. tb1(:,:,:) = tb1(:,:,:) + (xnu / sc(is)) * (td1(:,:,:) / mol_weight(is)) * tc1(:,:,:) ENDIF ENDDO @@ -891,7 +891,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) !zero is 0. iimplicit = tmp IF (imultispecies) THEN tc2(:,:,:) = (xnu / prandtl) * tc2(:,:,:) / ta2(:,:,:) @@ -909,7 +909,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) !zero is 0. iimplicit = tmp tc2(:,:,:) = tc2(:,:,:) + (xnu / sc(is)) * (te2(:,:,:) / mol_weight(is)) * td2(:,:,:) ENDIF @@ -929,7 +929,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) !zero is 0. IF (imultispecies) THEN divu3(:,:,:) = (xnu / prandtl) * divu3(:,:,:) / ta3(:,:,:) @@ -944,7 +944,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) !zero is 0. divu3(:,:,:) = divu3(:,:,:) + (xnu / sc(is)) * (td3(:,:,:) / mol_weight(is)) * tc3(:,:,:) ENDIF ENDDO @@ -1054,16 +1054,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) !zero is 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) !zero is 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) !zero is 0. td1(:,:,:) = td1(:,:,:) + te1(:,:,:) drhodt1_next(:,:,:) = drhodt1_next(:,:,:) - invpe * td1(:,:,:) diff --git a/src/probes.f90 b/src/probes.f90 index 7de100069..cd65522df 100644 --- a/src/probes.f90 +++ b/src/probes.f90 @@ -349,15 +349,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) @@ -378,13 +378,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 f3b11967c..13f352331 100644 --- a/src/tools.f90 +++ b/src/tools.f90 @@ -562,9 +562,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) !x is 1) + call filx(uyf1,uy1,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,2) !y is 2) + call filx(uzf1,uz1,di1,fisx,fiffxp,fifsxp,fifwxp,xsize(1),xsize(2),xsize(3),1,3) !z is 3) else uxf1=ux1 uyf1=uy1 @@ -578,9 +578,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) !x is 1) + call fily(uyf2,uy2,di2,fisy,fiffy,fifsy,fifwy,ysize(1),ysize(2),ysize(3),0,2) !y is 2) + call fily(uzf2,uz2,di2,fisy,fiffyp,fifsyp,fifwyp,ysize(1),ysize(2),ysize(3),1,3) !z is 3) !if (iscalar.eq.1) call fily(phif2,phi2,di2,fisy,fiffy,fifsy,fifwy,ysize(1),ysize(2),ysize(3),0) else uxf2=ux2 @@ -595,9 +595,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) !x is 1) + call filz(uyf3,uy3,di3,fisz,fiffzp,fifszp,fifwzp,zsize(1),zsize(2),zsize(3),1,2) !y is 2) + call filz(uzf3,uz3,di3,fisz,fiffz,fifsz,fifwz,zsize(1),zsize(2),zsize(3),0,3) !z is 3) !if (iscalar.eq.1) call filz(phif3,phi3,di3,fisz,fiffz,fifsz,fifwz,zsize(1),zsize(2),zsize(3),0) else uxf3=ux3 diff --git a/src/transeq.f90 b/src/transeq.f90 index 0a50997d5..38d8ffb0a 100644 --- a/src/transeq.f90 +++ b/src/transeq.f90 @@ -187,12 +187,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 ', dep1 #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)) @@ -219,7 +219,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(:,:,:) @@ -248,12 +248,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 ', dep1 #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 @@ -268,7 +268,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(:,:,:) @@ -290,9 +290,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) @@ -325,9 +325,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) @@ -338,9 +338,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) @@ -351,9 +351,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) @@ -366,7 +366,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) @@ -375,7 +375,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) @@ -384,7 +384,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) @@ -627,11 +627,11 @@ 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) @@ -658,13 +658,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(:,:,:) @@ -677,14 +677,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(:,:,:) @@ -940,13 +940,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 @@ -962,11 +962,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 @@ -1001,11 +1001,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 @@ -1021,9 +1021,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 @@ -1133,12 +1133,12 @@ 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(:,:,:) @@ -1207,11 +1207,11 @@ 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) @@ -1220,11 +1220,11 @@ subroutine continuity_rhs_eq(drho1, rho1, ux1, divu3) 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) From 01984a1e73a09b5d9a24fca966eae71263858498 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Mon, 18 Sep 2023 22:58:29 +0100 Subject: [PATCH 009/125] ellip_utils added --- Makefile | 2 +- src/BC-Cylinder.f90 | 20 +- src/acl_utils.f90 | 127 +----------- src/ellip_utils.f90 | 460 ++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 474 insertions(+), 135 deletions(-) create mode 100644 src/ellip_utils.f90 diff --git a/Makefile b/Makefile index faee0029c..970e36471 100644 --- a/Makefile +++ b/Makefile @@ -55,7 +55,7 @@ SRCDECOMP = $(DECOMPDIR)/decomp_2d.f90 $(DECOMPDIR)/glassman.f90 $(DECOMPDIR)/ff 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 $(TURBDIR)/constants.f90 $(TURBDIR)/acl_utils.f90 $(SRCDIR)/poisson.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-Mixing-layer.f90 $(SRCDIR)/BC-Sandbox.f90 $(SRCDIR)/BC-Uniform.f90 $(SRCDIR)/BC-Cavity.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 +SRC = $(SRCDIR)/module_param.f90 $(SRCDIR)/variables.f90 $(SRCDIR)/BC-dbg-schemes.f90 $(SRCDIR)/poisson.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-Mixing-layer.f90 $(SRCDIR)/BC-Sandbox.f90 $(SRCDIR)/BC-Uniform.f90 $(SRCDIR)/BC-Cavity.f90 $(TURBDIR)/constants.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########## diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index b6a589c99..26b673a59 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -26,7 +26,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) use param, only : one, two, ten use ibm_param use dbg_schemes, only: sqrt_prec - ! use actuator_line_model_utils, only: EllipsoidalRadius + use ellipsoid_utils, only: EllipsoidalRadius, NormalizeQuaternion implicit none @@ -39,7 +39,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) real(mytype) :: xm,ym,zm,r,rads2,kcon real(mytype) :: zeromach real(mytype) :: cexx,ceyy,cezz,dist_axi - real(mytype) :: point(3), ce(3), orientation(4), shape(3) + real(mytype) :: point(3), ce(3), orientation(4), orientation_normalized(4),shape(3) zeromach=one do while ((one + zeromach / two) .gt. one) @@ -47,7 +47,8 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) end do zeromach = ten*zeromach - orientation=[1.0, 0.0, 0.0, 0.0] + orientation=[1.0, -1.0, 1.0, 0.0] + call NormalizeQuaternion(orientation) shape=[1.0, 1.0, 1.0] @@ -72,21 +73,24 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) ! ! 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(xstart(3)+k-2,mytype))*dz + zm=(real(k-1,mytype))*dz + ! write(*,*) k, zm do j=nyi,nyf ym=yp(j) do i=nxi,nxf xm=real(i-1,mytype)*dx point=[xm, ym, zm] - ! call EllipsoidalRadius(point, ce, orientation, shape, r) - r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) + call EllipsoidalRadius(point, ce, orientation, shape, r) + ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) if (r-ra.gt.zeromach) then + ! write(*,*) i, j, k cycle endif - write(*,*) i, j, k + ! write(*,*) i, j, k, zm epsi(i,j,k)=remp + ! write(*,*) remp enddo enddo enddo diff --git a/src/acl_utils.f90 b/src/acl_utils.f90 index f449173b1..77f4443ec 100644 --- a/src/acl_utils.f90 +++ b/src/acl_utils.f90 @@ -132,132 +132,7 @@ end subroutine QuatRot - subroutine NormalizeQuaternion(quaternion) - real(mytype), intent(in) :: 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) - - ! Normalize the quaternion - normalizedQuaternion = quaternion / magnitude - - end subroutine NormalizeQuaternion - - 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_c, rotated_point) - - do i = 1,3 - scaled_point(i)=rotated_point(i)/shape(i) - end do - - radius=sqrt_prec(scaled_point(1)**two+scaled_point(2)**two+scaled_point(3)**two) - - 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, velocity) - real(mytype), intent(in) :: point(3), center(3), angularVelocity(3), linearVelocity(3) - real(mytype), intent(out) :: velocity(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(angularVelocity, distance, crossed) - - ! Calculate the velocity at the point - velocity = crossed + linearVelocity - - end subroutine CalculatePointVelocity - - - - ! subroutine CalculatePointVelocity(point, center, angularVelocity, velocity) - ! real(mytype), intent(in) :: point(3), center(3), angularVelocity(3) - ! real(mytype), intent(out) :: velocity(3) - ! real(mytype) :: distance(3) - ! real(mytype) :: crossProduct(3) - - - ! ! Compute the distance vector from the center to the point - ! distance = point - center - - ! ! Compute the cross product of angular velocity and distance vector - ! call CrossProduct(angularVelocity, distance, crossProduct) - - ! ! Calculate the velocity at the point - ! velocity = crossProduct - ! end subroutine CalculatePointVelocity - + !******************************************************************************* ! diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 new file mode 100644 index 000000000..dad925f1c --- /dev/null +++ b/src/ellip_utils.f90 @@ -0,0 +1,460 @@ +!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 + + 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(in) :: 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) + + ! Normalize the quaternion + normalizedQuaternion = quaternion / magnitude + + end subroutine NormalizeQuaternion + + 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_prec(scaled_point(1)**two+scaled_point(2)**two+scaled_point(3)**two) + + 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, linearVelocity, angularVelocity, velocity) + real(mytype), intent(in) :: point(3), center(3), linearVelocity(3), angularVelocity(3) + real(mytype), intent(out) :: velocity(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(angularVelocity, distance, crossed) + + ! Calculate the velocity at the point + velocity = crossed + linearVelocity + end subroutine CalculatePointVelocity + + + + ! subroutine CalculatePointVelocity(point, center, angularVelocity, velocity) + ! real(mytype), intent(in) :: point(3), center(3), angularVelocity(3) + ! real(mytype), intent(out) :: velocity(3) + ! real(mytype) :: distance(3) + ! real(mytype) :: crossProduct(3) + + + ! ! Compute the distance vector from the center to the point + ! distance = point - center + + ! ! Compute the cross product of angular velocity and distance vector + ! call CrossProduct(angularVelocity, distance, crossProduct) + + ! ! Calculate the velocity at the point + ! velocity = crossProduct + ! end subroutine CalculatePointVelocity + + + ! !******************************************************************************* + ! ! + ! subroutine IDW(Ncol,Xcol,Ycol,Zcol,Fxcol,Fycol,Fzcol,p,Xmesh,Ymesh,Zmesh,Fxmesh,Fymesh,Fzmesh) + ! ! + ! !******************************************************************************* + + ! implicit none + ! integer, intent(in) :: Ncol + ! real(mytype), dimension(Ncol), intent(in) :: Xcol,Ycol,Zcol,Fxcol,Fycol,Fzcol + ! real(mytype), intent(in) :: Xmesh,Ymesh,Zmesh + ! integer,intent(in) :: p + ! real(mytype), intent(inout) :: Fxmesh,Fymesh,Fzmesh + ! real(mytype), dimension(Ncol) :: d(Ncol), w(Ncol) + ! real(mytype) :: wsum + ! integer :: i,imin + + ! wsum=zero + ! do i=1,Ncol + ! d(i)=sqrt_prec((Xcol(i)-Xmesh)**2+(Ycol(i)-Ymesh)**2+(Zcol(i)-Zmesh)**2) + ! w(i)=one/d(i)**p + ! wsum=wsum+w(i) + ! enddo + + ! if (minval(d)<0.001_mytype) then + ! imin=minloc(d,1) + ! Fxmesh=Fxcol(imin) + ! Fymesh=Fycol(imin) + ! Fzmesh=Fzcol(imin) + ! else + ! Fxmesh=zero + ! Fymesh=zero + ! Fzmesh=zero + ! do i=1,Ncol + ! Fxmesh=Fxmesh+w(i)*Fxcol(i)/wsum + ! Fymesh=Fymesh+w(i)*Fycol(i)/wsum + ! Fzmesh=Fzmesh+w(i)*Fzcol(i)/wsum + ! enddo + ! endif + + ! end subroutine IDW + + ! !******************************************************************************* + ! ! + ! real(mytype) function IsoKernel(dr,epsilon_par,dim) + ! ! + ! !******************************************************************************* + + ! use constants + + ! implicit none + ! integer, intent(in) :: dim + ! real(mytype), intent(in) :: dr, epsilon_par + + ! if (dim==2) then + ! IsoKernel = one/(epsilon_par**2*pi)*exp_prec(-(dr/epsilon_par)**2.0) + ! else if (dim==3) then + ! IsoKernel = one/(epsilon_par**3.0*pi**1.5)*exp_prec(-(dr/epsilon_par)**2.0) + ! else + ! write(*,*) "1D source not implemented" + ! stop + ! endif + + ! end function IsoKernel + + ! !******************************************************************************* + ! ! + ! real(mytype) function AnIsoKernel(dx,dy,dz,nx,ny,nz,tx,ty,tz,sx,sy,sz,ec,et,es) + ! ! + ! !******************************************************************************* + + ! use constants + + ! implicit none + ! real(mytype), intent(in) :: dx,dy,dz,nx,ny,nz,tx,ty,tz,sx,sy,sz,ec,et,es + ! real(mytype) :: n,t,s + + ! n=dx*nx+dy*ny+dz*nz ! normal projection + ! t=dx*tx+dy*ty+dz*tz ! Chordwise projection + ! s=dx*sx+dy*sy+dz*sz ! Spanwise projection + + ! if (abs(s)<=es) then + ! AnIsoKernel = exp_prec(-((n/et)**2.0+(t/ec)**2.0))/(ec*et*pi) + ! else + ! AnIsoKernel = zero + ! endif + + ! end function AnIsoKernel + + ! !******************************************************************************* + ! ! + ! integer function FindMinimum(x,Start,End) + ! ! + ! !******************************************************************************* + + ! implicit none + ! integer, dimension(1:), intent(in) :: x + ! integer, intent(in) :: Start, End + ! integer :: Minimum + ! integer :: Location + ! integer :: i + + ! minimum = x(start) + ! Location = Start + ! do i=start+1,End + ! if (x(i) < Minimum) then + ! Minimum = x(i) + ! Location = i + ! endif + ! enddo + ! FindMinimum = Location + + ! end function FindMinimum + + ! !******************************************************************************* + ! ! + ! subroutine swap(a,b) + ! ! + ! !******************************************************************************* + + ! implicit none + ! integer, intent(inout) :: a,b + ! integer :: Temp + + ! Temp = a + ! a = b + ! b = Temp + + ! end subroutine swap + + ! !******************************************************************************* + ! ! + ! subroutine sort(x,size) + ! ! + ! !******************************************************************************* + + ! implicit none + ! integer, dimension(1:), intent(inout) :: x + ! integer, intent(in) :: size + ! integer :: i + ! integer :: Location + + ! do i=1,Size-1 + ! location=FindMinimum(x,i,size) + ! call swap(x(i),x(Location)) + ! enddo + + ! end subroutine sort + + ! !******************************************************************************* + ! ! + ! function dirname(number) + ! ! + ! !******************************************************************************* + + ! integer, intent(in) :: number + ! character(len=6) :: dirname + + ! ! Cast the (rounded) number to string using 6 digits and leading zeros + ! write (dirname, '(I6.1)') number + ! ! This is the same w/o leading zeros + ! !write (dirname, '(I6)') nint(number) + ! ! This is for one digit (no rounding) + ! !write (dirname, '(F4.1)') number + + ! end function dirname + + ! !******************************************************************************* + ! ! + ! function outdirname(number) + ! ! + ! !******************************************************************************* + + ! integer, intent(in) :: number + ! character(len=6) :: outdirname + + ! ! Cast the (rounded) number to string using 6 digits and leading zeros + ! write (outdirname, '(I6.1)') number + ! ! This is the same w/o leading zeros + ! !write (dirname, '(I6)') nint(number) + ! ! This is for one digit (no rounding) + ! !write (dirname, '(F4.1)') number + + ! end function outdirname + + ! !******************************************************************************* + ! ! + ! character(20) function int2str(num) + ! ! + ! !******************************************************************************* + + ! integer, intent(in) ::num + ! character(20) :: str + + ! ! convert integer to string using formatted write + ! write(str, '(i20)') num + ! int2str = adjustl(str) + + ! end function int2str + +end module ellipsoid_utils From 5fba44f8f3b750832e6525409b324be288958418 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Tue, 19 Sep 2023 16:55:22 +0100 Subject: [PATCH 010/125] adding visualisation file epsilon support --- src/BC-Cylinder.f90 | 2 +- src/visu.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index 26b673a59..97a7a353a 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -49,7 +49,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) orientation=[1.0, -1.0, 1.0, 0.0] call NormalizeQuaternion(orientation) - shape=[1.0, 1.0, 1.0] + shape=[1.0, 0.6, 0.4] ! Intitialise epsi diff --git a/src/visu.f90 b/src/visu.f90 index a38c82ea5..d86610642 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -236,7 +236,7 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) call write_field(uy1, ".", "uy", num) call write_field(uz1, ".", "uz", num) call write_field(ep1, ".", "ep1", num, skip_ibm = .true.) - + ! Interpolate pressure !WORK Z-PENCILS From c7e202998f746e616ee1f772ad7654270268c65a Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Tue, 19 Sep 2023 21:44:34 +0100 Subject: [PATCH 011/125] added in input file changes --- src/BC-Cylinder.f90 | 52 +++++++++++++++++++++++++++++--------------- src/acl_utils.f90 | 3 +-- src/ellip_utils.f90 | 6 ++--- src/genepsi3d.f90 | 2 +- src/ibm.f90 | 22 ++++++++++--------- src/module_param.f90 | 3 ++- src/parameters.f90 | 2 +- 7 files changed, 55 insertions(+), 35 deletions(-) diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index e62c17448..0b058e1ec 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -39,7 +39,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) real(mytype) :: xm,ym,zm,r,rads2,kcon real(mytype) :: zeromach real(mytype) :: cexx,ceyy,cezz,dist_axi - real(mytype) :: point(3), ce(3), orientation(4), orientation_normalized(4),shape(3) + real(mytype) :: point(3) zeromach=one do while ((one + zeromach / two) .gt. one) @@ -47,29 +47,29 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) end do zeromach = ten*zeromach - orientation=[1.0, -1.0, 1.0, 0.0] + ! orientation=[oriw, orii, orij, orik] call NormalizeQuaternion(orientation) - shape=[1.0, 0.6, 0.4] + ! shape=[shx, shy, shz] + ! write(*,*) shape, 'SHAPE' ! Intitialise epsi epsi(:,:,:)=zero - ! Update center of moving Cylinder - !cexx=cex+ubcx*t - !ceyy=cey+ubcy*t - ! Update center of moving Cylinder + + ! Update center of moving ellipsoid if (t.ne.0.) then - cexx=cex+ubcx*(t-ifirst*dt) - ceyy=cey+ubcy*(t-ifirst*dt) - cezz=cez+ubcz*(t-ifirst*dt) + cex=cex+lvx*(t-ifirst*dt) + cey=cey+lvy*(t-ifirst*dt) + cez=cez+lvz*(t-ifirst*dt) else - cexx=cex - ceyy=cey - cezz=cez + cex=cex + cey=cey + cez=cez endif - - ce=[cexx, ceyy, cezz] + position=[cex,cey,cez] + ! 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 @@ -82,7 +82,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 point=[xm, ym, zm] - call EllipsoidalRadius(point, ce, orientation, shape, r) + call EllipsoidalRadius(point, position, orientation, shape, r) ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) @@ -232,16 +232,34 @@ subroutine init_cyl (ux1,uy1,uz1,phi1) USE variables USE param USE MPI + USE ibm_param use dbg_schemes, only: exp_prec + use ellipsoid_utils, only: NormalizeQuaternion + 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 + real(mytype) :: y,um,eqr integer :: k,j,i,ii,is,code + eqr=(shx*shy*shz)**(1.0/3.0) + shape=[shx/eqr,shy/eqr,shz/eqr] + + orientation=[oriw,orii,orij,orik] + call NormalizeQuaternion(orientation) + position=[cex,cey,cez] + linearVelocity=[lvx,lvy,lvz] + angularVelocity=[avx,avy,avz] + + write(*,*) 'set shape = ', shape + write(*,*) 'set orientation = ', orientation + write(*,*) 'set position = ', position + write(*,*) 'set linear velocity = ', linearVelocity + write(*,*) 'set angular velocity = ', angularVelocity + if (iscalar==1) then phi1(:,:,:,:) = zero !change as much as you want diff --git a/src/acl_utils.f90 b/src/acl_utils.f90 index 77f4443ec..e379ef916 100644 --- a/src/acl_utils.f90 +++ b/src/acl_utils.f90 @@ -9,8 +9,7 @@ module actuator_line_model_utils use dbg_schemes, only: sqrt_prec, cos_prec, exp_prec, sin_prec implicit none - public QuatRot, cross, IsoKernel, AnIsoKernel, int2str, EllipsoidalRadius - + public QuatRot, cross, IsoKernel, AnIsoKernel, int2str contains !******************************************************************************* diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index dad925f1c..1ee875e80 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -222,9 +222,9 @@ subroutine CrossProduct(a, b, result) result(3) = a(1) * b(2) - a(2) * b(1) end subroutine CrossProduct - subroutine CalculatePointVelocity(point, center, linearVelocity, angularVelocity, velocity) + subroutine CalculatePointVelocity(point, center, linearVelocity, angularVelocity, pointVelocity) real(mytype), intent(in) :: point(3), center(3), linearVelocity(3), angularVelocity(3) - real(mytype), intent(out) :: velocity(3) + real(mytype), intent(out) :: pointVelocity(3) real(mytype) :: crossed(3) ! Compute the distance vector from the center to the point real(mytype) :: distance(3) @@ -235,7 +235,7 @@ subroutine CalculatePointVelocity(point, center, linearVelocity, angularVelocity call CrossProduct(angularVelocity, distance, crossed) ! Calculate the velocity at the point - velocity = crossed + linearVelocity + pointVelocity = crossed + linearVelocity end subroutine CalculatePointVelocity diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index f5fe56117..f0bf3d5c6 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -189,7 +189,7 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& integer :: numvis integer :: mpi_aux_i, code - write(*,*)'Inside gene_epsi_3D' + ! write(*,*)'Inside gene_epsi_3D' !x-pencil ep1=zero call geomcomplex(ep1,xstart(1),xend(1),ny,xstart(2),xend(2),xstart(3),xend(3),dx,yp,dz,one) diff --git a/src/ibm.f90 b/src/ibm.f90 index 630b22fb8..ad41afd4b 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -12,7 +12,7 @@ subroutine corgp_IBM (ux,uy,uz,px,py,pz,nlock) USE param USE decomp_2d USE variables - USE actuator_line_model_utils, ONLY: CalculatePointVelocity + implicit none integer :: i,j,k,nlock real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ux,uy,uz,px,py,pz @@ -402,8 +402,8 @@ subroutine cubsplx(u,lind) USE decomp_2d USE variables USE ibm_param - USE actuator_line_model_utils - ! + USE ellipsoid_utils, ONLY: CalculatePointVelocity + ! implicit none ! real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: u @@ -419,7 +419,7 @@ subroutine cubsplx(u,lind) real(mytype) :: bcimp ! Imposed BC integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf ! Position of Boundary (Analytically) - real(mytype) :: point(3),centre(3),angularVelocity(3),linearVelocity(3),pointVelocity(3) + real(mytype) :: point(3),pointVelocity(3) real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv ! ! Initialise Arrays @@ -448,7 +448,7 @@ subroutine cubsplx(u,lind) xa(ia)=ana_resi endif point=[xm,ym,zm] - call CalculatePointVelocity(point, centre, angularVelocity, linearVelocity, pointVelocity) + call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, pointVelocity) x_pv=pointVelocity(1) y_pv=pointVelocity(2) z_pv=pointVelocity(3) @@ -592,6 +592,7 @@ subroutine cubsply(u,lind) USE decomp_2d USE variables USE ibm_param + USE ellipsoid_utils, ONLY: CalculatePointVelocity ! implicit none ! @@ -608,7 +609,7 @@ subroutine cubsply(u,lind) real(mytype) :: bcimp ! Imposed BC integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf - real(mytype) :: point(3),centre(3),angularVelocity(3),linearVelocity(3),pointVelocity(3) + real(mytype) :: point(3),pointVelocity(3) real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv ! ! Initialise Arrays @@ -637,7 +638,7 @@ subroutine cubsply(u,lind) xa(ia)=ana_resi endif point=[xm,ym,zm] - call CalculatePointVelocity(point, centre, angularVelocity, linearVelocity, pointVelocity) + call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, pointVelocity) x_pv=pointVelocity(1) y_pv=pointVelocity(2) z_pv=pointVelocity(3) @@ -786,6 +787,7 @@ subroutine cubsplz(u,lind) USE decomp_2d USE variables USE ibm_param + USE ellipsoid_utils, ONLY: CalculatePointVelocity ! implicit none ! @@ -802,7 +804,7 @@ subroutine cubsplz(u,lind) real(mytype) :: bcimp ! Imposed BC integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf - real(mytype) :: point(3),centre(3),angularVelocity(3),linearVelocity(3),pointVelocity(3) + real(mytype) :: point(3),pointVelocity(3) real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv ! @@ -811,7 +813,7 @@ subroutine cubsplz(u,lind) ya(:)=zero ! ! Impose the Correct BC - bcimp=lind +! bcimp=lind ! do j=1,zsize(2) ym=real(zstart(2)+j-2,mytype)*dy @@ -832,7 +834,7 @@ subroutine cubsplz(u,lind) xa(ia)=ana_resi endif point=[xm,ym,zm] - call CalculatePointVelocity(point, centre, angularVelocity, linearVelocity, pointVelocity) + call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, pointVelocity) x_pv=pointVelocity(1) y_pv=pointVelocity(2) z_pv=pointVelocity(3) diff --git a/src/module_param.f90 b/src/module_param.f90 index ab97a0a84..99d93f770 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -616,7 +616,8 @@ end module simulation_stats !############################################################################ module ibm_param use decomp_2d, only : mytype - real(mytype) :: cex,cey,cez,ra,ubcx,ubcy,ubcz,rads, c_air + real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads, c_air + real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(3),shape(3) real(mytype) :: chord,thickness,omega integer :: inana ! Analytical BC as Input integer :: imove diff --git a/src/parameters.f90 b/src/parameters.f90 index 9221032e0..a756c7109 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -60,7 +60,7 @@ subroutine parameter(input_i3d) NAMELIST /LESModel/ jles, smagcst, smagwalldamp, nSmag, walecst, maxdsmagcst, iwall NAMELIST /WallModel/ smagwalldamp NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl - NAMELIST /ibmstuff/ cex,cey,cez,ra,nobjmax,nraf,nvol,iforces, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads, c_air + NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,nobjmax,nraf,nvol,iforces, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads, c_air 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, & From 44344daabacf4b0337ada140e5f9e48f1ae9a01f Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Wed, 20 Sep 2023 14:02:58 +0100 Subject: [PATCH 012/125] adding extra fields for rotational motion --- src/BC-Cylinder.f90 | 14 +++++++------- src/ellip_utils.f90 | 30 +++++++++++++++++++++++++++++- src/ibm.f90 | 6 ++++++ src/navier.f90 | 6 +++--- 4 files changed, 45 insertions(+), 11 deletions(-) diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index 0b058e1ec..8e9057ec9 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -59,15 +59,15 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) ! Update center of moving ellipsoid if (t.ne.0.) then - cex=cex+lvx*(t-ifirst*dt) - cey=cey+lvy*(t-ifirst*dt) - cez=cez+lvz*(t-ifirst*dt) + cexx=cex+lvx*(t-ifirst*dt) + ceyy=cey+lvy*(t-ifirst*dt) + cezz=cez+lvz*(t-ifirst*dt) else - cex=cex - cey=cey - cez=cez + cexx=cex + ceyy=cey + cezz=cez endif - position=[cex,cey,cez] + position=[cexx,ceyy,cezz] ! write(*,*) position ! ce=[cexx, ceyy, cezz] ! diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 1ee875e80..6a55ebd08 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -237,7 +237,35 @@ subroutine CalculatePointVelocity(point, center, linearVelocity, angularVelocity ! Calculate the velocity at the point pointVelocity = crossed + linearVelocity end subroutine CalculatePointVelocity - + + subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1_x, ep1_y, ep1_z) + use param + use decomp_2d + real(mytype), intent(in) :: center(3), linearVelocity(3), angularVelocity(3) + 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] + call CalculatePointVelocity(point, center, linearVelocity, angularVelocity, pointVelocity) + x_pv=pointVelocity(1) + y_pv=pointVelocity(2) + z_pv=pointVelocity(3) + 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 CalculatePointVelocity(point, center, angularVelocity, velocity) diff --git a/src/ibm.f90 b/src/ibm.f90 index ad41afd4b..c49a0185f 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -428,6 +428,7 @@ subroutine cubsplx(u,lind) ! ! Impose the Correct BC ! bcimp=lind + write(*,*) lind ! do k=1,xsize(3) zm=real(xstart(3)+k-2,mytype)*dz @@ -456,6 +457,7 @@ subroutine cubsplx(u,lind) bcimp=zero elseif (lind.eq.1) then bcimp=x_pv + write(*,*) bcimp elseif (lind.eq.2) then bcimp=y_pv elseif (lind.eq.3) then @@ -618,6 +620,8 @@ subroutine cubsply(u,lind) ! ! Impose the Correct BC ! bcimp=lind + write(*,*) lind + ! do k=1,ysize(3) zm=real(ystart(3)+k-2,mytype)*dz @@ -814,6 +818,8 @@ subroutine cubsplz(u,lind) ! ! Impose the Correct BC ! bcimp=lind + write(*,*) lind + ! do j=1,zsize(2) ym=real(zstart(2)+j-2,mytype)*dy diff --git a/src/navier.f90 b/src/navier.f90 index 5d9a36823..de656383b 100644 --- a/src/navier.f90 +++ b/src/navier.f90 @@ -288,9 +288,9 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) tb1(:,:,:) = uy1(:,:,:) tc1(:,:,:) = uz1(:,:,:) else - ta1(:,:,:) = (one - ep1(:,:,:)) * ux1(:,:,:) + ep1(:,:,:)*ubcx - tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*ubcy - tc1(:,:,:) = (one - ep1(:,:,:)) * uz1(:,:,:) + ep1(:,:,:)*ubcz + ta1(:,:,:) = (one - ep1(:,:,:)) * ux1(:,:,:) + ep1(:,:,:)*lvx + tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*lvy + tc1(:,:,:) = (one - ep1(:,:,:)) * uz1(:,:,:) + ep1(:,:,:)*lvz endif !WORK X-PENCILS From a561e93e1678745d15786a511b9d468f3c164274 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Wed, 20 Sep 2023 15:40:38 +0100 Subject: [PATCH 013/125] added ellip case separate from cyl --- Makefile | 2 +- src/BC-Ellipsoid.f90 | 433 +++++++++++++++++++++++++++++++++++++++++++ src/case.f90 | 24 ++- src/ellip_utils.f90 | 17 +- src/genepsi3d.f90 | 7 +- src/module_param.f90 | 3 +- src/parameters.f90 | 2 + 7 files changed, 479 insertions(+), 9 deletions(-) create mode 100644 src/BC-Ellipsoid.f90 diff --git a/Makefile b/Makefile index 970e36471..728bc7831 100644 --- a/Makefile +++ b/Makefile @@ -55,7 +55,7 @@ SRCDECOMP = $(DECOMPDIR)/decomp_2d.f90 $(DECOMPDIR)/glassman.f90 $(DECOMPDIR)/ff 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 $(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-Mixing-layer.f90 $(SRCDIR)/BC-Sandbox.f90 $(SRCDIR)/BC-Uniform.f90 $(SRCDIR)/BC-Cavity.f90 $(TURBDIR)/constants.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 +SRC = $(SRCDIR)/module_param.f90 $(SRCDIR)/variables.f90 $(SRCDIR)/BC-dbg-schemes.f90 $(SRCDIR)/poisson.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)/constants.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########## diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 new file mode 100644 index 000000000..7da85bea9 --- /dev/null +++ b/src/BC-Ellipsoid.f90 @@ -0,0 +1,433 @@ +module ellip + +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,remp) + + use decomp_2d, only : mytype + use param, only : one, two, ten + use ibm_param + use dbg_schemes, only: sqrt_prec + use ellipsoid_utils, only: EllipsoidalRadius, NormalizeQuaternion + + 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 + real(mytype) :: remp + integer :: i,j,k + real(mytype) :: xm,ym,zm,r,rads2,kcon + real(mytype) :: zeromach + real(mytype) :: cexx,ceyy,cezz,dist_axi + real(mytype) :: point(3) + + zeromach=one + do while ((one + zeromach / two) .gt. one) + zeromach = zeromach/two + end do + zeromach = ten*zeromach + + ! orientation=[oriw, orii, orij, orik] + call NormalizeQuaternion(orientation) + ! 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=yp(j) + do i=nxi,nxf + xm=real(i-1,mytype)*dx + point=[xm, ym, zm] + call EllipsoidalRadius(point, position, orientation, shape, r) + ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) + ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) + + if (r-ra.gt.zeromach) then + ! write(*,*) i, j, k + cycle + endif + ! 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 :: j,k,is + real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi + + !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 (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 dbg_schemes, only: exp_prec + use ellipsoid_utils, only: NormalizeQuaternion + + + 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 + integer :: k,j,i,ii,is,code + + eqr=(shx*shy*shz)**(1.0/3.0) + shape=[shx/eqr,shy/eqr,shz/eqr] + + orientation=[oriw,orii,orij,orik] + call NormalizeQuaternion(orientation) + position=[cex,cey,cez] + linearVelocity=[lvx,lvy,lvz] + angularVelocity=[avx,avy,avz] + + write(*,*) 'set shape = ', shape + write(*,*) 'set orientation = ', orientation + write(*,*) 'set position = ', position + write(*,*) 'set linear velocity = ', linearVelocity + write(*,*) 'set angular velocity = ', angularVelocity + + if (iscalar==1) then + + phi1(:,:,:,:) = zero !change as much as you want + + endif + + ux1=zero; 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_prec(-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) + 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 + use dbg_schemes, only: sqrt_prec + + 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, only : mytype + 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 + + 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) + 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 + +end subroutine visu_ellip + +end module ellip + \ No newline at end of file diff --git a/src/case.f90 b/src/case.f90 index d255ee364..a089f0d8b 100644 --- a/src/case.f90 +++ b/src/case.f90 @@ -21,6 +21,7 @@ module case use uniform use sandbox use cavity + use ellip use var, only : nzmsize @@ -114,6 +115,10 @@ subroutine init (rho1, ux1, uy1, uz1, ep1, phi1, drho1, dux1, duy1, duz1, dphi1, call init_cavity(ux1, uy1, uz1, ep1, phi1) + elseif (itype.eq.itype_ellip) then + + call init_ellip (ux1, uy1, uz1, phi1) + else if (nrank.eq.0) then @@ -202,6 +207,10 @@ subroutine boundary_conditions (rho,ux,uy,uz,phi,ep) call boundary_conditions_cavity(ux, uy, uz, phi) + elseif (itype.eq.itype_ellip) then + + call boundary_conditions_ellip(ux, uy, uz, phi) + endif end subroutine boundary_conditions @@ -351,6 +360,10 @@ 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) + endif if (iforces.eq.1) then @@ -392,7 +405,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) end if @@ -448,6 +465,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. + endif if (called_visu .and. (.not. case_visu_init)) then diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 6a55ebd08..e129fc97f 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -238,10 +238,11 @@ subroutine CalculatePointVelocity(point, center, linearVelocity, angularVelocity pointVelocity = crossed + linearVelocity end subroutine CalculatePointVelocity - subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1_x, ep1_y, ep1_z) + subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1, ep1_x, ep1_y, ep1_z) use param use decomp_2d real(mytype), intent(in) :: center(3), linearVelocity(3), angularVelocity(3) + 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 @@ -253,10 +254,16 @@ subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1_x, ep1_y, do i = 1,xsize(1) xm=real(i+xstart(1)-2, mytype)*dx point=[xm,ym,zm] - call CalculatePointVelocity(point, center, linearVelocity, angularVelocity, pointVelocity) - x_pv=pointVelocity(1) - y_pv=pointVelocity(2) - z_pv=pointVelocity(3) + if (ep1(i,j,k).eq.1) then + call CalculatePointVelocity(point, center, linearVelocity, angularVelocity, 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 diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index f0bf3d5c6..f53b8a6a9 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -45,12 +45,13 @@ 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 + USE param, ONLY : itype, itype_cyl, itype_hill, itype_channel,itype_sandbox, itype_ellip USE decomp_2d, ONLY : mytype 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 IMPLICIT NONE @@ -76,6 +77,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, remp) + ENDIF end subroutine geomcomplex diff --git a/src/module_param.f90 b/src/module_param.f90 index 99d93f770..21109d27e 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -284,7 +284,8 @@ module param itype_abl = 10, & itype_uniform = 11, & itype_sandbox = 12, & - itype_cavity = 13 + itype_cavity = 13, & + itype_ellip = 14 integer :: cont_phi,itr,itime,itest,iprocessing integer :: ifft,istret,iforc_entree,iturb diff --git a/src/parameters.f90 b/src/parameters.f90 index a756c7109..6ed4b579d 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -348,6 +348,8 @@ subroutine parameter(input_i3d) print *,'Sandbox' elseif (itype.eq.itype_cavity) then print *,'Cavity' + elseif (itype.eq.itype_ellip) then + print *,'Simulating Ellipsoid' else print *,'Unknown itype: ', itype stop From 48219a62037692e756a0e9e851311df41eccb448 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Wed, 20 Sep 2023 23:12:37 +0100 Subject: [PATCH 014/125] added quaternion integration functions --- src/ellip_utils.f90 | 448 ++++++++++++++++++++------------------------ 1 file changed, 201 insertions(+), 247 deletions(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index e129fc97f..2a1e330e2 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -145,6 +145,14 @@ subroutine NormalizeQuaternion(quaternion) end subroutine NormalizeQuaternion + subroutine QuaternionNorm(q,norm) + real(mytype),intent(in) :: q(4) + real(mytype),intent(out):: norm + + norm = sqrt_prec(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) @@ -207,289 +215,235 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) radius=sqrt_prec(scaled_point(1)**two+scaled_point(2)**two+scaled_point(3)**two) - 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, linearVelocity, angularVelocity, pointVelocity) - real(mytype), intent(in) :: point(3), center(3), linearVelocity(3), angularVelocity(3) - 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(angularVelocity, distance, crossed) + 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, linearVelocity, angularVelocity, pointVelocity) + real(mytype), intent(in) :: point(3), center(3), linearVelocity(3), angularVelocity(3) + 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 - ! Calculate the velocity at the point - pointVelocity = crossed + linearVelocity - end subroutine CalculatePointVelocity - - subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1, ep1_x, ep1_y, ep1_z) - use param - use decomp_2d - real(mytype), intent(in) :: center(3), linearVelocity(3), angularVelocity(3) - 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(point, center, linearVelocity, angularVelocity, 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 + call CrossProduct(angularVelocity, distance, crossed) + + ! Calculate the velocity at the point + pointVelocity = crossed + linearVelocity + end subroutine CalculatePointVelocity + + subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1, ep1_x, ep1_y, ep1_z) + use param + use decomp_2d + real(mytype), intent(in) :: center(3), linearVelocity(3), angularVelocity(3) + 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(point, center, linearVelocity, angularVelocity, 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 + 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) - ! subroutine CalculatePointVelocity(point, center, angularVelocity, velocity) - ! real(mytype), intent(in) :: point(3), center(3), angularVelocity(3) - ! real(mytype), intent(out) :: velocity(3) - ! real(mytype) :: distance(3) - ! real(mytype) :: crossProduct(3) + call QuaternionConjugate(q, q_inv) - - ! ! Compute the distance vector from the center to the point - ! distance = point - center - - ! ! Compute the cross product of angular velocity and distance vector - ! call CrossProduct(angularVelocity, distance, crossProduct) - - ! ! Calculate the velocity at the point - ! velocity = crossProduct - ! end subroutine CalculatePointVelocity - + call QuaternionMultiply(p_body,q_inv,q_m) + call QuaternionMultiply(q,q_m, p_lab) - ! !******************************************************************************* - ! ! - ! subroutine IDW(Ncol,Xcol,Ycol,Zcol,Fxcol,Fycol,Fzcol,p,Xmesh,Ymesh,Zmesh,Fxmesh,Fymesh,Fzmesh) - ! ! - ! !******************************************************************************* + end subroutine body_to_lab - ! implicit none - ! integer, intent(in) :: Ncol - ! real(mytype), dimension(Ncol), intent(in) :: Xcol,Ycol,Zcol,Fxcol,Fycol,Fzcol - ! real(mytype), intent(in) :: Xmesh,Ymesh,Zmesh - ! integer,intent(in) :: p - ! real(mytype), intent(inout) :: Fxmesh,Fymesh,Fzmesh - ! real(mytype), dimension(Ncol) :: d(Ncol), w(Ncol) - ! real(mytype) :: wsum - ! integer :: i,imin - - ! wsum=zero - ! do i=1,Ncol - ! d(i)=sqrt_prec((Xcol(i)-Xmesh)**2+(Ycol(i)-Ymesh)**2+(Zcol(i)-Zmesh)**2) - ! w(i)=one/d(i)**p - ! wsum=wsum+w(i) - ! enddo - - ! if (minval(d)<0.001_mytype) then - ! imin=minloc(d,1) - ! Fxmesh=Fxcol(imin) - ! Fymesh=Fycol(imin) - ! Fzmesh=Fzcol(imin) - ! else - ! Fxmesh=zero - ! Fymesh=zero - ! Fzmesh=zero - ! do i=1,Ncol - ! Fxmesh=Fxmesh+w(i)*Fxcol(i)/wsum - ! Fymesh=Fymesh+w(i)*Fycol(i)/wsum - ! Fzmesh=Fzmesh+w(i)*Fzcol(i)/wsum - ! enddo - ! endif + 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) - ! end subroutine IDW + call QuaternionConjugate(q, q_inv) - ! !******************************************************************************* - ! ! - ! real(mytype) function IsoKernel(dr,epsilon_par,dim) - ! ! - ! !******************************************************************************* + call QuaternionMultiply(p_lab,q,q_m) + call QuaternionMultiply(q_inv,q_m, p_body) - ! use constants + end subroutine lab_to_body - ! implicit none - ! integer, intent(in) :: dim - ! real(mytype), intent(in) :: dr, epsilon_par - - ! if (dim==2) then - ! IsoKernel = one/(epsilon_par**2*pi)*exp_prec(-(dr/epsilon_par)**2.0) - ! else if (dim==3) then - ! IsoKernel = one/(epsilon_par**3.0*pi**1.5)*exp_prec(-(dr/epsilon_par)**2.0) - ! else - ! write(*,*) "1D source not implemented" - ! stop - ! endif - - ! end function IsoKernel - - ! !******************************************************************************* - ! ! - ! real(mytype) function AnIsoKernel(dx,dy,dz,nx,ny,nz,tx,ty,tz,sx,sy,sz,ec,et,es) - ! ! - ! !******************************************************************************* - - ! use constants - - ! implicit none - ! real(mytype), intent(in) :: dx,dy,dz,nx,ny,nz,tx,ty,tz,sx,sy,sz,ec,et,es - ! real(mytype) :: n,t,s + subroutine omega_stepper(omega_n, ang_accel, dt, omega_n1) + real(mytype),intent(in) :: omega_n(4), ang_accel(4), dt + real(mytype),intent(out):: omega_n1(4) + + omega_n1 = omega_n + ang_accel * dt - ! n=dx*nx+dy*ny+dz*nz ! normal projection - ! t=dx*tx+dy*ty+dz*tz ! Chordwise projection - ! s=dx*sx+dy*sy+dz*sz ! Spanwise projection + end subroutine omega_stepper - ! if (abs(s)<=es) then - ! AnIsoKernel = exp_prec(-((n/et)**2.0+(t/ec)**2.0))/(ec*et*pi) - ! else - ! AnIsoKernel = zero - ! endif + 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_prec(mag*dt*half) + if (mag.gt.zero) then + im_sc = sin_prec(mag*dt*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 function AnIsoKernel + end subroutine orientation_stepper - ! !******************************************************************************* - ! ! - ! integer function FindMinimum(x,Start,End) - ! ! - ! !******************************************************************************* + 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 + + - ! implicit none - ! integer, dimension(1:), intent(in) :: x - ! integer, intent(in) :: Start, End - ! integer :: Minimum - ! integer :: Location - ! integer :: i - - ! minimum = x(start) - ! Location = Start - ! do i=start+1,End - ! if (x(i) < Minimum) then - ! Minimum = x(i) - ! Location = i - ! endif - ! enddo - ! FindMinimum = Location - - ! end function FindMinimum + 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) - ! !******************************************************************************* - ! ! - ! subroutine swap(a,b) - ! ! - ! !******************************************************************************* + 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) - ! implicit none - ! integer, intent(inout) :: a,b - ! integer :: Temp + end subroutine accel_get - ! Temp = a - ! a = b - ! b = Temp - ! end subroutine swap - ! !******************************************************************************* - ! ! - ! subroutine sort(x,size) - ! ! - ! !******************************************************************************* + subroutine ang_half_step(q, omega_q, torque, q_new, o_new) + use param + real(mytype),intent(in) :: q(4),omega_q(4),torque(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) - ! implicit none - ! integer, dimension(1:), intent(inout) :: x - ! integer, intent(in) :: size - ! integer :: i - ! integer :: Location + call lab_to_body(omega_q,q,omega_b) + torque_q(1)=zero + torque_q(2:4)=torque - ! do i=1,Size-1 - ! location=FindMinimum(x,i,size) - ! call swap(x(i),x(Location)) - ! enddo + call lab_to_body(torque_q,q,torque_b) - ! end subroutine sort + call accel_get(omega_b, inertia, torque_b, ang_accel_b) - ! !******************************************************************************* - ! ! - ! function dirname(number) - ! ! - ! !******************************************************************************* + 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) - ! integer, intent(in) :: number - ! character(len=6) :: dirname + 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) - ! ! Cast the (rounded) number to string using 6 digits and leading zeros - ! write (dirname, '(I6.1)') number - ! ! This is the same w/o leading zeros - ! !write (dirname, '(I6)') nint(number) - ! ! This is for one digit (no rounding) - ! !write (dirname, '(F4.1)') number + q_new=q_half_predict + o_new=omega_n_half - ! end function dirname + end subroutine ang_half_step - ! !******************************************************************************* - ! ! - ! function outdirname(number) - ! ! - ! !******************************************************************************* + subroutine ang_full_step(q,omega_q,q_half,omega_n_half,torque,q_full,omega_full) + use param + real(mytype),intent(in) :: q(4),omega_q(4),q_half(4),omega_n_half(4),torque(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) - ! integer, intent(in) :: number - ! character(len=6) :: outdirname + call lab_to_body(omega_q, q, omega_b) + call lab_to_body(omega_n_half,q_half,omega_n_half_b) - ! ! Cast the (rounded) number to string using 6 digits and leading zeros - ! write (outdirname, '(I6.1)') number - ! ! This is the same w/o leading zeros - ! !write (dirname, '(I6)') nint(number) - ! ! This is for one digit (no rounding) - ! !write (dirname, '(F4.1)') number - - ! end function outdirname + torque_q(1)=zero + torque_q(2:4)=torque + call lab_to_body(torque_q,q_half,torque_b) - ! !******************************************************************************* - ! ! - ! character(20) function int2str(num) - ! ! - ! !******************************************************************************* + 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) - ! integer, intent(in) ::num - ! character(20) :: str + call orientation_stepper(q,omega_n_half2,dt,q_full) - ! ! convert integer to string using formatted write - ! write(str, '(i20)') num - ! int2str = adjustl(str) + 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 function int2str + end subroutine ang_full_step end module ellipsoid_utils From 444a97d9854e5d2bc80ff2913b9f2164c68350e0 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 21 Sep 2023 18:42:15 +0200 Subject: [PATCH 015/125] adding linear solid time step --- src/ellip_utils.f90 | 8 ++++++++ src/module_param.f90 | 3 ++- src/navier.f90 | 8 +++++++- src/xcompact3d.f90 | 6 ++++++ 4 files changed, 23 insertions(+), 2 deletions(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 2a1e330e2..32ed16ee2 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -446,4 +446,12 @@ subroutine ang_full_step(q,omega_q,q_half,omega_n_half,torque,q_full,omega_full) end subroutine ang_full_step + subroutine lin_step(position,linearVelocity,linearAcceleration,time_step,position_1,linearVelocity_1) + real(mytype),intent(in) :: position(3),linearVelocity(3),linearAcceleration(3),time_step + real(mytype),intent(out) :: position_1(3),linearVelocity_1(3) + + position_1(:) = position(:) + time_step*linearVelocity(:) + linearVelocity_1 = linearVelocity(:) + time_step*linearAcceleration(:) + + end subroutine lin_step end module ellipsoid_utils diff --git a/src/module_param.f90 b/src/module_param.f90 index 21109d27e..7a0779692 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -618,7 +618,8 @@ end module simulation_stats module ibm_param use decomp_2d, only : mytype real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads, c_air - real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(3),shape(3) + real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(3),linearAcceleration(3),shape(3) + real(mytype) :: position_1(3),linearVelocity_1(3) real(mytype) :: chord,thickness,omega integer :: inana ! Analytical BC as Input integer :: imove diff --git a/src/navier.f90 b/src/navier.f90 index de656383b..ee7b04889 100644 --- a/src/navier.f90 +++ b/src/navier.f90 @@ -264,6 +264,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 @@ -276,7 +277,7 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) !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) :: pp3 - + real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ep1_ux,ep1_uy,ep1_uz integer :: nvect3,i,j,k,nlock integer :: code real(mytype) :: tmax,tmoy,tmax1,tmoy1 @@ -287,6 +288,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(position, linearVelocity, angularVelocity,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(:,:,:)*lvx tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*lvy diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 736ec4b06..3af729dd3 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -16,6 +16,7 @@ program xcompact3d use ibm_param use ibm, only : body use genepsi, only : genepsi3d + use ellipsoid_utils, only: lin_step implicit none @@ -75,6 +76,11 @@ program xcompact3d call test_flow(rho1,ux1,uy1,uz1,phi1,ep1,drho1,divu3) + call lin_step(position,linearVelocity,linearAcceleration,dt,position_1,linearVelocity_1) + + position = position_1 + linearVelocity = linearVelocity_1 + enddo !! End sub timesteps call restart(ux1,uy1,uz1,dux1,duy1,duz1,ep1,pp3(:,:,:,1),phi1,dphi1,px1,py1,pz1,rho1,drho1,mu1,1) From 86a5afdf5444d828198ddba4f41bfb8d545fe134 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Thu, 21 Sep 2023 21:59:28 +0100 Subject: [PATCH 016/125] rotational boundary conditions working! (I think) --- src/BC-Ellipsoid.f90 | 49 ++++++++++++---------- src/ellip_utils.f90 | 97 +++++++++++++++++++++++++++++++++++++++++--- src/module_param.f90 | 6 +-- src/parameters.f90 | 5 ++- src/tools.f90 | 3 ++ src/xcompact3d.f90 | 16 +++++++- 6 files changed, 144 insertions(+), 32 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 7da85bea9..9df6e2b5b 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -22,7 +22,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) use param, only : one, two, ten use ibm_param use dbg_schemes, only: sqrt_prec - use ellipsoid_utils, only: EllipsoidalRadius, NormalizeQuaternion + use ellipsoid_utils, only: NormalizeQuaternion, is_inside_ellipsoid implicit none @@ -36,6 +36,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) 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) @@ -54,16 +55,16 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) ! 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] + ! 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] ! @@ -78,11 +79,12 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) do i=nxi,nxf xm=real(i-1,mytype)*dx point=[xm, ym, zm] - call EllipsoidalRadius(point, position, orientation, shape, r) + ! call EllipsoidalRadius(point, position, orientation, shape, r) + call is_inside_ellipsoid(point, position, orientation, shape, ra, zeromach, is_inside) ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) - if (r-ra.gt.zeromach) then + if (.not.is_inside) then ! write(*,*) i, j, k cycle endif @@ -230,7 +232,7 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) USE MPI USE ibm_param use dbg_schemes, only: exp_prec - use ellipsoid_utils, only: NormalizeQuaternion + use ellipsoid_utils, only: NormalizeQuaternion,ellipInertiaCalculate implicit none @@ -248,13 +250,18 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) call NormalizeQuaternion(orientation) position=[cex,cey,cez] linearVelocity=[lvx,lvy,lvz] - angularVelocity=[avx,avy,avz] - - write(*,*) 'set shape = ', shape - write(*,*) 'set orientation = ', orientation - write(*,*) 'set position = ', position - write(*,*) 'set linear velocity = ', linearVelocity - write(*,*) 'set angular velocity = ', angularVelocity + angularVelocity=[zero,avx,avy,avz] + call ellipInertiaCalculate(shape,rho_s,inertia) + + 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 diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 32ed16ee2..1e5ab49b0 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -242,6 +242,18 @@ subroutine CalculatePointVelocity(point, center, linearVelocity, angularVelocity pointVelocity = crossed + linearVelocity end subroutine CalculatePointVelocity + 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(center, linearVelocity, angularVelocity, ep1, ep1_x, ep1_y, ep1_z) use param use decomp_2d @@ -379,6 +391,7 @@ subroutine accel_get(omega, inertia, torque_b, ang_accel) real(mytype),intent(out) :: ang_accel(4) real(mytype) :: inertia_inv(3,3),omega_v(3),torque_v(3),test(3),crossed(3) + ! write(*,*) 'inverting ', inertia call invert_3x3_matrix(inertia,inertia_inv) omega_v=omega(2:4) torque_v=torque_b(2:4) @@ -390,9 +403,9 @@ end subroutine accel_get - subroutine ang_half_step(q, omega_q, torque, q_new, o_new) + 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(3) + 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) @@ -401,7 +414,7 @@ subroutine ang_half_step(q, omega_q, torque, q_new, o_new) call lab_to_body(omega_q,q,omega_b) torque_q(1)=zero - torque_q(2:4)=torque + torque_q(2:4)=torque_vec(:) call lab_to_body(torque_q,q,torque_b) @@ -420,9 +433,9 @@ subroutine ang_half_step(q, omega_q, torque, q_new, o_new) end subroutine ang_half_step - subroutine ang_full_step(q,omega_q,q_half,omega_n_half,torque,q_full,omega_full) + 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(3) + 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) @@ -433,7 +446,7 @@ subroutine ang_full_step(q,omega_q,q_half,omega_n_half,torque,q_full,omega_full) call lab_to_body(omega_n_half,q_half,omega_n_half_b) torque_q(1)=zero - torque_q(2:4)=torque + 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) @@ -446,6 +459,41 @@ subroutine ang_full_step(q,omega_q,q_half,omega_n_half,torque,q_full,omega_full) end subroutine ang_full_step + subroutine ang_step(q,omega_q,torque_vec,time_step,q1,omega1) + use param + use ibm_param + real(mytype),intent(in) :: q(4),omega_q(4),torque_vec(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,linearAcceleration,time_step,position_1,linearVelocity_1) real(mytype),intent(in) :: position(3),linearVelocity(3),linearAcceleration(3),time_step real(mytype),intent(out) :: position_1(3),linearVelocity_1(3) @@ -454,4 +502,41 @@ subroutine lin_step(position,linearVelocity,linearAcceleration,time_step,positio 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 + end module ellipsoid_utils diff --git a/src/module_param.f90 b/src/module_param.f90 index 7a0779692..e375dddb0 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -617,9 +617,9 @@ end module simulation_stats !############################################################################ module ibm_param use decomp_2d, only : mytype - real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads, c_air - real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(3),linearAcceleration(3),shape(3) - real(mytype) :: position_1(3),linearVelocity_1(3) + real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,c_air + real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(4),linearAcceleration(3),torque(3),shape(3),inertia(3,3) + real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega integer :: inana ! Analytical BC as Input integer :: imove diff --git a/src/parameters.f90 b/src/parameters.f90 index 6ed4b579d..3dbc63d09 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -60,7 +60,7 @@ subroutine parameter(input_i3d) NAMELIST /LESModel/ jles, smagcst, smagwalldamp, nSmag, walecst, maxdsmagcst, iwall NAMELIST /WallModel/ smagwalldamp NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl - NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,nobjmax,nraf,nvol,iforces, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads, c_air + NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,nobjmax,nraf,nvol,iforces, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads,rho_s, c_air 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, & @@ -571,6 +571,7 @@ subroutine parameter_defaults() use probes, only : nprobes, flag_all_digits, flag_extra_probes use visu, only : output2D use forces, only : iforces, nvol + use ibm_param, only : oriw,rho_s implicit none @@ -610,6 +611,8 @@ subroutine parameter_defaults() wrotation = zero irotation = 0 itest=1 + oriw=one + rho_s=one !! Gravity field gravx = zero diff --git a/src/tools.f90 b/src/tools.f90 index 13f352331..8088d224b 100644 --- a/src/tools.f90 +++ b/src/tools.f90 @@ -143,6 +143,7 @@ subroutine simu_stats(iwhen) use simulation_stats use var use MPI + use ibm_param, only: position,orientation implicit none @@ -160,6 +161,8 @@ subroutine simu_stats(iwhen) call cpu_time(time1) write(*,*) '===========================================================' write(*,"(' Time step =',i7,'/',i7,', Time unit =',F9.4)") itime,ilast,t + write(*,*) 'Centroid position = ',real(position(1),4),real(position(2),4),real(position(3),4) + write(*,*) 'Orientation = ',real(orientation(1),4),real(orientation(2),4),real(orientation(3),4),real(orientation(4),4) endif else if ((iwhen == 3).and.(itime > ifirst)) then !AT THE END OF A TIME STEP if (nrank == 0.and.(mod(itime, ilist) == 0 .or. itime == ifirst .or. itime==ilast)) then diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 3af729dd3..6e97086bc 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -16,7 +16,7 @@ program xcompact3d use ibm_param use ibm, only : body use genepsi, only : genepsi3d - use ellipsoid_utils, only: lin_step + use ellipsoid_utils, only: lin_step, ang_step implicit none @@ -76,11 +76,25 @@ program xcompact3d call test_flow(rho1,ux1,uy1,uz1,phi1,ep1,drho1,divu3) + !Add force calculation here + + linearAcceleration(:)=zero + torque(:)=zero + call lin_step(position,linearVelocity,linearAcceleration,dt,position_1,linearVelocity_1) + call ang_step(orientation,angularVelocity,torque,dt,orientation_1,angularVelocity_1) position = position_1 linearVelocity = linearVelocity_1 + orientation = orientation_1 + angularVelocity = angularVelocity_1 + + ! if (nrank==0) then + ! write(*,*) 'Centroid position is ', position + ! write(*,*) 'Orientation is ', orientation + ! end if + enddo !! End sub timesteps call restart(ux1,uy1,uz1,dux1,duy1,duz1,ep1,pp3(:,:,:,1),phi1,dphi1,px1,py1,pz1,rho1,drho1,mu1,1) From 7dfb98ba04a9f6aa943788ceec1e27c525fa6101 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 4 Oct 2023 17:37:49 +0100 Subject: [PATCH 017/125] started control volume changes --- src/forces.f90 | 58 +++++++++++++++++++++++++++++++++++--------- src/forces_draft.f90 | 0 2 files changed, 47 insertions(+), 11 deletions(-) create mode 100644 src/forces_draft.f90 diff --git a/src/forces.f90 b/src/forces.f90 index 2d0952dfa..bf906e435 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -17,11 +17,13 @@ module forces implicit none integer :: nvol,iforces - real(mytype),save,allocatable,dimension(:,:,:) :: ux01, uy01, ux11, uy11, ppi1 - real(mytype),allocatable,dimension(:) :: xld,xrd,yld,yud - integer,allocatable,dimension(:) :: icvlf,icvrt,jcvlw,jcvup - integer,allocatable,dimension(:) :: icvlf_lx,icvrt_lx,icvlf_ly,icvrt_ly - integer,allocatable,dimension(:) :: jcvlw_lx,jcvup_lx,jcvlw_ly,jcvup_ly + 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 + character(len=*), parameter :: io_restart_forces = "restart-forces-io", & resfile = "restart-forces" @@ -43,16 +45,34 @@ 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)) - 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)) - + 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)) + + ! 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!!) @@ -82,10 +102,22 @@ 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)) + 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 @@ -104,6 +136,8 @@ subroutine init_forces 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 @@ -113,7 +147,9 @@ 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 subroutine restart_forces(itest1) diff --git a/src/forces_draft.f90 b/src/forces_draft.f90 new file mode 100644 index 000000000..e69de29bb From b85a3864359835c83fc20216092563e7313803c7 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 4 Oct 2023 18:17:44 +0100 Subject: [PATCH 018/125] force calc --- src/forces_draft.f90 | 919 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 919 insertions(+) diff --git a/src/forces_draft.f90 b/src/forces_draft.f90 index e69de29bb..59a74ad26 100644 --- a/src/forces_draft.f90 +++ b/src/forces_draft.f90 @@ -0,0 +1,919 @@ +!################################################################################ +!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) + uz01(i,j,k)=uz1(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 From abab88a7a84e6e4f89cfe9b4525fed180ec5f14c Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Thu, 5 Oct 2023 21:12:01 +0100 Subject: [PATCH 019/125] 3d control vol --- src/BC-Cylinder.f90 | 39 ++--- src/BC-Ellipsoid.f90 | 3 +- src/ellip_utils.f90 | 25 ++-- src/forces.f90 | 342 ++++++++++++++++++++++++++++++++++++++----- src/module_param.f90 | 4 +- src/navier.f90 | 6 +- src/tools.f90 | 5 +- src/xcompact3d.f90 | 25 +++- 8 files changed, 357 insertions(+), 92 deletions(-) diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index 8e9057ec9..986b249c4 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -39,7 +39,6 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) real(mytype) :: xm,ym,zm,r,rads2,kcon real(mytype) :: zeromach real(mytype) :: cexx,ceyy,cezz,dist_axi - real(mytype) :: point(3) zeromach=one do while ((one + zeromach / two) .gt. one) @@ -47,10 +46,6 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) end do zeromach = ten*zeromach - ! orientation=[oriw, orii, orij, orik] - call NormalizeQuaternion(orientation) - ! shape=[shx, shy, shz] - ! write(*,*) shape, 'SHAPE' ! Intitialise epsi @@ -67,7 +62,6 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) ceyy=cey cezz=cez endif - position=[cexx,ceyy,cezz] ! write(*,*) position ! ce=[cexx, ceyy, cezz] ! @@ -81,18 +75,11 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) ym=yp(j) do i=nxi,nxf xm=real(i-1,mytype)*dx - point=[xm, ym, zm] - call EllipsoidalRadius(point, position, orientation, shape, r) - ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) - ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) - + r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) if (r-ra.gt.zeromach) then - ! write(*,*) i, j, k cycle endif - ! write(*,*) i, j, k, zm epsi(i,j,k)=remp - ! write(*,*) remp enddo enddo enddo @@ -245,20 +232,20 @@ subroutine init_cyl (ux1,uy1,uz1,phi1) real(mytype) :: y,um,eqr integer :: k,j,i,ii,is,code - eqr=(shx*shy*shz)**(1.0/3.0) - shape=[shx/eqr,shy/eqr,shz/eqr] + ! eqr=(shx*shy*shz)**(1.0/3.0) + ! shape=[shx/eqr,shy/eqr,shz/eqr] - orientation=[oriw,orii,orij,orik] - call NormalizeQuaternion(orientation) - position=[cex,cey,cez] - linearVelocity=[lvx,lvy,lvz] - angularVelocity=[avx,avy,avz] + ! orientation=[oriw,orii,orij,orik] + ! call NormalizeQuaternion(orientation) + ! position=[cex,cey,cez] + ! linearVelocity=[lvx,lvy,lvz] + ! angularVelocity=[avx,avy,avz] - write(*,*) 'set shape = ', shape - write(*,*) 'set orientation = ', orientation - write(*,*) 'set position = ', position - write(*,*) 'set linear velocity = ', linearVelocity - write(*,*) 'set angular velocity = ', angularVelocity + ! write(*,*) 'set shape = ', shape + ! write(*,*) 'set orientation = ', orientation + ! write(*,*) 'set position = ', position + ! write(*,*) 'set linear velocity = ', linearVelocity + ! write(*,*) 'set angular velocity = ', angularVelocity if (iscalar==1) then diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 9df6e2b5b..51877f7be 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -232,7 +232,7 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) USE MPI USE ibm_param use dbg_schemes, only: exp_prec - use ellipsoid_utils, only: NormalizeQuaternion,ellipInertiaCalculate + use ellipsoid_utils, only: NormalizeQuaternion,ellipInertiaCalculate,ellipMassCalculate implicit none @@ -252,6 +252,7 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) linearVelocity=[lvx,lvy,lvz] angularVelocity=[zero,avx,avy,avz] call ellipInertiaCalculate(shape,rho_s,inertia) + call ellipMassCalculate(shape,rho_s,ellip_m) if (nrank==0) then write(*,*) 'set shape = ', shape diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 1e5ab49b0..ddd6a77bd 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -314,11 +314,11 @@ subroutine lab_to_body(p_lab, q, p_body) end subroutine lab_to_body - subroutine omega_stepper(omega_n, ang_accel, dt, omega_n1) - real(mytype),intent(in) :: omega_n(4), ang_accel(4), dt + 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 * dt + omega_n1 = omega_n + ang_accel * time_step end subroutine omega_stepper @@ -329,9 +329,9 @@ subroutine orientation_stepper(q1, omega_q, time_step, q_n1) real(mytype) :: mag, re_part, im_sc, im_part(3), omega_n1(4) call QuaternionNorm(omega_q, mag) - re_part=cos_prec(mag*dt*half) + re_part=cos_prec(mag*time_step*half) if (mag.gt.zero) then - im_sc = sin_prec(mag*dt*half)/mag + im_sc = sin_prec(mag*time_step*half)/mag else im_sc = zero endif @@ -389,7 +389,7 @@ 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) + 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) @@ -397,7 +397,9 @@ subroutine accel_get(omega, inertia, torque_b, ang_accel) 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) + 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 @@ -461,7 +463,7 @@ end subroutine ang_full_step subroutine ang_step(q,omega_q,torque_vec,time_step,q1,omega1) use param - use ibm_param + use ibm_param, only: inertia real(mytype),intent(in) :: q(4),omega_q(4),torque_vec(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) @@ -494,10 +496,13 @@ subroutine ang_step(q,omega_q,torque_vec,time_step,q1,omega1) end subroutine ang_step - subroutine lin_step(position,linearVelocity,linearAcceleration,time_step,position_1,linearVelocity_1) - real(mytype),intent(in) :: position(3),linearVelocity(3),linearAcceleration(3),time_step + subroutine lin_step(position,linearVelocity,linearForce,time_step,position_1,linearVelocity_1) + use ibm_param, only: ellip_m + real(mytype),intent(in) :: position(3),linearVelocity(3),linearForce(3),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(:) diff --git a/src/forces.f90 b/src/forces.f90 index bf906e435..7975545bb 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -212,7 +212,7 @@ subroutine restart_forces(itest1) end subroutine restart_forces - subroutine force(ux1,uy1,ep1) + subroutine force(ux1,uy1,uz1,ep1) USE param USE variables @@ -220,40 +220,62 @@ subroutine force(ux1,uy1,ep1) USE MPI USE ibm_param - use var, only : ta1, tb1, tc1, td1, di1 - use var, only : ux2, uy2, ta2, tb2, tc2, td2, di2 - + 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)),intent(in) :: ux1, uy1 + 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(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), dimension(ny-1) :: del_y - real(mytype), dimension(nz) :: tunstxl, tunstyl - real(mytype), dimension(nz) :: tconvxl,tconvyl + 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 + real(mytype), dimension(nz) :: tdiffxl,tdiffyl,tdiffzl - real(mytype), dimension(nz) :: tunstx, tunsty - real(mytype), dimension(nz) :: tconvx,tconvy + 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) :: uxmid,uymid,prmid - real(mytype) :: dudxmid,dudymid,dvdxmid,dvdymid - real(mytype) :: fac,tsumx,tsumy - real(mytype) :: fcvx,fcvy,fprx,fpry,fdix,fdiy - real(mytype) :: xmom,ymom + + + 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 + nvect1=xsize(1)*xsize(2)*xsize(3) nvect2=ysize(1)*ysize(2)*ysize(3) @@ -273,6 +295,7 @@ subroutine force(ux1,uy1,ep1) 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 @@ -283,6 +306,7 @@ subroutine force(ux1,uy1,ep1) 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 @@ -291,18 +315,40 @@ subroutine force(ux1,uy1,ep1) 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 !***************************************************************** @@ -321,9 +367,11 @@ subroutine force(ux1,uy1,ep1) tunstxl=zero tunstyl=zero + tunstzl=zero do k=1,xsize(3) 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, @@ -339,13 +387,18 @@ subroutine force(ux1,uy1,ep1) 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 + + 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 @@ -358,14 +411,34 @@ subroutine force(ux1,uy1,ep1) !!$! \ \__\ \ !!$! \ \ !!$! \ CV \ -!!$!(jcvlw) A____________D +!!$!(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 @@ -374,34 +447,47 @@ subroutine force(ux1,uy1,ep1) 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)) - fcvx = fcvx -uxmid*uymid*dx - fcvy = fcvy -uymid*uymid*dx + 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 + 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)) - fdix = fdix -(xnu*(dudymid+dvdxmid)*dx) - fdiy = fdiy -two*xnu*dvdymid*dx + 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 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 @@ -411,33 +497,47 @@ subroutine force(ux1,uy1,ep1) 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)) - fcvx= fcvx +uxmid*uymid*dx - fcvy= fcvy +uymid*uymid*dx + 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 + 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)) - fdix = fdix +(xnu*(dudymid+dvdxmid)*dx) - fdiy = fdiy +two*xnu*dvdymid*dx + 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 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 @@ -448,32 +548,46 @@ subroutine force(ux1,uy1,ep1) kk=ystart(3)-1+k fcvx=zero fcvy=zero + fcvz=zero fprx=zero fdix=zero fdiy=zero + fdiz=zero 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)) - fcvx= fcvx -uxmid*uxmid*del_y(j) - fcvy= fcvy -uxmid*uymid*del_y(j) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) + + 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) + 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)) - fdix = fdix -two*xnu*dudxmid*del_y(j) - fdiy = fdiy -xnu*(dvdxmid+dudymid)*del_y(j) + 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 @@ -483,50 +597,198 @@ subroutine force(ux1,uy1,ep1) kk=ystart(3)-1+k fcvx=zero fcvy=zero + fcvz=zero fprx=zero fdix=zero fdiy=zero + fdiz=zero 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)) - fcvx= fcvx +uxmid*uxmid*del_y(j) - fcvy= fcvy +uxmid*uymid*del_y(j) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) + + 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) + 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)) - fdix = fdix +two*xnu*dudxmid*del_y(j) - fdiy = fdiy +xnu*(dvdxmid+dudymid)*del_y(j) + 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 + + !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) + + 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) + 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) 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 diff --git a/src/module_param.f90 b/src/module_param.f90 index e375dddb0..8e0224607 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -617,8 +617,8 @@ end module simulation_stats !############################################################################ module ibm_param use decomp_2d, only : mytype - real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,c_air - real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(4),linearAcceleration(3),torque(3),shape(3),inertia(3,3) + real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air + real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(4),linearAcceleration(3),linearForce(3),torque(3),shape(3),inertia(3,3) real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega integer :: inana ! Analytical BC as Input diff --git a/src/navier.f90 b/src/navier.f90 index ee7b04889..534f77543 100644 --- a/src/navier.f90 +++ b/src/navier.f90 @@ -294,9 +294,9 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*ep1_uy(:,:,:) tc1(:,:,:) = (one - ep1(:,:,:)) * uz1(:,:,:) + ep1(:,:,:)*ep1_uz(:,:,:) else - ta1(:,:,:) = (one - ep1(:,:,:)) * ux1(:,:,:) + ep1(:,:,:)*lvx - tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*lvy - tc1(:,:,:) = (one - ep1(:,:,:)) * uz1(:,:,:) + ep1(:,:,:)*lvz + ta1(:,:,:) = (one - ep1(:,:,:)) * ux1(:,:,:) + ep1(:,:,:)*ubcx + tb1(:,:,:) = (one - ep1(:,:,:)) * uy1(:,:,:) + ep1(:,:,:)*ubcy + tc1(:,:,:) = (one - ep1(:,:,:)) * uz1(:,:,:) + ep1(:,:,:)*ubcz endif !WORK X-PENCILS diff --git a/src/tools.f90 b/src/tools.f90 index 8088d224b..1ae2ed1e5 100644 --- a/src/tools.f90 +++ b/src/tools.f90 @@ -143,7 +143,7 @@ subroutine simu_stats(iwhen) use simulation_stats use var use MPI - use ibm_param, only: position,orientation + use ibm_param, only: position,orientation,angularVelocity implicit none @@ -163,7 +163,8 @@ subroutine simu_stats(iwhen) write(*,"(' Time step =',i7,'/',i7,', Time unit =',F9.4)") itime,ilast,t write(*,*) 'Centroid position = ',real(position(1),4),real(position(2),4),real(position(3),4) write(*,*) 'Orientation = ',real(orientation(1),4),real(orientation(2),4),real(orientation(3),4),real(orientation(4),4) - endif + write(*,*) 'Angular velocity = ', real(angularVelocity(1),4),real(angularVelocity(2),4),real(angularVelocity(3),4),real(angularVelocity(4),4) + endif else if ((iwhen == 3).and.(itime > ifirst)) then !AT THE END OF A TIME STEP if (nrank == 0.and.(mod(itime, ilist) == 0 .or. itime == ifirst .or. itime==ilast)) then call cpu_time(trank) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 6e97086bc..52a206fa2 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -16,9 +16,10 @@ program xcompact3d use ibm_param use ibm, only : body use genepsi, only : genepsi3d - use ellipsoid_utils, only: lin_step, ang_step + use ellipsoid_utils, only: lin_step, ang_step, QuaternionNorm implicit none + real(mytype) :: dummy call init_xcompact3d() @@ -78,17 +79,25 @@ program xcompact3d !Add force calculation here - linearAcceleration(:)=zero + linearForce(:)=zero torque(:)=zero - call lin_step(position,linearVelocity,linearAcceleration,dt,position_1,linearVelocity_1) - call ang_step(orientation,angularVelocity,torque,dt,orientation_1,angularVelocity_1) + if (nrank==0) then - position = position_1 - linearVelocity = linearVelocity_1 + call lin_step(position,linearVelocity,linearForce,dt,position_1,linearVelocity_1) + call ang_step(orientation,angularVelocity,torque,dt,orientation_1,angularVelocity_1) - orientation = orientation_1 - angularVelocity = angularVelocity_1 + position = position_1 + linearVelocity = linearVelocity_1 + + orientation = orientation_1 + angularVelocity = angularVelocity_1 + + call QuaternionNorm(angularVelocity,dummy) + + write(*,*) 'Norm of angvel = ', dummy + + endif ! if (nrank==0) then ! write(*,*) 'Centroid position is ', position From 1b3e698a05970bdb45ccde26cfe431c86369d0f9 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Sun, 8 Oct 2023 20:58:10 +0100 Subject: [PATCH 020/125] finishing cvs --- Makefile | 2 +- src/case.f90 | 3 ++- src/forces.f90 | 11 +++++++++-- src/forces_draft.f90 | 1 - src/module_param.f90 | 2 +- src/parameters.f90 | 5 +++-- src/xcompact3d.f90 | 16 +++++++++++++--- 7 files changed, 29 insertions(+), 11 deletions(-) diff --git a/Makefile b/Makefile index 728bc7831..5bf421801 100644 --- a/Makefile +++ b/Makefile @@ -55,7 +55,7 @@ SRCDECOMP = $(DECOMPDIR)/decomp_2d.f90 $(DECOMPDIR)/glassman.f90 $(DECOMPDIR)/ff 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 $(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)/constants.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 +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########## diff --git a/src/case.f90 b/src/case.f90 index a089f0d8b..dc34b2769 100644 --- a/src/case.f90 +++ b/src/case.f90 @@ -307,6 +307,7 @@ subroutine postprocess_case(rho,ux,uy,uz,pp,phi,ep) real(mytype),dimension(xsize(1),xsize(2),xsize(3),nrhotime) :: rho real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ep real(mytype), dimension(ph1%zst(1):ph1%zen(1), ph1%zst(2):ph1%zen(2), nzmsize, npress), intent(in) :: pp + real(mytype) :: dummy1,dummy2,dummy3 if (itype.eq.itype_user) then @@ -367,7 +368,7 @@ subroutine postprocess_case(rho,ux,uy,uz,pp,phi,ep) endif if (iforces.eq.1) then - call force(ux,uy,ep) + call force(ux,uy,uz,ep,dummy1,dummy2,dummy3) call restart_forces(1) endif diff --git a/src/forces.f90 b/src/forces.f90 index 7975545bb..2d2e30ec7 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -163,7 +163,7 @@ subroutine restart_forces(itest1) implicit none integer :: ierror,code,itest1 - integer :: ierror_o=0 !error to open sauve file during restart + integer :: ierror_o=0 !error to open save file during restart character(len=30) :: filename, filestart @@ -212,7 +212,7 @@ subroutine restart_forces(itest1) end subroutine restart_forces - subroutine force(ux1,uy1,uz1,ep1) + subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) USE param USE variables @@ -233,6 +233,7 @@ subroutine force(ux1,uy1,uz1,ep1) 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), intent(out) :: xDrag_tot,yLift_tot,zLat_tot real(mytype), dimension(ysize(1),ysize(2),ysize(3)) :: ppi2 real(mytype), dimension(zsize(1),zsize(2),zsize(3)) :: ppi3 @@ -796,6 +797,10 @@ subroutine force(ux1,uy1,uz1,ep1) 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 ! if (nrank .eq. 0) then ! write(filename,"('aerof',I1.1)") iv @@ -819,8 +824,10 @@ subroutine force(ux1,uy1,uz1,ep1) 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 diff --git a/src/forces_draft.f90 b/src/forces_draft.f90 index 59a74ad26..e02ca9511 100644 --- a/src/forces_draft.f90 +++ b/src/forces_draft.f90 @@ -899,7 +899,6 @@ subroutine force(ux1,uy1,uz1,ep1) 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 diff --git a/src/module_param.f90 b/src/module_param.f90 index 8e0224607..e3230977b 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -617,7 +617,7 @@ end module simulation_stats !############################################################################ module ibm_param use decomp_2d, only : mytype - real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air + real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air,cvl_scalar real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(4),linearAcceleration(3),linearForce(3),torque(3),shape(3),inertia(3,3) real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega diff --git a/src/parameters.f90 b/src/parameters.f90 index 3dbc63d09..54d1b3e20 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -60,7 +60,7 @@ subroutine parameter(input_i3d) NAMELIST /LESModel/ jles, smagcst, smagwalldamp, nSmag, walecst, maxdsmagcst, iwall NAMELIST /WallModel/ smagwalldamp NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl - NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,nobjmax,nraf,nvol,iforces, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads,rho_s, c_air + NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,nobjmax,nraf,nvol,iforces, cvl_scalar, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads,rho_s, c_air 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, & @@ -571,7 +571,7 @@ subroutine parameter_defaults() use probes, only : nprobes, flag_all_digits, flag_extra_probes use visu, only : output2D use forces, only : iforces, nvol - use ibm_param, only : oriw,rho_s + use ibm_param, only : oriw,rho_s,cvl_scalar implicit none @@ -613,6 +613,7 @@ subroutine parameter_defaults() itest=1 oriw=one rho_s=one + cvl_scalar=onepfive !! Gravity field gravx = zero diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 52a206fa2..0a47abc48 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -17,9 +17,9 @@ program xcompact3d use ibm, only : body use genepsi, only : genepsi3d use ellipsoid_utils, only: lin_step, ang_step, QuaternionNorm - + use forces, only : force, init_forces, iforces implicit none - real(mytype) :: dummy + real(mytype) :: dummy,drag,lift,lat call init_xcompact3d() @@ -48,6 +48,15 @@ program xcompact3d if (imove.eq.1) then ! update epsi for moving objects if ((iibm.eq.2).or.(iibm.eq.3)) then call genepsi3d(ep1) + if (iforces.eq.1) then + xld = position(1) - ra * cvl_scalar + xrd = position(1) + ra * cvl_scalar + yld = position(2) - ra * cvl_scalar + yud = position(2) + ra * cvl_scalar + zld = position(3) - ra * cvl_scalar + zrd = position(3) + ra * cvl_scalar + call init_forces() + endif else if (iibm.eq.1) then call body(ux1,uy1,uz1,ep1) endif @@ -78,8 +87,9 @@ program xcompact3d call test_flow(rho1,ux1,uy1,uz1,phi1,ep1,drho1,divu3) !Add force calculation here + call force(ux1,uy1,uz1,ep1,drag,lift,lat) - linearForce(:)=zero + linearForce=[drag,lift,lat] torque(:)=zero if (nrank==0) then From d5144822d6e638aa899901869edcf9a78c17053a Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Sun, 8 Oct 2023 20:59:33 +0100 Subject: [PATCH 021/125] added example input --- inputs/input.i3d | 157 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 157 insertions(+) create mode 100644 inputs/input.i3d 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 From 28e22270d81902517124c2dacc54fe798dd7b63f Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 9 Oct 2023 13:55:00 +0100 Subject: [PATCH 022/125] forces tweaks --- docs/pages/user_guide/parameters.rst | 2 +- src/forces.f90 | 12 +++++++++++- src/forces_draft.f90 | 22 +++++++++++----------- 3 files changed, 23 insertions(+), 13 deletions(-) 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/src/forces.f90 b/src/forces.f90 index 2d2e30ec7..3ae9db3e8 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -151,7 +151,17 @@ subroutine init_forces call decomp_2d_register_variable(io_restart_forces, "uz11", 1, 0, 0, mytype) end subroutine init_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 restart_forces(itest1) USE decomp_2d diff --git a/src/forces_draft.f90 b/src/forces_draft.f90 index e02ca9511..46ed16826 100644 --- a/src/forces_draft.f90 +++ b/src/forces_draft.f90 @@ -87,17 +87,17 @@ subroutine init_forces 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 + ! 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 !***************************************************************** From 706188ccb8c3903d51871a8cf2091efc438aca30 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 10 Oct 2023 14:50:57 +0100 Subject: [PATCH 023/125] corrected all vars to 3d version - still run problems --- src/BC-Ellipsoid.f90 | 12 ++++++------ src/ellip_utils.f90 | 5 ++++- src/forces.f90 | 26 ++++++++++++++------------ src/genepsi3d.f90 | 23 +++++++++++++++++++++++ src/parameters.f90 | 6 +++--- src/tools.f90 | 4 ++-- src/xcompact3d.f90 | 17 +++++++++-------- 7 files changed, 61 insertions(+), 32 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 51877f7be..740d2b77f 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -255,13 +255,13 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) 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 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 + write(*,*) 'density of solid = ', rho_s end if if (iscalar==1) then diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index ddd6a77bd..be167e60b 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -139,7 +139,10 @@ subroutine NormalizeQuaternion(quaternion) ! 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 normalizedQuaternion = quaternion / magnitude diff --git a/src/forces.f90 b/src/forces.f90 index 3ae9db3e8..516bb2219 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -18,7 +18,7 @@ module forces 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 + 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 @@ -59,7 +59,7 @@ subroutine init_forces 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)) + allocate(xld2(nvol), xrd2(nvol), yld2(nvol), yud2(nvol), zld2(nvol), zrd2(nvol)) ! if ((iibm.ne.0).and.(t.ne.0.)) then ! xld2(:) = xld(:) + (t-ifirst*dt)*ubcx @@ -71,6 +71,8 @@ subroutine init_forces xrd2(:) = xrd(:) yld2(:) = yld(:) yud2(:) = yud(:) + zld2(:) = zld(:) + zrd2(:) = zrd(:) ! endif ! Definition of the Control Volume @@ -151,7 +153,7 @@ subroutine init_forces call decomp_2d_register_variable(io_restart_forces, "uz11", 1, 0, 0, mytype) end subroutine init_forces - if ((iibm.ne.0).and.(t.ne.0.)) then +! 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 @@ -391,16 +393,16 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) ! 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 + tsumx = tsumx+fac*dx*del_y(j+(xstart(2)-1))*dz/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 + tsumy = tsumy+fac*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumy+fac*dx*dy/dt !sumy(k) = sumy(k)+dudt1*dx*dy 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 + tsumz = tsumz+fac*dx*del_y(j+(xstart(2)-1))*dz/dt enddo enddo tunstxl(xstart(3)-1+k)=tsumx @@ -794,12 +796,12 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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) + xmom = tunstx(k)+tconvx(k)+tconvx2(k) + ymom = tunsty(k)+tconvy(k)+tconvy2(k) + zmom = tunstz(k)+tconvz(k)+tconvz2(k) + xDrag(k) = two*(tdiffx(k)+tdiffx2(k)+tpresx(k)-xmom) + yLift(k) = two*(tdiffy(k)+tdiffy2(k)+tpresy(k)-ymom) + zLat(k) = two*(tdiffz(k)+tdiffz2(k)+tpresz(k)-zmom) enddo diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index f53b8a6a9..5b71f3e63 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -85,6 +85,26 @@ 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 + real(mytype) :: eqr + + eqr=(shx*shy*shz)**(1.0/3.0) + shape=[shx/eqr,shy/eqr,shz/eqr] + + orientation=[oriw,orii,orij,orik] + call NormalizeQuaternion(orientation) + position=[cex,cey,cez] + linearVelocity=[lvx,lvy,lvz] + angularVelocity=[zero,avx,avy,avz] + call ellipInertiaCalculate(shape,rho_s,inertia) + call ellipMassCalculate(shape,rho_s,ellip_m) + + end subroutine param_assign !############################################################################ subroutine genepsi3d(ep1) @@ -94,6 +114,7 @@ subroutine genepsi3d(ep1) USE complex_geometry use decomp_2d + implicit none !*****************************************************************! @@ -109,6 +130,8 @@ subroutine genepsi3d(ep1) ! logical :: dir_exists real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ep1 + + call param_assign() ! if (nrank==0.and.mod(itime,ilist)==0) then write(*,*)'===========================================================' diff --git a/src/parameters.f90 b/src/parameters.f90 index 54d1b3e20..6b2f3641d 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -29,7 +29,7 @@ subroutine parameter(input_i3d) use probes, only : nprobes, setup_probes, flag_all_digits, flag_extra_probes, xyzprobes use visu, only : output2D - use forces, only : iforces, nvol, xld, xrd, yld, yud!, zld, zrd + use forces, only : iforces, nvol, xld, xrd, yld, yud, zld, zrd implicit none @@ -61,7 +61,7 @@ subroutine parameter(input_i3d) NAMELIST /WallModel/ smagwalldamp NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,nobjmax,nraf,nvol,iforces, cvl_scalar, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads,rho_s, c_air - NAMELIST /ForceCVs/ xld, xrd, yld, yud!, zld, zrd + 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 @@ -116,7 +116,7 @@ subroutine parameter(input_i3d) read(10, nml=ProbesParam); rewind(10) endif if (iforces.eq.1) then - allocate(xld(nvol), xrd(nvol), yld(nvol), yud(nvol))!, zld(nvol), zrd(nvol)) + allocate(xld(nvol), xrd(nvol), yld(nvol), yud(nvol), zld(nvol), zrd(nvol)) read(10, nml=ForceCVs); rewind(10) endif diff --git a/src/tools.f90 b/src/tools.f90 index 1ae2ed1e5..5c45610af 100644 --- a/src/tools.f90 +++ b/src/tools.f90 @@ -162,8 +162,8 @@ subroutine simu_stats(iwhen) write(*,*) '===========================================================' write(*,"(' Time step =',i7,'/',i7,', Time unit =',F9.4)") itime,ilast,t write(*,*) 'Centroid position = ',real(position(1),4),real(position(2),4),real(position(3),4) - write(*,*) 'Orientation = ',real(orientation(1),4),real(orientation(2),4),real(orientation(3),4),real(orientation(4),4) - write(*,*) 'Angular velocity = ', real(angularVelocity(1),4),real(angularVelocity(2),4),real(angularVelocity(3),4),real(angularVelocity(4),4) + write(*,*) 'Orientation = ',real(orientation(1),4),real(orientation(2),4),real(orientation(3),4),real(orientation(4),4) + write(*,*) 'Angular velocity = ',real(angularVelocity(1),4),real(angularVelocity(2),4),real(angularVelocity(3),4),real(angularVelocity(4),4) endif else if ((iwhen == 3).and.(itime > ifirst)) then !AT THE END OF A TIME STEP if (nrank == 0.and.(mod(itime, ilist) == 0 .or. itime == ifirst .or. itime==ilast)) then diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 0a47abc48..7ab272aeb 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -17,7 +17,7 @@ program xcompact3d use ibm, only : body use genepsi, only : genepsi3d use ellipsoid_utils, only: lin_step, ang_step, QuaternionNorm - use forces, only : force, init_forces, iforces + use forces, only : force, init_forces, iforces, xld,xrd,yld,yud,zld,zrd implicit none real(mytype) :: dummy,drag,lift,lat @@ -49,12 +49,12 @@ program xcompact3d if ((iibm.eq.2).or.(iibm.eq.3)) then call genepsi3d(ep1) if (iforces.eq.1) then - xld = position(1) - ra * cvl_scalar - xrd = position(1) + ra * cvl_scalar - yld = position(2) - ra * cvl_scalar - yud = position(2) + ra * cvl_scalar - zld = position(3) - ra * cvl_scalar - zrd = position(3) + ra * cvl_scalar + xld(1) = position(1) - shape(1) * cvl_scalar + xrd(1) = position(1) + shape(1) * cvl_scalar + yld(1) = position(2) - shape(1) * cvl_scalar + yud(1) = position(2) + shape(1) * cvl_scalar + zld(1) = position(3) - shape(1) * cvl_scalar + zrd(1) = position(3) + shape(1) * cvl_scalar call init_forces() endif else if (iibm.eq.1) then @@ -163,7 +163,7 @@ subroutine init_xcompact3d() use ibm, only : body use probes, only : init_probes - +! use case, only : param_assign implicit none integer :: ierr @@ -231,6 +231,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) From 4af930f070b53149f8e1911e463fbab6b1fe0020 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 11 Oct 2023 12:47:12 +0100 Subject: [PATCH 024/125] formatting --- src/xcompact3d.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 7ab272aeb..f217f9933 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -49,12 +49,12 @@ program xcompact3d if ((iibm.eq.2).or.(iibm.eq.3)) then call genepsi3d(ep1) if (iforces.eq.1) then - xld(1) = position(1) - shape(1) * cvl_scalar - xrd(1) = position(1) + shape(1) * cvl_scalar - yld(1) = position(2) - shape(1) * cvl_scalar - yud(1) = position(2) + shape(1) * cvl_scalar - zld(1) = position(3) - shape(1) * cvl_scalar - zrd(1) = position(3) + shape(1) * cvl_scalar + xld(1) = position(1) - shape(1) * ra * cvl_scalar + xrd(1) = position(1) + shape(1) * ra * cvl_scalar + yld(1) = position(2) - shape(1) * ra * cvl_scalar + yud(1) = position(2) + shape(1) * ra * cvl_scalar + zld(1) = position(3) - shape(1) * ra * cvl_scalar + zrd(1) = position(3) + shape(1) * ra * cvl_scalar call init_forces() endif else if (iibm.eq.1) then From b2b2d4bd215d6f32a4986e24a46f0002d30fb71e Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Sat, 14 Oct 2023 19:57:40 +0100 Subject: [PATCH 025/125] added frame change util functions --- src/ellip_utils.f90 | 79 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 79 insertions(+) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index be167e60b..ce1aa0cbb 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -345,6 +345,85 @@ subroutine orientation_stepper(q1, omega_q, time_step, 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(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(1) = Omega(2)*r(3) - Omega(3)*r(2) + crossProduct(2) = Omega(3)*r(1) - Omega(1)*r(3) + crossProduct(3) = Omega(1)*r(2) - Omega(2)*r(1) + + ! Compute vR = vI - vO - Omega x r + vR(1) = vI(1) - vO(1) - crossProduct(1) + vR(2) = vI(2) - vO(2) - crossProduct(2) + vR(3) = vI(3) - vO(3) - crossProduct(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) From f1c45bfd993839bd58bc01280c9f0b8286e16c28 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 19 Oct 2023 13:55:54 +0100 Subject: [PATCH 026/125] checking all up to date --- src/tools.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/tools.f90 b/src/tools.f90 index 5c45610af..41295f49d 100644 --- a/src/tools.f90 +++ b/src/tools.f90 @@ -143,7 +143,7 @@ subroutine simu_stats(iwhen) use simulation_stats use var use MPI - use ibm_param, only: position,orientation,angularVelocity + use ibm_param, only: position,orientation implicit none @@ -163,8 +163,7 @@ subroutine simu_stats(iwhen) write(*,"(' Time step =',i7,'/',i7,', Time unit =',F9.4)") itime,ilast,t write(*,*) 'Centroid position = ',real(position(1),4),real(position(2),4),real(position(3),4) write(*,*) 'Orientation = ',real(orientation(1),4),real(orientation(2),4),real(orientation(3),4),real(orientation(4),4) - write(*,*) 'Angular velocity = ',real(angularVelocity(1),4),real(angularVelocity(2),4),real(angularVelocity(3),4),real(angularVelocity(4),4) - endif + endif else if ((iwhen == 3).and.(itime > ifirst)) then !AT THE END OF A TIME STEP if (nrank == 0.and.(mod(itime, ilist) == 0 .or. itime == ifirst .or. itime==ilast)) then call cpu_time(trank) From ae30af19efcde3d12bf1692cf8a1e80b307ebab2 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Fri, 20 Oct 2023 14:17:20 +0100 Subject: [PATCH 027/125] fixed memory allocation bug --- src/BC-Ellipsoid.f90 | 7 +++++-- src/forces.f90 | 10 ++++++++++ src/ibm.f90 | 4 ++-- src/xcompact3d.f90 | 2 +- 4 files changed, 18 insertions(+), 5 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 740d2b77f..b8626eeb3 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -43,7 +43,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) zeromach = zeromach/two end do zeromach = ten*zeromach - + is_inside=.false. ! orientation=[oriw, orii, orij, orik] call NormalizeQuaternion(orientation) ! shape=[shx, shy, shz] @@ -83,11 +83,12 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) call is_inside_ellipsoid(point, position, orientation, shape, ra, zeromach, is_inside) ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) - if (.not.is_inside) then ! write(*,*) i, j, k cycle endif + ! write(*,*) is_inside + ! write(*,*) i, j, k, zm epsi(i,j,k)=remp ! write(*,*) remp @@ -243,6 +244,8 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) real(mytype) :: y,um,eqr integer :: k,j,i,ii,is,code + write(*,*) 'INSIDE INIT ELLIP' + eqr=(shx*shy*shz)**(1.0/3.0) shape=[shx/eqr,shy/eqr,shz/eqr] diff --git a/src/forces.f90 b/src/forces.f90 index 516bb2219..c95fa957e 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -40,6 +40,8 @@ subroutine init_forces integer :: iv,stp1,stp2,h + write(*,*) 'Inside INIT_FORCES' + call alloc_x(ux01) call alloc_x(uy01) call alloc_x(ux11) @@ -55,12 +57,16 @@ subroutine init_forces 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 @@ -79,6 +85,7 @@ subroutine init_forces !***************************************************************** !! 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 @@ -288,6 +295,9 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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 + + write(*,*) 'Inside FORCE' + nvect1=xsize(1)*xsize(2)*xsize(3) diff --git a/src/ibm.f90 b/src/ibm.f90 index c49a0185f..c48ac0253 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -428,7 +428,7 @@ subroutine cubsplx(u,lind) ! ! Impose the Correct BC ! bcimp=lind - write(*,*) lind +! write(*,*) lind ! do k=1,xsize(3) zm=real(xstart(3)+k-2,mytype)*dz @@ -457,7 +457,7 @@ subroutine cubsplx(u,lind) bcimp=zero elseif (lind.eq.1) then bcimp=x_pv - write(*,*) bcimp + ! write(*,*) bcimp elseif (lind.eq.2) then bcimp=y_pv elseif (lind.eq.3) then diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index f217f9933..8585dec7d 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -239,7 +239,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 From 94c4cad86a72496a2ad0e3da9f5a3ab17a30fd71 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 14 Nov 2023 16:54:32 +0000 Subject: [PATCH 028/125] fixed gridding issue --- src/BC-Cylinder.f90 | 2 +- src/BC-Ellipsoid.f90 | 6 +- src/forces.f90 | 140 +++++++++++++++++++++++++++++++++++++++++-- src/genepsi3d.f90 | 4 +- src/ibm.f90 | 4 +- src/xcompact3d.f90 | 26 ++++++-- 6 files changed, 165 insertions(+), 17 deletions(-) diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index 986b249c4..a492e3b9d 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -26,7 +26,7 @@ subroutine geomcomplex_cyl(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) use param, only : one, two, ten use ibm_param use dbg_schemes, only: sqrt_prec - use ellipsoid_utils, only: EllipsoidalRadius, NormalizeQuaternion + ! use ellipsoid_utils, only: EllipsoidalRadius, NormalizeQuaternion implicit none diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index b8626eeb3..9ef9901a5 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -16,7 +16,7 @@ module ellip contains -subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) +subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) use decomp_2d, only : mytype use param, only : one, two, ten @@ -29,7 +29,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,remp) 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 + real(mytype) :: dx,dz real(mytype) :: remp integer :: i,j,k real(mytype) :: xm,ym,zm,r,rads2,kcon @@ -244,7 +244,7 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) real(mytype) :: y,um,eqr integer :: k,j,i,ii,is,code - write(*,*) 'INSIDE INIT ELLIP' + ! write(*,*) 'INSIDE INIT ELLIP' eqr=(shx*shy*shz)**(1.0/3.0) shape=[shx/eqr,shy/eqr,shz/eqr] diff --git a/src/forces.f90 b/src/forces.f90 index c95fa957e..787fc436f 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -40,7 +40,7 @@ subroutine init_forces integer :: iv,stp1,stp2,h - write(*,*) 'Inside INIT_FORCES' + ! write(*,*) 'Inside INIT_FORCES' call alloc_x(ux01) call alloc_x(uy01) @@ -57,7 +57,7 @@ subroutine init_forces uz01 = zero uz11 = zero - write(*,*) 'Alloc_x called' + ! 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)) @@ -65,7 +65,7 @@ subroutine init_forces 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' + ! write(*,*) 'allocate called' ! if ((iibm.ne.0).and.(t.ne.0.)) then ! xld2(:) = xld(:) + (t-ifirst*dt)*ubcx @@ -160,6 +160,138 @@ subroutine init_forces call decomp_2d_register_variable(io_restart_forces, "uz11", 1, 0, 0, mytype) end subroutine init_forces + + 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 @@ -296,7 +428,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) real(mytype), dimension(nz) :: drag3, drag4, drag33, drag44 real(mytype) :: mom1, mom2, mom3, tp1, tp2, tp3, dra1, dra2, dra3 - write(*,*) 'Inside FORCE' + ! write(*,*) 'Inside FORCE' diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 5b71f3e63..23475ff5b 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -79,7 +79,7 @@ subroutine geomcomplex(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, dx, yp, dz, remp) ELSEIF (itype.EQ.itype_ellip) THEN - CALL geomcomplex_ellip(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, dx, yp, remp) + CALL geomcomplex_ellip(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, dx, yp, dz, remp) ENDIF @@ -131,7 +131,7 @@ subroutine genepsi3d(ep1) logical :: dir_exists real(mytype),dimension(xsize(1),xsize(2),xsize(3)) :: ep1 - call param_assign() + ! call param_assign() ! if (nrank==0.and.mod(itime,ilist)==0) then write(*,*)'===========================================================' diff --git a/src/ibm.f90 b/src/ibm.f90 index c48ac0253..f93cdc74d 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -620,7 +620,7 @@ subroutine cubsply(u,lind) ! ! Impose the Correct BC ! bcimp=lind - write(*,*) lind +! write(*,*) lind ! do k=1,ysize(3) @@ -818,7 +818,7 @@ subroutine cubsplz(u,lind) ! ! Impose the Correct BC ! bcimp=lind - write(*,*) lind +! write(*,*) lind ! do j=1,zsize(2) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 8585dec7d..8351bf7f9 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -17,7 +17,7 @@ program xcompact3d use ibm, only : body use genepsi, only : genepsi3d use ellipsoid_utils, only: lin_step, ang_step, QuaternionNorm - use forces, only : force, init_forces, iforces, xld,xrd,yld,yud,zld,zrd + use forces, only : force, init_forces, iforces,update_forces, xld,xrd,yld,yud,zld,zrd implicit none real(mytype) :: dummy,drag,lift,lat @@ -40,6 +40,7 @@ program xcompact3d call apply_spatial_filter(ux1,uy1,uz1,phi1) endif + do itr=1,iadvance_time call set_fluid_properties(rho1,mu1) @@ -55,7 +56,11 @@ program xcompact3d yud(1) = position(2) + shape(1) * ra * cvl_scalar zld(1) = position(3) - shape(1) * ra * cvl_scalar zrd(1) = position(3) + shape(1) * ra * cvl_scalar - call init_forces() + if (itime.eq.ifirst) then + call init_forces() + else + call update_forces() + endif endif else if (iibm.eq.1) then call body(ux1,uy1,uz1,ep1) @@ -90,9 +95,12 @@ program xcompact3d call force(ux1,uy1,uz1,ep1,drag,lift,lat) linearForce=[drag,lift,lat] + if (nrank==0) then + write(*,*) "Time = , ", t, " Linear Force = ,", linearForce + endif torque(:)=zero - if (nrank==0) then + ! if (nrank==0) then call lin_step(position,linearVelocity,linearForce,dt,position_1,linearVelocity_1) call ang_step(orientation,angularVelocity,torque,dt,orientation_1,angularVelocity_1) @@ -103,11 +111,18 @@ program xcompact3d orientation = orientation_1 angularVelocity = angularVelocity_1 + if (nrank==0) then + write(*,*) "Position = ", position_1 + write(*,*) "Orientation = ", orientation_1 + write(*,*) "Linear velocity = ", linearVelocity + write(*,*) "Angular velocity = ", angularVelocity + call QuaternionNorm(angularVelocity,dummy) write(*,*) 'Norm of angvel = ', dummy + endif - endif + ! endif ! if (nrank==0) then ! write(*,*) 'Centroid position is ', position @@ -159,7 +174,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 @@ -220,6 +235,7 @@ subroutine init_xcompact3d() call decomp_info_init(nxm, nym, nz, ph3) call init_variables() + call param_assign() call schemes() From ee13b7546e0089964f1638cb6a18e835e6b0a1a1 Mon Sep 17 00:00:00 2001 From: Andrew Boyd Date: Sun, 3 Dec 2023 18:57:10 +0000 Subject: [PATCH 029/125] rotating frame for control vols --- src/ellip_utils.f90 | 4 +- src/forces.f90 | 125 ++++++++++++++++++++++++++++++------------- src/module_param.f90 | 2 +- src/parameters.f90 | 5 +- src/xcompact3d.f90 | 14 ++--- 5 files changed, 102 insertions(+), 48 deletions(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index ce1aa0cbb..971533df1 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -133,7 +133,7 @@ module ellipsoid_utils subroutine NormalizeQuaternion(quaternion) - real(mytype), intent(in) :: quaternion(4) + real(mytype), intent(inout) :: quaternion(4) real(mytype) :: normalizedQuaternion(4) ! Compute the magnitude of the quaternion @@ -144,7 +144,7 @@ subroutine NormalizeQuaternion(quaternion) write(*,*) "Tried to normalize a zero quaternion" endif ! Normalize the quaternion - normalizedQuaternion = quaternion / magnitude + quaternion = quaternion / magnitude end subroutine NormalizeQuaternion diff --git a/src/forces.f90 b/src/forces.f90 index 787fc436f..ac46b7643 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -22,7 +22,7 @@ module forces 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 + integer,allocatable,dimension(:) :: zcvlf_lx, zcvrt_lx, zcvlf_ly, zcvrt_ly, zcvlf_lz, zcvrt_lz character(len=*), parameter :: io_restart_forces = "restart-forces-io", & @@ -62,7 +62,7 @@ subroutine init_forces 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(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' @@ -126,7 +126,9 @@ subroutine init_forces 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)) + 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 @@ -370,6 +372,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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 @@ -379,7 +382,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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 real(mytype), dimension(xsize(1),xsize(2),xsize(3)),intent(in) :: ux1, uy1, uz1 @@ -391,6 +394,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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 @@ -416,7 +420,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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) :: 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 @@ -527,24 +531,31 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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) - 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/dt + tsumx = tsumx+(fac1-coriolis(1)-centrifugal(1))*dx*del_y(j+(xstart(2)-1))*dz/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))*dz/dt !tsumy+fac*dx*dy/dt + tsumy = tsumy+(fac2-coriolis(2)-centrifugal(2))*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumy+fac*dx*dy/dt !sumy(k) = sumy(k)+dudt1*dx*dy - 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*del_y(j+(xstart(2)-1))*dz/dt + tsumz = tsumz+(fac3-coriolis(3)-centrifugal(3))*dx*del_y(j+(xstart(2)-1))*dz/dt enddo enddo tunstxl(xstart(3)-1+k)=tsumx @@ -598,8 +609,11 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) !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=1,xsize(3) kk=xstart(3)-1+k + zm=real(kk,mytype)*dz fcvx=zero fcvy=zero fcvz=zero @@ -608,10 +622,14 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) fdiy=zero fdiz=zero do i=icvlf_lx(iv),icvrt_lx(iv)-1 + + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx !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)) + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx -uxmid*uymid*dx*dz fcvy = fcvy -uymid*uymid*dx*dz @@ -648,8 +666,11 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) !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=1,xsize(3) - kk=xstart(3)-1+k + kk=xstart(3)-1+k + zm=real(kk,mytype)*dz fcvx=zero fcvy=zero fcvz=zero @@ -658,14 +679,17 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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)) + ii=xstart(1)+i-1 + xm=real(ii,mytype)*dx + !momentum flux + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) - fcvx= fcvx +uxmid*uymid*dx*dz - fcvy= fcvy +uymid*uymid*dx*dz - fcvz= fcvz +uymid*uzmid*dx*dz + fcvx = fcvx +uxmid*uymid*dx*dz + fcvy = fcvy +uymid*uymid*dx*dz + fcvz = fcvz +uymid*uzmid*dx*dz !pressure @@ -699,8 +723,11 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) !AB if ((icvlf(iv).ge.ystart(1)).and.(icvlf(iv).le.yend(1))) then i=icvlf(iv)-ystart(1)+1 + ii=icvlf(iv) + xm=real(ii,mytype)*dx do k=1,ysize(3) - kk=ystart(3)-1+k + kk=ystart(3)+k-1 + zm=real(kk,mytype)*dz fcvx=zero fcvy=zero fcvz=zero @@ -709,10 +736,15 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) fdiy=zero fdiz=zero do j=jcvlw_ly(iv),jcvup_ly(iv)-1 + + jj=ystart(2)+j-1 + ym=real(jj,mytype)*dz !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)) + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + fcvx= fcvx -uxmid*uxmid*del_y(j)*dz fcvy= fcvy -uxmid*uymid*del_y(j)*dz @@ -748,8 +780,11 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) !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=1,ysize(3) kk=ystart(3)-1+k + zm=real(kk,mytype)*dz fcvx=zero fcvy=zero fcvz=zero @@ -758,10 +793,14 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) fdiy=zero fdiz=zero do j=jcvlw_ly(iv),jcvup_ly(iv)-1 + jj=ystart(2)+j-1 + ym=real(jj,mytype)*dy !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)) + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + fcvx= fcvx +uxmid*uxmid*del_y(j)*dz fcvy= fcvy +uxmid*uymid*del_y(j)*dz @@ -800,7 +839,8 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) !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 @@ -811,11 +851,17 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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 !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)) + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) fcvx= fcvx +uxmid*uzmid*dx*dy fcvy= fcvy +uymid*uzmid*dx*dy @@ -851,6 +897,8 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) !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 @@ -863,11 +911,16 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) ! 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 - 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)) + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) fcvx= fcvx -uxmid*uzmid*dx*dy fcvy= fcvy -uymid*uzmid*dx*dy diff --git a/src/module_param.f90 b/src/module_param.f90 index e3230977b..5f4badd72 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -617,7 +617,7 @@ end module simulation_stats !############################################################################ module ibm_param use decomp_2d, only : mytype - real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air,cvl_scalar + real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air,cvl_scalar,grav real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(4),linearAcceleration(3),linearForce(3),torque(3),shape(3),inertia(3,3) real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega diff --git a/src/parameters.f90 b/src/parameters.f90 index 6b2f3641d..40938ccb4 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -60,7 +60,7 @@ subroutine parameter(input_i3d) NAMELIST /LESModel/ jles, smagcst, smagwalldamp, nSmag, walecst, maxdsmagcst, iwall NAMELIST /WallModel/ smagwalldamp NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl - NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,nobjmax,nraf,nvol,iforces, cvl_scalar, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads,rho_s, c_air + NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,nobjmax,nraf,nvol,iforces, cvl_scalar, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads,rho_s, c_air, grav 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, & @@ -571,7 +571,7 @@ subroutine parameter_defaults() use probes, only : nprobes, flag_all_digits, flag_extra_probes use visu, only : output2D use forces, only : iforces, nvol - use ibm_param, only : oriw,rho_s,cvl_scalar + use ibm_param, only : oriw,rho_s,cvl_scalar,grav implicit none @@ -614,6 +614,7 @@ subroutine parameter_defaults() oriw=one rho_s=one cvl_scalar=onepfive + grav=zero !! Gravity field gravx = zero diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 8351bf7f9..c5430804e 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -94,7 +94,7 @@ program xcompact3d !Add force calculation here call force(ux1,uy1,uz1,ep1,drag,lift,lat) - linearForce=[drag,lift,lat] + linearForce=[drag,lift,lat-grav] if (nrank==0) then write(*,*) "Time = , ", t, " Linear Force = ,", linearForce endif @@ -111,15 +111,15 @@ program xcompact3d orientation = orientation_1 angularVelocity = angularVelocity_1 - if (nrank==0) then - write(*,*) "Position = ", position_1 - write(*,*) "Orientation = ", orientation_1 - write(*,*) "Linear velocity = ", linearVelocity + if ((nrank==0).and.(mod(itime,ilist)==0)) then + write(*,*) "Position = ", position_1 + write(*,*) "Orientation = ", orientation_1 + write(*,*) "Linear velocity = ", linearVelocity write(*,*) "Angular velocity = ", angularVelocity - call QuaternionNorm(angularVelocity,dummy) + ! call QuaternionNorm(angularVelocity,dummy) - write(*,*) 'Norm of angvel = ', dummy + ! write(*,*) 'Norm of angvel = ', dummy endif ! endif From 61237c1f448d65c1f47832199e3f0fb7f920cefc Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 12 Dec 2023 14:07:11 +0000 Subject: [PATCH 030/125] tidying --- src/xcompact3d.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index c5430804e..91f4a7c6e 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -19,7 +19,7 @@ program xcompact3d use ellipsoid_utils, only: lin_step, ang_step, QuaternionNorm use forces, only : force, init_forces, iforces,update_forces, xld,xrd,yld,yud,zld,zrd implicit none - real(mytype) :: dummy,drag,lift,lat + real(mytype) :: dummy,drag,lift,lat,grav_eff call init_xcompact3d() @@ -93,10 +93,10 @@ program xcompact3d !Add force calculation here call force(ux1,uy1,uz1,ep1,drag,lift,lat) - - linearForce=[drag,lift,lat-grav] + grav_eff = grav*(rho_s-1.0) + linearForce=[drag,lift-grav_eff,lat] if (nrank==0) then - write(*,*) "Time = , ", t, " Linear Force = ,", linearForce + write(*,*) "Time = ", t, ", Linear Force = ", linearForce endif torque(:)=zero From 95e2b77859eac3154a40a384b7605c51896ada4f Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 20 Feb 2024 15:13:50 +0000 Subject: [PATCH 031/125] force simplification for debug --- src/forces.f90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index ac46b7643..0f1289d23 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -548,14 +548,17 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) ! 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-coriolis(1)-centrifugal(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+(fac2-coriolis(2)-centrifugal(2))*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumy+fac*dx*dy/dt + ! 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(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-coriolis(3)-centrifugal(3))*dx*del_y(j+(xstart(2)-1))*dz/dt + tsumz = tsumz+fac3*dx*del_y(xstart(2)-1)*dz/dt enddo enddo tunstxl(xstart(3)-1+k)=tsumx From 966f9c6d63a0282c116d22dd3347a2199377b4a4 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 26 Feb 2024 17:06:24 +0000 Subject: [PATCH 032/125] adjustable gravity --- src/forces.f90 | 2 +- src/module_param.f90 | 2 +- src/parameters.f90 | 8 +++++--- src/xcompact3d.f90 | 8 +++++--- 4 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 0f1289d23..6c72c58de 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1021,7 +1021,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) write(38,*) t,xDrag_mean,yLift_mean call flush(38) endif - if (mod(itime, icheckpoint).eq.0) then + 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) diff --git a/src/module_param.f90 b/src/module_param.f90 index 5f4badd72..9c14974d0 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -617,7 +617,7 @@ end module simulation_stats !############################################################################ module ibm_param use decomp_2d, only : mytype - real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air,cvl_scalar,grav + real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air,cvl_scalar,grav_y,grav_x,grav_z real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(4),linearAcceleration(3),linearForce(3),torque(3),shape(3),inertia(3,3) real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega diff --git a/src/parameters.f90 b/src/parameters.f90 index 40938ccb4..1e73fd190 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -60,7 +60,7 @@ subroutine parameter(input_i3d) NAMELIST /LESModel/ jles, smagcst, smagwalldamp, nSmag, walecst, maxdsmagcst, iwall NAMELIST /WallModel/ smagwalldamp NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl - NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,nobjmax,nraf,nvol,iforces, cvl_scalar, npif, izap, ianal, imove, thickness, chord, omega ,ubcx,ubcy,ubcz,rads,rho_s, c_air, grav + NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,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 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, & @@ -571,7 +571,7 @@ subroutine parameter_defaults() use probes, only : nprobes, flag_all_digits, flag_extra_probes use visu, only : output2D use forces, only : iforces, nvol - use ibm_param, only : oriw,rho_s,cvl_scalar,grav + use ibm_param, only : oriw,rho_s,cvl_scalar,grav_y,grav_x,grav_z implicit none @@ -614,7 +614,9 @@ subroutine parameter_defaults() oriw=one rho_s=one cvl_scalar=onepfive - grav=zero + grav_y=zero + grav_x=zero + grav_z=zero !! Gravity field gravx = zero diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 91f4a7c6e..b78494a28 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -19,7 +19,7 @@ program xcompact3d use ellipsoid_utils, only: lin_step, ang_step, QuaternionNorm use forces, only : force, init_forces, iforces,update_forces, xld,xrd,yld,yud,zld,zrd implicit none - real(mytype) :: dummy,drag,lift,lat,grav_eff + real(mytype) :: dummy,drag,lift,lat,grav_effy,grav_effx,grav_effz call init_xcompact3d() @@ -93,8 +93,10 @@ program xcompact3d !Add force calculation here call force(ux1,uy1,uz1,ep1,drag,lift,lat) - grav_eff = grav*(rho_s-1.0) - linearForce=[drag,lift-grav_eff,lat] + grav_effx = grav_x*(rho_s-1.0) + grav_effy = grav_y*(rho_s-1.0) + grav_effz = grav_z*(rho_s-1.0) + linearForce=[drag-grav_effx,lift-grav_effy,lat-grav_effz] if (nrank==0) then write(*,*) "Time = ", t, ", Linear Force = ", linearForce endif From da7c1db8b10acc29bd3582c36ab20c28d89b7113 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 26 Feb 2024 17:10:36 +0000 Subject: [PATCH 033/125] option to force z velocity to 0 --- src/module_param.f90 | 2 +- src/parameters.f90 | 5 +++-- src/xcompact3d.f90 | 3 +++ 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/module_param.f90 b/src/module_param.f90 index 9c14974d0..c05721e92 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -622,6 +622,6 @@ module ibm_param real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega integer :: inana ! Analytical BC as Input - integer :: imove + integer :: imove, nozdrift end module ibm_param !############################################################################ diff --git a/src/parameters.f90 b/src/parameters.f90 index 1e73fd190..004afaac1 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -60,7 +60,7 @@ subroutine parameter(input_i3d) NAMELIST /LESModel/ jles, smagcst, smagwalldamp, nSmag, walecst, maxdsmagcst, iwall NAMELIST /WallModel/ smagwalldamp NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl - NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,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 + NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,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 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, & @@ -571,7 +571,7 @@ subroutine parameter_defaults() use probes, only : nprobes, flag_all_digits, flag_extra_probes use visu, only : output2D use forces, only : iforces, nvol - use ibm_param, only : oriw,rho_s,cvl_scalar,grav_y,grav_x,grav_z + use ibm_param, only : oriw,rho_s,cvl_scalar,grav_y,grav_x,grav_z,nozdrift implicit none @@ -617,6 +617,7 @@ subroutine parameter_defaults() grav_y=zero grav_x=zero grav_z=zero + nozdrift=0 !! Gravity field gravx = zero diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index b78494a28..a884dd51b 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -97,6 +97,9 @@ program xcompact3d grav_effy = grav_y*(rho_s-1.0) grav_effz = grav_z*(rho_s-1.0) linearForce=[drag-grav_effx,lift-grav_effy,lat-grav_effz] + if (nozdrift==1) then + linearForce(3)=zero + endif if (nrank==0) then write(*,*) "Time = ", t, ", Linear Force = ", linearForce endif From b1b33d113fb2d0f5dbfa3d25a833e2ff73c3076c Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 26 Feb 2024 17:34:47 +0000 Subject: [PATCH 034/125] force printout --- src/xcompact3d.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index a884dd51b..d725e0a82 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -100,9 +100,7 @@ program xcompact3d if (nozdrift==1) then linearForce(3)=zero endif - if (nrank==0) then - write(*,*) "Time = ", t, ", Linear Force = ", linearForce - endif + torque(:)=zero ! if (nrank==0) then @@ -121,6 +119,7 @@ program xcompact3d write(*,*) "Orientation = ", orientation_1 write(*,*) "Linear velocity = ", linearVelocity write(*,*) "Angular velocity = ", angularVelocity + write(*,*) "Linear Force = ", linearForce ! call QuaternionNorm(angularVelocity,dummy) From 82c1948424140296b0ee8cd3c7aa257b383aa122 Mon Sep 17 00:00:00 2001 From: adfboyd Date: Sun, 10 Mar 2024 19:35:09 +0000 Subject: [PATCH 035/125] force fixes/printing --- src/forces.f90 | 63 ++++++++++++++++++++++---------------------- src/ibm.f90 | 6 +++++ src/module_param.f90 | 2 +- src/parameters.f90 | 7 +++-- src/xcompact3d.f90 | 33 +++++++++++++++++++++++ 5 files changed, 77 insertions(+), 34 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 6c72c58de..52e311a5c 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -365,7 +365,7 @@ subroutine restart_forces(itest1) end subroutine restart_forces - subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) + subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3) USE param USE variables @@ -387,7 +387,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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), intent(out) :: xDrag_tot,yLift_tot,zLat_tot + real(mytype), intent(out) :: dra1,dra2,dra3 real(mytype), dimension(ysize(1),ysize(2),ysize(3)) :: ppi2 real(mytype), dimension(zsize(1),zsize(2),zsize(3)) :: ppi3 @@ -430,7 +430,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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 + real(mytype) :: mom1, mom2, mom3, tp1, tp2, tp3 ! write(*,*) 'Inside FORCE' @@ -558,7 +558,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) !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(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 @@ -652,7 +652,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) fdix = fdix -(xnu*(dudymid+dvdxmid)*dx*dz) fdiy = fdiy -two*xnu*dvdymid*dx*dz - fdiz = fdiz -(xnu*(dwdymid+dvdzmid)*dx*dz) + fdiz = fdiz -(xnu*(dwdymid+dvdzmid)*dx*dz) enddo @@ -684,6 +684,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) do i=icvlf_lx(iv),icvrt_lx(iv)-1 ii=xstart(1)+i-1 xm=real(ii,mytype)*dx + ! write(*,*) 'xm = ', xm !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) @@ -706,9 +707,9 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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) + fdix = fdix + (xnu*(dudymid+dvdxmid)*dx*dz) + fdiy = fdiy + two*xnu*dvdymid*dx*dz + fdiz = fdiz + (xnu*(dwdymid+dvdzmid)*dx*dz) enddo tconvxl(kk)=tconvxl(kk)+fcvx @@ -743,19 +744,19 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) jj=ystart(2)+j-1 ym=real(jj,mytype)*dz !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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 + 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)) + prmid = half*(ppi2(i,j,k)+ppi2(i,j+1,k)) fprx = fprx +prmid*del_y(j)*dz !viscous term @@ -799,19 +800,19 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) jj=ystart(2)+j-1 ym=real(jj,mytype)*dy !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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 + 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)) + prmid = half*(ppi2(i,j,k)+ppi2(i,j+1,k)) fprx = fprx -prmid*del_y(j)*dz !viscous term @@ -821,9 +822,9 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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 + 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 @@ -913,7 +914,7 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) fdiz=zero ! do k=1,xsize(3) do j=jcvlw_lx(iv),jcvup_lx(iv) - kk = xstart(2)-1+j + ! kk = xstart(2)-1+j jj = xstart(2)-1+j ym=real(jj,mytype)*dy do i=icvlf_lx(iv),icvrt_lx(iv)-1 @@ -1007,9 +1008,9 @@ subroutine force(ux1,uy1,uz1,ep1,xDrag_tot,yLift_tot,zLat_tot) 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(:)) + ! xDrag_tot = sum(xDrag(:)) + ! yLift_tot = sum(yLift(:)) + ! zLat_tot = sum(zLat(:)) ! if ((itime==ifirst).or.(itime==0)) then ! if (nrank .eq. 0) then diff --git a/src/ibm.f90 b/src/ibm.f90 index f93cdc74d..3f4cc296f 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -1031,6 +1031,12 @@ subroutine cubic_spline(xa,ya,n,x,y) alpha(nc)= three*yprf - three*(aa(nc)-aa(nc-1))/hh(nc-1) ! do i=2,nc-1 + if (hh(i).lt.0.0004) then + write(*,*) 'i = ', i, 'dividing by ', hh(i) + end if + if (hh(i-1).lt.0.0004) then + write(*,*) 'i = ', i, 'dividing by hh(i-1)= ', hh(i) + end if alpha(i)=(three/hh(i))*(aa(i+1)-aa(i))-(three/hh(i-1))*(aa(i)-aa(i-1)) enddo ll(1)=two*hh(1) diff --git a/src/module_param.f90 b/src/module_param.f90 index c05721e92..62c48a58f 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -622,6 +622,6 @@ module ibm_param real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega integer :: inana ! Analytical BC as Input - integer :: imove, nozdrift + integer :: imove, nozdrift, force_csv end module ibm_param !############################################################################ diff --git a/src/parameters.f90 b/src/parameters.f90 index 004afaac1..c163992f5 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -60,7 +60,9 @@ subroutine parameter(input_i3d) NAMELIST /LESModel/ jles, smagcst, smagwalldamp, nSmag, walecst, maxdsmagcst, iwall NAMELIST /WallModel/ smagwalldamp NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl - NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,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 + NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & + 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 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, & @@ -571,7 +573,7 @@ subroutine parameter_defaults() use probes, only : nprobes, flag_all_digits, flag_extra_probes use visu, only : output2D use forces, only : iforces, nvol - use ibm_param, only : oriw,rho_s,cvl_scalar,grav_y,grav_x,grav_z,nozdrift + use ibm_param, only : oriw,rho_s,cvl_scalar,grav_y,grav_x,grav_z,nozdrift,force_csv implicit none @@ -618,6 +620,7 @@ subroutine parameter_defaults() grav_x=zero grav_z=zero nozdrift=0 + force_csv=0 !! Gravity field gravx = zero diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index d725e0a82..b2b717ecb 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -20,10 +20,34 @@ program xcompact3d use forces, only : force, init_forces, iforces,update_forces, xld,xrd,yld,yud,zld,zrd implicit none real(mytype) :: dummy,drag,lift,lat,grav_effy,grav_effx,grav_effz + integer :: iounit,ierr,i + real, dimension(100) :: x 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='replace',action='write',iostat=ierr) + if (ierr /= 0) then + print *, 'Error opening file.' + stop + end if + write(*,*) 'Outputting forces' + end if + + 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 @@ -100,6 +124,13 @@ program xcompact3d if (nozdrift==1) then linearForce(3)=zero endif + + if ((nrank==0).and.(force_csv.eq.1)) then + open(unit=20, file='force_out.dat', action='write') + write(20, *) linearForce(1), linearForce(2), linearForce(3), '\n' + write(*,*) 'Writing forces', linearForce(1), linearForce(2), linearForce(3) + close(20) + endif torque(:)=zero @@ -143,6 +174,8 @@ program xcompact3d enddo !! End time loop + close(iounit) + call finalise_xcompact3d() end program xcompact3d From 9213c9a6226afba965358594a7d1a3ffbe3a5bed Mon Sep 17 00:00:00 2001 From: adfboyd Date: Thu, 21 Mar 2024 18:03:01 +0000 Subject: [PATCH 036/125] added ability to fix body for force checks --- src/module_param.f90 | 2 +- src/parameters.f90 | 2 +- src/xcompact3d.f90 | 16 +++++++++------- 3 files changed, 11 insertions(+), 9 deletions(-) diff --git a/src/module_param.f90 b/src/module_param.f90 index 62c48a58f..3e740cad0 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -622,6 +622,6 @@ module ibm_param real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega integer :: inana ! Analytical BC as Input - integer :: imove, nozdrift, force_csv + integer :: imove, nozdrift, force_csv, bodies_fixed end module ibm_param !############################################################################ diff --git a/src/parameters.f90 b/src/parameters.f90 index c163992f5..3d4da04c2 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -62,7 +62,7 @@ subroutine parameter(input_i3d) NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & 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 + ubcx,ubcy,ubcz,rads,rho_s, c_air, grav_x,grav_y,grav_z, nozdrift, force_csv, bodies_fixed 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, & diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index b2b717ecb..d5b4f496f 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -37,14 +37,14 @@ program xcompact3d write(*,*) 'Outputting forces' end if - do i = 1,100 - x(i) = i - enddo - open(unit=3, file='testcsv.dat', status='new',action='write',iostat=ierr) +! 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 i = 1,100 +! write(3,*) x(i) +! enddo @@ -136,6 +136,7 @@ program xcompact3d ! if (nrank==0) then + if (bodies_fixed==0) then call lin_step(position,linearVelocity,linearForce,dt,position_1,linearVelocity_1) call ang_step(orientation,angularVelocity,torque,dt,orientation_1,angularVelocity_1) @@ -144,6 +145,7 @@ program xcompact3d orientation = orientation_1 angularVelocity = angularVelocity_1 + endif if ((nrank==0).and.(mod(itime,ilist)==0)) then write(*,*) "Position = ", position_1 From 3a0f1958187e5d52a2679b96492e5a0685255976 Mon Sep 17 00:00:00 2001 From: adfboyd Date: Thu, 21 Mar 2024 18:36:14 +0000 Subject: [PATCH 037/125] fixed index error in y force calc --- src/forces.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 52e311a5c..df1e3a3be 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -745,9 +745,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3) ym=real(jj,mytype)*dz !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx -uxmid*uxmid*del_y(j)*dz @@ -801,9 +801,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3) ym=real(jj,mytype)*dy !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx + uxmid*uxmid*del_y(j)*dz From de2ed32a32a7575a94f2a00f7dad015c5f8fd839 Mon Sep 17 00:00:00 2001 From: adfboyd Date: Thu, 21 Mar 2024 18:42:44 +0000 Subject: [PATCH 038/125] fixed body position when fixed --- src/xcompact3d.f90 | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index d5b4f496f..df32177dd 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -125,6 +125,10 @@ program xcompact3d linearForce(3)=zero endif + if (bodies_fixed==1) then + linearForce(:)=zero + endif + if ((nrank==0).and.(force_csv.eq.1)) then open(unit=20, file='force_out.dat', action='write') write(20, *) linearForce(1), linearForce(2), linearForce(3), '\n' @@ -136,7 +140,7 @@ program xcompact3d ! if (nrank==0) then - if (bodies_fixed==0) then + ! if (bodies_fixed==0) then call lin_step(position,linearVelocity,linearForce,dt,position_1,linearVelocity_1) call ang_step(orientation,angularVelocity,torque,dt,orientation_1,angularVelocity_1) @@ -145,7 +149,7 @@ program xcompact3d orientation = orientation_1 angularVelocity = angularVelocity_1 - endif + ! endif if ((nrank==0).and.(mod(itime,ilist)==0)) then write(*,*) "Position = ", position_1 From 1955ed2563d9b9424da4021666b2cc2be7d65270 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Fri, 22 Mar 2024 15:59:16 +0000 Subject: [PATCH 039/125] force outputting working --- src/forces.f90 | 36 +++++++++++++++++++++--------------- src/xcompact3d.f90 | 5 ++++- 2 files changed, 25 insertions(+), 16 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index df1e3a3be..56368c75b 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -449,6 +449,13 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3) enddo if (itime.eq.1) then + do iv=1,nvol + if (nrank .eq. 0) then + write(filename,"('forces.dat',I1.1)") iv + open(38+(iv-1),file=filename,status='unknown',form='formatted') + ! 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) @@ -1011,23 +1018,22 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3) ! xDrag_tot = sum(xDrag(:)) ! yLift_tot = sum(yLift(:)) ! zLat_tot = sum(zLat(:)) - - ! 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 ((itime==ifirst).or.(itime==0)) then + + endif if (nrank .eq. 0) then - write(38,*) t,xDrag_mean,yLift_mean - call flush(38) - 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 + ! write(*,*) 'TIME STEP = ', itime + write(38+(iv-1),*) t,dra1,dra2,dra3 + ! write(*,*) 'written to file number', 38+(iv-1), t, dra1,dra2,dra3 + call flush(38+(iv-1)) 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) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index df32177dd..8778636d6 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -116,6 +116,9 @@ 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' + ! endif call force(ux1,uy1,uz1,ep1,drag,lift,lat) grav_effx = grav_x*(rho_s-1.0) grav_effy = grav_y*(rho_s-1.0) @@ -156,7 +159,7 @@ program xcompact3d write(*,*) "Orientation = ", orientation_1 write(*,*) "Linear velocity = ", linearVelocity write(*,*) "Angular velocity = ", angularVelocity - write(*,*) "Linear Force = ", linearForce + write(*,*) "Linear Force = ", [drag,lift,lat] ! call QuaternionNorm(angularVelocity,dummy) From 31e2cc859017c3ab709389cfa84aad65bd039020 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Sat, 23 Mar 2024 15:35:57 +0000 Subject: [PATCH 040/125] fixed force outputting twice --- src/case.f90 | 3 ++- src/forces.f90 | 7 ++++--- src/xcompact3d.f90 | 8 ++++---- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/case.f90 b/src/case.f90 index dc34b2769..a334b2b4c 100644 --- a/src/case.f90 +++ b/src/case.f90 @@ -368,7 +368,8 @@ subroutine postprocess_case(rho,ux,uy,uz,pp,phi,ep) endif if (iforces.eq.1) then - call force(ux,uy,uz,ep,dummy1,dummy2,dummy3) + ! write(*,*) "Calling force from case" + call force(ux,uy,uz,ep,dummy1,dummy2,dummy3,0) call restart_forces(1) endif diff --git a/src/forces.f90 b/src/forces.f90 index 56368c75b..0f950edb5 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -365,7 +365,7 @@ subroutine restart_forces(itest1) end subroutine restart_forces - subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3) + subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) USE param USE variables @@ -387,6 +387,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3) 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,dra2,dra3 real(mytype), dimension(ysize(1),ysize(2),ysize(3)) :: ppi2 @@ -450,7 +451,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3) if (itime.eq.1) then do iv=1,nvol - if (nrank .eq. 0) then + 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(*,*) 'Opened file: ', filename, 'number = ', 38+(iv-1) @@ -1022,7 +1023,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3) if ((itime==ifirst).or.(itime==0)) then endif - if (nrank .eq. 0) then + if ((nrank .eq. 0).and.(record_var.eq.1)) then ! write(*,*) 'TIME STEP = ', itime write(38+(iv-1),*) t,dra1,dra2,dra3 ! write(*,*) 'written to file number', 38+(iv-1), t, dra1,dra2,dra3 diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 8778636d6..0dee7f704 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -116,10 +116,10 @@ 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' - ! endif - call force(ux1,uy1,uz1,ep1,drag,lift,lat) + if (nrank.eq.0) then + write(*,*) 'Going to call force from xcompact3d, itr = ', itr + endif + 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) From 28e10a8f7d20181a8eb534b96f44e1c63da738c0 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Sat, 23 Mar 2024 15:42:08 +0000 Subject: [PATCH 041/125] removed debug prints --- src/xcompact3d.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 0dee7f704..b5718b0b4 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -116,9 +116,9 @@ 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 (nrank.eq.0) then + ! write(*,*) 'Going to call force from xcompact3d, itr = ', itr + ! endif 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) From 5f555f69a64493bc64c44589fbc8f3904b2ea90d Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 26 Mar 2024 16:37:54 +0000 Subject: [PATCH 042/125] changed do loops to correct values --- src/forces.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 0f950edb5..8ec69b535 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -622,7 +622,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) j=jcvlw(iv)-xstart(2)+1 jj=jcvlw(iv) ym=real(jj,mytype)*dy - do k=1,xsize(3) + do k=zcvlf_lx(iv),zcvrt_lx(iv) kk=xstart(3)-1+k zm=real(kk,mytype)*dz fcvx=zero @@ -679,7 +679,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) j=jcvup(iv)-xstart(2)+1 jj=jcvup(iv) ym=real(jj,mytype)*dy - do k=1,xsize(3) + do k=zcvlf_lx(iv),zcvrt_lx(iv) kk=xstart(3)-1+k zm=real(kk,mytype)*dz fcvx=zero @@ -737,7 +737,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) i=icvlf(iv)-ystart(1)+1 ii=icvlf(iv) xm=real(ii,mytype)*dx - do k=1,ysize(3) + do k=zcvlf_ly(iv),zcvrt_ly(iv) kk=ystart(3)+k-1 zm=real(kk,mytype)*dz fcvx=zero @@ -794,7 +794,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) i=icvrt(iv)-ystart(1)+1 ii=icvrt(iv) xm=real(ii,mytype)*dx - do k=1,ysize(3) + do k=zcvlf_ly(iv),zcvrt_ly(iv) kk=ystart(3)-1+k zm=real(kk,mytype)*dz fcvx=zero @@ -804,7 +804,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fdix=zero fdiy=zero fdiz=zero - do j=jcvlw_ly(iv),jcvup_ly(iv)-1 + do j=jcvlw_ly(iv),jcvup_ly(iv)-1 !!!What's going on here? jj=ystart(2)+j-1 ym=real(jj,mytype)*dy !momentum flux From c6e611a7ede3fe5808878398ab7a1cd1ed675146 Mon Sep 17 00:00:00 2001 From: adfboyd Date: Wed, 27 Mar 2024 01:16:09 +0000 Subject: [PATCH 043/125] fixed volume loop --- src/forces.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 8ec69b535..91bb34075 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -535,7 +535,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 @@ -862,7 +862,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fdiy=zero fdiz=zero do j=jcvlw_lx(iv),jcvup_lx(iv) - kk = xstart(2)-1+j + ! kk = xstart(2)-1+j jj = xstart(2)-1+j ym=real(jj,mytype)*dy From 7833407d89b0a0d654cf7dd251e4042c516624ba Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 1 Apr 2024 13:29:14 +0100 Subject: [PATCH 044/125] stopped variable name being used twice, simplified force calc even further --- src/ellip_utils.f90 | 14 ++++++------- src/forces.f90 | 51 +++++++++++++++++++++++++++------------------ 2 files changed, 38 insertions(+), 27 deletions(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 971533df1..e76d32940 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -358,7 +358,7 @@ SUBROUTINE ConvertToMovingRotatingFrame(vI, positionI, originO, vO, Omega, vR) 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(3) + real(mytype) :: r(3), crossProduct_v(3) ! Compute r = positionI - originO r(1) = positionI(1) - originO(1) @@ -366,14 +366,14 @@ SUBROUTINE ConvertToMovingRotatingFrame(vI, positionI, originO, vO, Omega, vR) r(3) = positionI(3) - originO(3) ! Compute Omega x r (cross product) - crossProduct(1) = Omega(2)*r(3) - Omega(3)*r(2) - crossProduct(2) = Omega(3)*r(1) - Omega(1)*r(3) - crossProduct(3) = Omega(1)*r(2) - Omega(2)*r(1) + 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(1) - vR(2) = vI(2) - vO(2) - crossProduct(2) - vR(3) = vI(3) - vO(3) - crossProduct(3) + 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 diff --git a/src/forces.f90 b/src/forces.f90 index 91bb34075..d2033e88c 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -636,11 +636,13 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) ! - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) !- linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) !- linearVelocity(3) - rotationalComponent(3) fcvx = fcvx -uxmid*uymid*dx*dz fcvy = fcvy -uymid*uymid*dx*dz @@ -693,11 +695,13 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k))! - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k))! - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k))! - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx +uxmid*uymid*dx*dz fcvy = fcvy +uymid*uymid*dx*dz @@ -735,7 +739,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !AB if ((icvlf(iv).ge.ystart(1)).and.(icvlf(iv).le.yend(1))) then i=icvlf(iv)-ystart(1)+1 - ii=icvlf(iv) + ii=icvlf(iv)-1 xm=real(ii,mytype)*dx do k=zcvlf_ly(iv),zcvrt_ly(iv) kk=ystart(3)+k-1 @@ -751,11 +755,12 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k))! - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k))! - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k))! - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx -uxmid*uxmid*del_y(j)*dz @@ -807,11 +812,13 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k))! - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k))! - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k))! - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx + uxmid*uxmid*del_y(j)*dz @@ -862,18 +869,20 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fdiy=zero fdiz=zero do j=jcvlw_lx(iv),jcvup_lx(iv) - ! kk = xstart(2)-1+j + 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,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k))! - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k))! - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k))! - linearVelocity(3) - rotationalComponent(3) fcvx= fcvx +uxmid*uzmid*dx*dy fcvy= fcvy +uymid*uzmid*dx*dy @@ -930,9 +939,11 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) xm=real(ii,mytype)*dx !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] + + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k))! - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k))! - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k))! - linearVelocity(3) - rotationalComponent(3) fcvx= fcvx -uxmid*uzmid*dx*dy fcvy= fcvy -uymid*uzmid*dx*dy From 5d4c926efb72e3cbbd1a9c0d02833340cf0c9184 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 3 Apr 2024 10:51:23 +0100 Subject: [PATCH 045/125] fixed inputs to calculatePointVelocity --- src/ellip_utils.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index e76d32940..83fae9874 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -229,7 +229,7 @@ subroutine CrossProduct(a, b, result) result(3) = a(1) * b(2) - a(2) * b(1) end subroutine CrossProduct - subroutine CalculatePointVelocity(point, center, linearVelocity, angularVelocity, pointVelocity) + subroutine CalculatePointVelocity(point, center, angularVelocity, linearVelocity, pointVelocity) real(mytype), intent(in) :: point(3), center(3), linearVelocity(3), angularVelocity(3) real(mytype), intent(out) :: pointVelocity(3) real(mytype) :: crossed(3) @@ -274,7 +274,7 @@ subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1, ep1_x, e xm=real(i+xstart(1)-2, mytype)*dx point=[xm,ym,zm] if (ep1(i,j,k).eq.1) then - call CalculatePointVelocity(point, center, linearVelocity, angularVelocity, pointVelocity) + call CalculatePointVelocity(point, center, angularVelocity, linearVelocity, pointVelocity) x_pv=pointVelocity(1) y_pv=pointVelocity(2) z_pv=pointVelocity(3) From 6c312667cfae5a53fcaa71f1981b37636fa361f5 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 15 Apr 2024 15:44:08 +0100 Subject: [PATCH 046/125] added cube_flag option --- src/BC-Ellipsoid.f90 | 6 +++++- src/module_param.f90 | 2 +- src/parameters.f90 | 2 +- 3 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 9ef9901a5..022acf80f 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -80,7 +80,11 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) xm=real(i-1,mytype)*dx point=[xm, ym, zm] ! call EllipsoidalRadius(point, position, orientation, shape, r) - call is_inside_ellipsoid(point, position, orientation, shape, ra, zeromach, is_inside) + if (cube_flag.eq.0) then + call is_inside_ellipsoid(point, position, orientation, shape, ra, zeromach, is_inside) + else if (cube_flag.eq.1) then + is_inside = (abs(xm-position(1)).lt.ra).and.(abs(ym-position(2)).lt.ra).and.(abs(zm-position(3)).lt.ra) + endif ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) if (.not.is_inside) then diff --git a/src/module_param.f90 b/src/module_param.f90 index 3e740cad0..0125b3b96 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -622,6 +622,6 @@ module ibm_param real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega integer :: inana ! Analytical BC as Input - integer :: imove, nozdrift, force_csv, bodies_fixed + integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag end module ibm_param !############################################################################ diff --git a/src/parameters.f90 b/src/parameters.f90 index 3d4da04c2..a1d480057 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -62,7 +62,7 @@ subroutine parameter(input_i3d) NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & 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 + ubcx,ubcy,ubcz,rads,rho_s, c_air, grav_x,grav_y,grav_z, nozdrift, force_csv, bodies_fixed, cube_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, & From 10c21cb2b7e2e123078a8579f519c0baa6ebd860 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 17 Apr 2024 12:11:30 +0100 Subject: [PATCH 047/125] detailed forces output --- src/forces.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/forces.f90 b/src/forces.f90 index d2033e88c..7d4816dab 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1036,7 +1036,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) endif if ((nrank .eq. 0).and.(record_var.eq.1)) then ! write(*,*) 'TIME STEP = ', itime - write(38+(iv-1),*) t,dra1,dra2,dra3 + 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)) endif From 3c9fc0265108ab2c2c8345b79ba2d30cfce6f5ad Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 17 Apr 2024 15:19:03 +0100 Subject: [PATCH 048/125] changed force normalisation --- src/forces.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 7d4816dab..ce60d6702 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1017,9 +1017,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) xmom = tunstx(k)+tconvx(k)+tconvx2(k) ymom = tunsty(k)+tconvy(k)+tconvy2(k) zmom = tunstz(k)+tconvz(k)+tconvz2(k) - xDrag(k) = two*(tdiffx(k)+tdiffx2(k)+tpresx(k)-xmom) - yLift(k) = two*(tdiffy(k)+tdiffy2(k)+tpresy(k)-ymom) - zLat(k) = two*(tdiffz(k)+tdiffz2(k)+tpresz(k)-zmom) + 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 From 331a5a74c28b8b0b46a771ba0cbcb40afd054e1e Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 29 Apr 2024 11:36:15 +0100 Subject: [PATCH 049/125] added sign change to tconv2 --- src/forces.f90 | 12 ++++++------ src/module_param.f90 | 2 +- src/parameters.f90 | 2 +- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index ce60d6702..036d9154b 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -999,13 +999,13 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) tp2 = sum(tpresy(:))/dt tp3 = sum(tpresz(:))/dt - mom1 = sum(tunstx(:) + tconvx(:) + tconvx2(:)) - mom2 = sum(tunsty(:) + tconvy(:) + tconvy2(:)) - mom3 = sum(tunstz(:) + tconvz(:) + tconvz2(:)) + mom1 = sum(tunstx(:) + tconvx(:) + (-2.0*tconv2_sign+1.0)*tconvx2(:)) !if tconv2sign == 1.0, multiply by -1 + mom2 = sum(tunsty(:) + tconvy(:) + (-2.0*tconv2_sign+1.0)*tconvy2(:)) + mom3 = sum(tunstz(:) + tconvz(:) + (-2.0*tconv2_sign+1.0)*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) + dra1 = (sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) + dra2 = (sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) + dra3 = (sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) do k=1,zsize(3) diff --git a/src/module_param.f90 b/src/module_param.f90 index 0125b3b96..9d16bbe87 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -620,7 +620,7 @@ module ibm_param real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air,cvl_scalar,grav_y,grav_x,grav_z real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(4),linearAcceleration(3),linearForce(3),torque(3),shape(3),inertia(3,3) real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) - real(mytype) :: chord,thickness,omega + real(mytype) :: chord,thickness,omega, tconv2_sign integer :: inana ! Analytical BC as Input integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag end module ibm_param diff --git a/src/parameters.f90 b/src/parameters.f90 index a1d480057..2e50404ee 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -62,7 +62,7 @@ subroutine parameter(input_i3d) NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & 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 + ubcx,ubcy,ubcz,rads,rho_s, c_air, grav_x,grav_y,grav_z, nozdrift, force_csv, bodies_fixed, cube_flag, tconv2_sign 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, & From c6819d37b729bc95789fd123bd854966b74891a1 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 21 May 2024 21:00:37 +0100 Subject: [PATCH 050/125] torque function fix --- src/forces.f90 | 701 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 701 insertions(+) diff --git a/src/forces.f90 b/src/forces.f90 index 036d9154b..ae0c5b33f 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1064,4 +1064,705 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) return end subroutine force + + + subroutine torque(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,dra2,dra3 + + 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 + + ! write(*,*) 'Inside FORCE' + + + + 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,"('forces.dat',I1.1)") iv + open(38+(iv-1),file=filename,status='unknown',form='formatted') + ! 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 + 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) + tsumx = tsumx+crossProduct((fac1-coriolis(1)-centrifugal(1)),[xm,ym,zm]-position)*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+(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(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(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 + fpry=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] + + !momentum flux + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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 + + 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 + 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,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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 + 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 + fcvz=zero + fprx=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 + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(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 + fcvz=zero + fprx=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] + + !momentum flux + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(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 + + !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,[xm,ym,zm]-position,rotationalComponent) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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,[xm,ym,zm]-position,rotationalComponent) + ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] + + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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(:) + tconvx(:) + (-2.0*tconv2_sign+1.0)*tconvx2(:)) !if tconv2sign == 1.0, multiply by -1 + mom2 = sum(tunsty(:) + tconvy(:) + (-2.0*tconv2_sign+1.0)*tconvy2(:)) + mom3 = sum(tunstz(:) + tconvz(:) + (-2.0*tconv2_sign+1.0)*tconvz2(:)) + + dra1 = (sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) + dra2 = (sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) + dra3 = (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)) 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)) + 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 end module forces From 61d5684f446a44ab8932a6551ed79d61ead1a61e Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 21 May 2024 21:22:32 +0100 Subject: [PATCH 051/125] correct pressure and convective equations --- src/forces.f90 | 69 +++++++++++++++++++++++++++++--------------------- 1 file changed, 40 insertions(+), 29 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index ae0c5b33f..ff6b1025b 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1153,8 +1153,8 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) if (itime.eq.1) then do iv=1,nvol 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(filename,"('torques.dat',I1.1)") iv + open(45+(iv-1),file=filename,status='unknown',form='formatted') ! write(*,*) 'Opened file: ', filename, 'number = ', 38+(iv-1) endif enddo @@ -1338,6 +1338,7 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) @@ -1345,14 +1346,14 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) - fcvx = fcvx -uxmid*uymid*dx*dz - fcvy = fcvy -uymid*uymid*dx*dz - fcvz = fcvz -uymid*uzmid*dx*dz + 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 + fpry = fpry +prmid*dx*dz*(radial(1)-radial(3)) !viscous term dudymid = half*(tc1(i,j,k)+tc1(i+1,j,k)) @@ -1400,18 +1401,19 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + radial = [xm,ym,zm]-position uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) - fcvx = fcvx +uxmid*uymid*dx*dz - fcvy = fcvy +uymid*uymid*dx*dz - fcvz = fcvz +uymid*uzmid*dx*dz + 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 + fpry = fpry -prmid*dx*dz*(radial(1)-radial(3)) !viscous term dudymid = half*(tc1(i,j,k)+tc1(i+1,j,k)) @@ -1458,20 +1460,21 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ym=real(jj,mytype)*dz ! write(*,*) 'Calculating force at left x boundary', [xm,ym,zm] !momentum flux + radial = [xm,ym,zm]-position + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(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 + 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 + fprx = fprx +prmid*del_y(j)*dz*(radial(3)-radial(2)) !viscous term dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) @@ -1515,6 +1518,8 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ym=real(jj,mytype)*dy ! write(*,*) 'Calculating force at right x boundary', [xm,ym,zm] + radial = [xm,ym,zm]-position + !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) @@ -1522,14 +1527,15 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(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 + 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 + fprx = fprx -prmid*del_y(j)*dz*(radial(3)-radial(2)) !viscous term dudxmid = half*(ta2(i,j,k)+ta2(i,j+1,k)) @@ -1580,18 +1586,20 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at left z boundary', [xm,ym,zm] !momentum flux + radial = [xm,ym,zm]-position + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) - fcvx= fcvx +uxmid*uzmid*dx*dy - fcvy= fcvy +uymid*uzmid*dx*dy - fcvz= fcvz +uzmid*uzmid*dx*dy + 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 + fprz = fprz -prmid*dx*dy*(radial(2)-radial(1)) !viscous term dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) @@ -1639,6 +1647,8 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ii=xstart(1)+i-1 xm=real(ii,mytype)*dx !momentum flux + radial = [xm,ym,zm]-position + call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] @@ -1646,13 +1656,14 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) - fcvx= fcvx -uxmid*uzmid*dx*dy - fcvy= fcvy -uymid*uzmid*dx*dy - fcvz= fcvz -uzmid*uzmid*dx*dy + 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 + fprz = fprz +prmid*dx*dy*(radial(2)-radial(1)) !viscous term dudzmid = half*(tg1(i,j,k)+tg1(i+1,j,k)) @@ -1737,9 +1748,9 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) endif if ((nrank .eq. 0).and.(record_var.eq.1)) 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(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(38+(iv-1)) + call flush(45+(iv-1)) endif ! if (mod(itime, ioutput).eq.0) then ! if (nrank .eq. 0) then From b1148776f83381050619d5be8dd4b819fcb74b3d Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 21 May 2024 21:36:48 +0100 Subject: [PATCH 052/125] completed correct torque integrals for viscous terms --- src/forces.f90 | 67 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 47 insertions(+), 20 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index ff6b1025b..e861dbb38 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1362,9 +1362,13 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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) + 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 @@ -1422,9 +1426,13 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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) + 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(kk)=tconvxl(kk)+fcvx @@ -1483,9 +1491,14 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 + 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(kk)=tconvxl(kk)+fcvx tconvyl(kk)=tconvyl(kk)+fcvy @@ -1544,9 +1557,14 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 + 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(kk)=tconvxl(kk)+fcvx @@ -1607,10 +1625,15 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 + + 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 @@ -1671,10 +1694,14 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 + + 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 From 40aa0104404ddc1718c0b9bb109f64e02c3933cf Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 21 May 2024 22:44:23 +0100 Subject: [PATCH 053/125] fixed derivative in volume integral and added integration to main program --- src/forces.f90 | 74 +++++++++++++++++++++++--------------------- src/module_param.f90 | 2 +- src/xcompact3d.f90 | 13 +++++--- 3 files changed, 49 insertions(+), 40 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index e861dbb38..8d4bdb7a0 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -640,9 +640,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) ! - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) !- linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) !- linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx -uxmid*uymid*dx*dz fcvy = fcvy -uymid*uymid*dx*dz @@ -699,9 +699,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k))! - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k))! - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k))! - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx +uxmid*uymid*dx*dz fcvy = fcvy +uymid*uymid*dx*dz @@ -758,9 +758,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at left x boundary', [xm,ym,zm] !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k))! - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k))! - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k))! - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx -uxmid*uxmid*del_y(j)*dz @@ -816,9 +816,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k))! - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k))! - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k))! - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) fcvx = fcvx + uxmid*uxmid*del_y(j)*dz @@ -880,9 +880,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k))! - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k))! - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k))! - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) fcvx= fcvx +uxmid*uzmid*dx*dy fcvy= fcvy +uymid*uzmid*dx*dy @@ -941,9 +941,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k))! - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k))! - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k))! - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) fcvx= fcvx -uxmid*uzmid*dx*dy fcvy= fcvy -uymid*uzmid*dx*dy @@ -1048,25 +1048,27 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! 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 + 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(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) + subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) USE param USE variables @@ -1133,6 +1135,7 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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' @@ -1257,16 +1260,17 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! 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+crossProduct((fac1-coriolis(1)-centrifugal(1)),[xm,ym,zm]-position)*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumx+fac*dx*dy/dt + call crossProduct(([fac1,fac2,fac3]),[xm,ym,zm]-position, 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+(fac2-coriolis(2)-centrifugal(2))*dx*del_y(j+(xstart(2)-1))*dz/dt !tsumy+fac*dx*dy/dt + 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+(fac3-coriolis(3)-centrifugal(3))*dx*del_y(j+(xstart(2)-1))*dz/dt + 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 @@ -1802,5 +1806,5 @@ subroutine torque(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) return - end subroutine torque + end subroutine torque_calc end module forces diff --git a/src/module_param.f90 b/src/module_param.f90 index 9d16bbe87..96afe048d 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -622,6 +622,6 @@ module ibm_param real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega, tconv2_sign integer :: inana ! Analytical BC as Input - integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag + integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag end module ibm_param !############################################################################ diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index b5718b0b4..9716d7bc7 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -17,9 +17,9 @@ program xcompact3d use ibm, only : body use genepsi, only : genepsi3d use ellipsoid_utils, only: lin_step, ang_step, QuaternionNorm - use forces, only : force, init_forces, iforces,update_forces, xld,xrd,yld,yud,zld,zrd + use forces, only : force, init_forces, iforces,update_forces, xld,xrd,yld,yud,zld,zrd,torque_calc implicit none - real(mytype) :: dummy,drag,lift,lat,grav_effy,grav_effx,grav_effz + real(mytype) :: dummy,drag,lift,lat,grav_effy,grav_effx,grav_effz,xtorq,ytorq,ztorq integer :: iounit,ierr,i real, dimension(100) :: x @@ -139,8 +139,13 @@ program xcompact3d close(20) endif - torque(:)=zero - + + if (torques_flag.eq.1) then + call torque_calc(ux1,uy1,uz1,ep1,xtorq,ytorq,ztorq,1) + torque = [xtorq,ytorq,ztorq] + else + torque(:) = zero + endif ! if (nrank==0) then ! if (bodies_fixed==0) then From ab786a09571fc0e0ceaa3eedc2b3eb610c945880 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 21 May 2024 22:55:02 +0100 Subject: [PATCH 054/125] more options with torque inputs --- src/module_param.f90 | 2 +- src/xcompact3d.f90 | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/module_param.f90 b/src/module_param.f90 index 96afe048d..8514074f8 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -622,6 +622,6 @@ module ibm_param real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega, tconv2_sign integer :: inana ! Analytical BC as Input - integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag + integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free end module ibm_param !############################################################################ diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 9716d7bc7..97779170a 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -142,6 +142,8 @@ program xcompact3d if (torques_flag.eq.1) then call torque_calc(ux1,uy1,uz1,ep1,xtorq,ytorq,ztorq,1) + endif + if (orientations_free.eq.1) then torque = [xtorq,ytorq,ztorq] else torque(:) = zero From d48d8c3b0a417d8d84096b859314a29bfa689e8a Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 21 May 2024 23:38:54 +0100 Subject: [PATCH 055/125] fixed parameter input --- src/parameters.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameters.f90 b/src/parameters.f90 index 2e50404ee..3e4168e13 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -62,7 +62,8 @@ subroutine parameter(input_i3d) NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & 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 + 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 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, & From 8bf279c53266a25ae42d572106cf299035e388b8 Mon Sep 17 00:00:00 2001 From: adfboyd Date: Wed, 22 May 2024 03:59:35 +0100 Subject: [PATCH 056/125] edits --- src/forces.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 8d4bdb7a0..a039a1b84 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -557,16 +557,16 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! 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(j+xstart(2)-1)*dz/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(j+xstart(2)-1)*dz/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(j+xstart(2)-1)*dz/dt + tsumz = tsumz+fac3*dx*del_y(min(ny-1,j+xstart(2)-1))*dz/dt enddo enddo tunstxl(xstart(3)-1+k)=tsumx From 064ff3b44b8fc5cecd1c99574d38e14f52ff6f71 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 5 Jun 2024 13:44:20 +0100 Subject: [PATCH 057/125] fixed pressure in torque_calc --- src/forces.f90 | 58 +++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 50 insertions(+), 8 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index a039a1b84..00e8f5505 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1261,7 +1261,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! 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, 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+angular_velocity_result(1)*dx*dy + yel_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 @@ -1333,7 +1334,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fcvx=zero fcvy=zero fcvz=zero + fprx=zero fpry=zero + fprz=zero fdix=zero fdiy=zero fdiz=zero @@ -1357,7 +1360,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !pressure prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) - fpry = fpry +prmid*dx*dz*(radial(1)-radial(3)) + ! 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)) @@ -1380,7 +1385,11 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) tconvxl(kk)=tconvxl(kk)+fcvx tconvyl(kk)=tconvyl(kk)+fcvy tconvzl(kk)=tconvzl(kk)+fcvz + + tpresxl(kk)=tpresxl(kk)+fprx tpresyl(kk)=tpresyl(kk)+fpry + tpreszl(kk)=tpreszl(kk)+fprz + tdiffxl(kk)=tdiffxl(kk)+fdix tdiffyl(kk)=tdiffyl(kk)+fdiy tdiffzl(kk)=tdiffzl(kk)+fdiz @@ -1397,7 +1406,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fcvx=zero fcvy=zero fcvz=zero + fprx=zero fpry=zero + fprz=zero fdix=zero fdiy=zero fdiz=zero @@ -1421,7 +1432,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !pressure prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) - fpry = fpry -prmid*dx*dz*(radial(1)-radial(3)) + ! 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)) @@ -1443,7 +1456,10 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) tconvyl(kk)=tconvyl(kk)+fcvy tconvzl(kk)=tconvzl(kk)+fcvz + tpresxl(kk)=tpresxl(kk)+fprx tpresyl(kk)=tpresyl(kk)+fpry + tpreszl(kk)=tpreszl(kk)+fprz + tdiffxl(kk)=tdiffxl(kk)+fdix tdiffyl(kk)=tdiffyl(kk)+fdiy tdiffzl(kk)=tdiffzl(kk)+fdiz @@ -1463,6 +1479,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fcvy=zero fcvz=zero fprx=zero + fpry=zero + fprz=zero fdix=zero fdiy=zero fdiz=zero @@ -1486,7 +1504,10 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !pressure prmid = half*(ppi2(i,j,k)+ppi2(i,j+1,k)) - fprx = fprx +prmid*del_y(j)*dz*(radial(3)-radial(2)) + ! 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)) @@ -1509,6 +1530,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) tconvzl(kk)=tconvzl(kk)+fcvz tpresxl(kk)=tpresxl(kk)+fprx + tpresyl(kk)=tpresyl(kk)+fpry + tpreszl(kk)=tpreszl(kk)+fprz + tdiffxl(kk)=tdiffxl(kk)+fdix tdiffyl(kk)=tdiffyl(kk)+fdiy tdiffzl(kk)=tdiffzl(kk)+fdiz @@ -1527,6 +1551,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fcvy=zero fcvz=zero fprx=zero + fpry=zero + fprz=zero fdix=zero fdiy=zero fdiz=zero @@ -1552,7 +1578,10 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !pressure prmid = half*(ppi2(i,j,k)+ppi2(i,j+1,k)) - fprx = fprx -prmid*del_y(j)*dz*(radial(3)-radial(2)) + ! 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)) @@ -1576,6 +1605,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) tconvzl(kk)=tconvzl(kk)+fcvz tpresxl(kk)=tpresxl(kk)+fprx + tpresyl(kk)=tpresyl(kk)+fpry + tpreszl(kk)=tpreszl(kk)+fprz + tdiffxl(kk)=tdiffxl(kk)+fdix tdiffyl(kk)=tdiffyl(kk)+fdiy tdiffzl(kk)=tdiffzl(kk)+fdiz @@ -1593,8 +1625,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fcvx=zero fcvy=zero fcvz=zero + fprx=zero + fpry=zero fprz=zero - fdix=zero fdiy=zero fdiz=zero do j=jcvlw_lx(iv),jcvup_lx(iv) @@ -1621,7 +1654,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !pressure prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) - fprz = fprz -prmid*dx*dy*(radial(2)-radial(1)) + ! 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)) @@ -1661,6 +1696,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fcvx=zero fcvy=zero fcvz=zero + fprx=zero + fpry=zero fprz=zero fdix=zero fdiy=zero @@ -1690,7 +1727,10 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !pressure prmid = half*(ppi1(i,j,k)+ppi1(i+1,j,k)) - fprz = fprz +prmid*dx*dy*(radial(2)-radial(1)) + ! 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)) @@ -1713,6 +1753,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) tconvxl2(kk)=tconvxl2(kk)+fcvx tconvyl2(kk)=tconvyl2(kk)+fcvy tconvzl2(kk)=tconvzl2(kk)+fcvz + tpresxl(kk) =tpresxl(kk) +fcvx + tpresyl(kk) =tpresyl(kk) +fcvy tpreszl(kk) =tpreszl(kk) +fprz tdiffxl2(kk)=tdiffxl2(kk)+fdix tdiffyl2(kk)=tdiffyl2(kk)+fdiy From 8c28aad5cb2bcba0fa10eec1d3f4e3c76d347683 Mon Sep 17 00:00:00 2001 From: not populated Date: Wed, 12 Jun 2024 11:15:52 +0100 Subject: [PATCH 058/125] fixed compile error from local --- src/ellip_utils.f90 | 2 +- src/forces.f90 | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 83fae9874..17a044016 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -251,7 +251,7 @@ subroutine is_inside_ellipsoid(point, centre, orientation, shape, ra, zeromach, real(mytype) :: r call EllipsoidalRadius(point,centre,orientation,shape,r) - + is_inside = ((r-ra).lt.zeromach) end subroutine is_inside_ellipsoid diff --git a/src/forces.f90 b/src/forces.f90 index 00e8f5505..8f0e9d1ad 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1261,8 +1261,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! 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, angular_velocity_result) - tsumx = tsumx+angular_velocity_result(1)*dx*dy - yel_y(j+(xstart(2)-1))*dz/dt !tsumx+fac*dx*dy/dt + 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 From 1fe1d0e9892d707c59b7cec794e0ffe62d78255e Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 12 Jun 2024 11:43:06 +0100 Subject: [PATCH 059/125] fixed compile error --- src/forces.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 00e8f5505..885e1ade2 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1261,8 +1261,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! 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, angular_velocity_result) - tsumx = tsumx+angular_velocity_result(1)*dx*dy - yel_y(j+(xstart(2)-1))*dz/dt !tsumx+fac*dx*dy/dt + 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 @@ -1702,7 +1701,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) fdix=zero fdiy=zero fdiz=zero -! do k=1,xsize(3) + ! do k=1,xsize(3) do j=jcvlw_lx(iv),jcvup_lx(iv) ! kk = xstart(2)-1+j jj = xstart(2)-1+j From df19d2e70afeddeac254dc13223371b2beefb68c Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 12 Jun 2024 15:29:34 +0100 Subject: [PATCH 060/125] fixed forces summing over vectors --- src/forces.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 885e1ade2..b80a33eaf 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -999,9 +999,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) tp2 = sum(tpresy(:))/dt tp3 = sum(tpresz(:))/dt - mom1 = sum(tunstx(:) + tconvx(:) + (-2.0*tconv2_sign+1.0)*tconvx2(:)) !if tconv2sign == 1.0, multiply by -1 - mom2 = sum(tunsty(:) + tconvy(:) + (-2.0*tconv2_sign+1.0)*tconvy2(:)) - mom3 = sum(tunstz(:) + tconvz(:) + (-2.0*tconv2_sign+1.0)*tconvz2(:)) + 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 = (sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) dra2 = (sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) From 2fcba8f374bbb3d644e69e858f397b900811a0ac Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 12 Jun 2024 15:40:44 +0100 Subject: [PATCH 061/125] fixed in torque_calc --- src/forces.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index b80a33eaf..8d1b93b64 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1783,9 +1783,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) tp2 = sum(tpresy(:))/dt tp3 = sum(tpresz(:))/dt - mom1 = sum(tunstx(:) + tconvx(:) + (-2.0*tconv2_sign+1.0)*tconvx2(:)) !if tconv2sign == 1.0, multiply by -1 - mom2 = sum(tunsty(:) + tconvy(:) + (-2.0*tconv2_sign+1.0)*tconvy2(:)) - mom3 = sum(tunstz(:) + tconvz(:) + (-2.0*tconv2_sign+1.0)*tconvz2(:)) + 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 = (sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) dra2 = (sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) From cadc6b9957c6c59a8f6ad63393acbe967e2949d4 Mon Sep 17 00:00:00 2001 From: adfboyd Date: Mon, 17 Jun 2024 01:27:41 +0100 Subject: [PATCH 062/125] added shear flow options in BC-Ellipsoid --- src/BC-Ellipsoid.f90 | 55 ++++++++++++++++++++++++++++++++++++++++---- src/module_param.f90 | 4 ++-- src/parameters.f90 | 2 +- src/xcompact3d.f90 | 2 +- 4 files changed, 55 insertions(+), 8 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 022acf80f..43775f9c7 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -130,7 +130,7 @@ subroutine inflow (phi) implicit none - integer :: j,k,is + integer :: i,j,k,is real(mytype),dimension(xsize(1),xsize(2),xsize(3),numscalar) :: phi !call random_number(bxo) @@ -144,6 +144,33 @@ subroutine inflow (phi) 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) @@ -245,8 +272,8 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) 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 - integer :: k,j,i,ii,is,code + real(mytype) :: y,um,eqr,ym + integer :: k,j,i,ii,is,code,jj ! write(*,*) 'INSIDE INIT ELLIP' @@ -276,8 +303,22 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) 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 - ux1=zero; uy1=zero; uz1=zero + + uy1=zero; uz1=zero if (iin.ne.0) then call system_clock(count=code) @@ -320,6 +361,12 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) 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 diff --git a/src/module_param.f90 b/src/module_param.f90 index 8514074f8..1dfe0351b 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -620,8 +620,8 @@ module ibm_param real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air,cvl_scalar,grav_y,grav_x,grav_z real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(4),linearAcceleration(3),linearForce(3),torque(3),shape(3),inertia(3,3) real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) - real(mytype) :: chord,thickness,omega, tconv2_sign + real(mytype) :: chord,thickness,omega, tconv2_sign, shear_velocity integer :: inana ! Analytical BC as Input - integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free + integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free, shear_flow_ybc, shear_flow_zbc end module ibm_param !############################################################################ diff --git a/src/parameters.f90 b/src/parameters.f90 index 3e4168e13..3e63f4547 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -63,7 +63,7 @@ subroutine parameter(input_i3d) NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & 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 + torques_flag, orientations_free, shear_flow_ybc, shear_flow_zbc, shear_velocity 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, & diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 97779170a..56d39190c 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -167,7 +167,7 @@ program xcompact3d write(*,*) "Linear velocity = ", linearVelocity write(*,*) "Angular velocity = ", angularVelocity write(*,*) "Linear Force = ", [drag,lift,lat] - + write(*,*) "Torque = ", [xtorq,ytorq,ztorq] ! call QuaternionNorm(angularVelocity,dummy) ! write(*,*) 'Norm of angvel = ', dummy From 8417d53214524724622d3340bc3a5a3910ec22cb Mon Sep 17 00:00:00 2001 From: adfboyd Date: Mon, 17 Jun 2024 02:28:57 +0100 Subject: [PATCH 063/125] fixed final sign on torque calculation --- src/forces.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 8d1b93b64..367fe8926 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1787,9 +1787,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 = (sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) - dra2 = (sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) - dra3 = (sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) + dra1 = -(sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) + dra2 = -(sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) + dra3 = -(sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) do k=1,zsize(3) From 167526e4b3a349abf0c3e14d42c8d92e6e728fa7 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 17 Jun 2024 10:09:46 +0100 Subject: [PATCH 064/125] generalised control volume scalar --- src/xcompact3d.f90 | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 56d39190c..d757c64c0 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -19,7 +19,7 @@ program xcompact3d 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 implicit none - real(mytype) :: dummy,drag,lift,lat,grav_effy,grav_effx,grav_effz,xtorq,ytorq,ztorq + real(mytype) :: dummy,drag,lift,lat,grav_effy,grav_effx,grav_effz,xtorq,ytorq,ztorq,maxrad integer :: iounit,ierr,i real, dimension(100) :: x @@ -73,13 +73,14 @@ program xcompact3d if (imove.eq.1) then ! update epsi for moving objects if ((iibm.eq.2).or.(iibm.eq.3)) then call genepsi3d(ep1) + maxrad = max(shape(1),shape(2),shape(3)) if (iforces.eq.1) then - xld(1) = position(1) - shape(1) * ra * cvl_scalar - xrd(1) = position(1) + shape(1) * ra * cvl_scalar - yld(1) = position(2) - shape(1) * ra * cvl_scalar - yud(1) = position(2) + shape(1) * ra * cvl_scalar - zld(1) = position(3) - shape(1) * ra * cvl_scalar - zrd(1) = position(3) + shape(1) * ra * cvl_scalar + xld(1) = position(1) - maxrad * ra * cvl_scalar + xrd(1) = position(1) + maxrad * ra * cvl_scalar + yld(1) = position(2) - maxrad * ra * cvl_scalar + yud(1) = position(2) + maxrad * ra * cvl_scalar + zld(1) = position(3) - maxrad * ra * cvl_scalar + zrd(1) = position(3) + maxrad * ra * cvl_scalar if (itime.eq.ifirst) then call init_forces() else From b0b44237ffdaefb9cef6cf5f5499e534f5c03b84 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 17 Jun 2024 12:43:26 +0100 Subject: [PATCH 065/125] error check for nan --- src/ellip_utils.f90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 17a044016..68177f794 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -216,7 +216,12 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) scaled_point(i)=rotated_point(i)/shape(i) end do - radius=sqrt_prec(scaled_point(1)**two+scaled_point(2)**two+scaled_point(3)**two) + radius=sqrt_prec(scaled_point(1)**2+scaled_point(2)**2+scaled_point(3)**2) + + if (radius /= radius) then + write(*,*) "Got an error in grid check!" + write(*,*) "point = ", point + endif end subroutine From cbbbc5202abb4860c07e838aad5ad3f027518f6d Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 17 Jun 2024 12:48:51 +0100 Subject: [PATCH 066/125] got rid of stretching param in geomcomplex_ellip --- src/BC-Ellipsoid.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 43775f9c7..fac33d7cf 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -75,7 +75,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) zm=(real(k-1,mytype))*dz ! write(*,*) k, zm do j=nyi,nyf - ym=yp(j) + ym=(real(j-1,mytype))*dy do i=nxi,nxf xm=real(i-1,mytype)*dx point=[xm, ym, zm] From 05f36cdb69664c1c34728c1e69462a70484ad9fc Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 17 Jun 2024 13:37:50 +0100 Subject: [PATCH 067/125] slightly added debug comments --- src/ellip_utils.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 68177f794..e09b659ca 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -220,7 +220,7 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) if (radius /= radius) then write(*,*) "Got an error in grid check!" - write(*,*) "point = ", point + write(*,*) "Radius = ", radius, "point = ", point endif end subroutine From b92628b5f2cb4abe44b3355d2aee46bc5a353450 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 17 Jun 2024 13:41:36 +0100 Subject: [PATCH 068/125] even more debug comments --- src/ellip_utils.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index e09b659ca..4e771fb75 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -221,6 +221,8 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) if (radius /= radius) then write(*,*) "Got an error in grid check!" write(*,*) "Radius = ", radius, "point = ", point + write(*,*) "Rotated point = ", rotated_point + write(*,*) "Scaled Point = ", scaled_point endif end subroutine From 0d9fe7ef9705c4ac03eb16a7c665684b31b71bb7 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 17 Jun 2024 13:44:05 +0100 Subject: [PATCH 069/125] even more debug comments --- src/ellip_utils.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 4e771fb75..1dc5b361d 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -221,6 +221,8 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) if (radius /= radius) then write(*,*) "Got an error in grid check!" write(*,*) "Radius = ", radius, "point = ", point + write(*,*) "Translated point = ", trans_point + write(*,*) "Orientation = ", orientation write(*,*) "Rotated point = ", rotated_point write(*,*) "Scaled Point = ", scaled_point endif From 61f286b67b479cb32f748ec1670318f11be8025b Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 17 Jun 2024 14:32:20 +0100 Subject: [PATCH 070/125] final debug comments --- src/ellip_utils.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 1dc5b361d..d6956fc7e 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -220,7 +220,9 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) if (radius /= radius) then write(*,*) "Got an error in grid check!" - write(*,*) "Radius = ", radius, "point = ", point + write(*,*) "Radius = ", radius + write(*,*) "point = ", centre + write(*,*) "Body centre = ", position write(*,*) "Translated point = ", trans_point write(*,*) "Orientation = ", orientation write(*,*) "Rotated point = ", rotated_point From 14c9c48c47de5fee1df36998b4406308b5719836 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 17 Jun 2024 14:33:24 +0100 Subject: [PATCH 071/125] final final fix... --- src/ellip_utils.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index d6956fc7e..d89d15ffd 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -221,8 +221,8 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) if (radius /= radius) then write(*,*) "Got an error in grid check!" write(*,*) "Radius = ", radius - write(*,*) "point = ", centre - write(*,*) "Body centre = ", position + write(*,*) "point = ", point + write(*,*) "Body centre = ", centre write(*,*) "Translated point = ", trans_point write(*,*) "Orientation = ", orientation write(*,*) "Rotated point = ", rotated_point From da965418ff74e5a7c36beb419b7bd4de4441e48a Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 18 Jun 2024 23:33:35 +0100 Subject: [PATCH 072/125] changed location of debug --- src/BC-Ellipsoid.f90 | 10 ++++++++-- src/ellip_utils.f90 | 20 ++++++++++---------- 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index fac33d7cf..1f82800a8 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -22,7 +22,7 @@ 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 dbg_schemes, only: sqrt_prec - use ellipsoid_utils, only: NormalizeQuaternion, is_inside_ellipsoid + use ellipsoid_utils, only: NormalizeQuaternion, EllipsoidalRadius implicit none @@ -81,7 +81,13 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) point=[xm, ym, zm] ! call EllipsoidalRadius(point, position, orientation, shape, r) if (cube_flag.eq.0) then - call is_inside_ellipsoid(point, position, orientation, shape, ra, zeromach, is_inside) + call EllipsoidalRadius(point,position,orientation,shape,r) + is_inside = (r-ra).lt.zeromach + + if (ra /= ra) then + write(*,*) "Nrank = ", nrank + write(*,*) "Point = ", point + endif else if (cube_flag.eq.1) then is_inside = (abs(xm-position(1)).lt.ra).and.(abs(ym-position(2)).lt.ra).and.(abs(zm-position(3)).lt.ra) endif diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index d89d15ffd..f3a707a8a 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -218,16 +218,16 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) radius=sqrt_prec(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 + ! 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 From 8dc51e94ec027141f9deedf67c70f57c0caf50a2 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 18 Jun 2024 23:46:44 +0100 Subject: [PATCH 073/125] added failsafe for nan solutions --- src/tools.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/tools.f90 b/src/tools.f90 index 41295f49d..2723f7ac5 100644 --- a/src/tools.f90 +++ b/src/tools.f90 @@ -130,6 +130,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 From ce4344e490245ed4746d129c923897eb5e5d76ed Mon Sep 17 00:00:00 2001 From: s2006749 Date: Sun, 23 Jun 2024 16:39:35 +0100 Subject: [PATCH 074/125] debugging options for epsi fn --- src/BC-Ellipsoid.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 1f82800a8..b25ca7717 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -139,6 +139,12 @@ subroutine inflow (phi) 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) From b6f0c04427cfe48993d34b027c420d8524d8178e Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 25 Jul 2024 13:14:50 +0100 Subject: [PATCH 075/125] fixwed y ibm issue --- src/BC-Ellipsoid.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index b25ca7717..c54e03a40 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -75,7 +75,8 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) zm=(real(k-1,mytype))*dz ! write(*,*) k, zm do j=nyi,nyf - ym=(real(j-1,mytype))*dy + ! ym=(real(j-1,mytype))*dy + ym=yp(j) do i=nxi,nxf xm=real(i-1,mytype)*dx point=[xm, ym, zm] From 00130725b829523644b7a6f5e22f163c9e194e00 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 8 Aug 2024 11:24:12 +0100 Subject: [PATCH 076/125] fixed sign in left box pressure calculation for torques --- src/forces.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 367fe8926..c1e950271 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1654,8 +1654,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !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)) + 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)) From 6974fe7546bdfd6218a481848b983a7db05a473b Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 8 Aug 2024 14:43:00 +0100 Subject: [PATCH 077/125] found another bug in fprx/y summation. Added debug variable for torque outputs --- src/forces.f90 | 118 ++++++++++++++++++++++++------------------- src/module_param.f90 | 2 +- 2 files changed, 67 insertions(+), 53 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index c1e950271..741c85a59 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1160,6 +1160,15 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) open(45+(iv-1),file=filename,status='unknown',form='formatted') ! write(*,*) 'Opened file: ', filename, 'number = ', 38+(iv-1) endif + if ((nrank.eq.0).and.(torq_debug.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') + endif + enddo do k = 1, xsize(3) do j = 1, xsize(2) @@ -1381,18 +1390,19 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) enddo - tconvxl(kk)=tconvxl(kk)+fcvx - tconvyl(kk)=tconvyl(kk)+fcvy - tconvzl(kk)=tconvzl(kk)+fcvz + tconvxl(1)=tconvxl(1)+fcvx + tconvyl(1)=tconvyl(1)+fcvy + tconvzl(1)=tconvzl(1)+fcvz - tpresxl(kk)=tpresxl(kk)+fprx - tpresyl(kk)=tpresyl(kk)+fpry - tpreszl(kk)=tpreszl(kk)+fprz + tpresxl(1)=tpresxl(1)+fprx + ! tpresyl(1)=tpresyl(1)+fpry + tpreszl(1)=tpreszl(1)+fprz - tdiffxl(kk)=tdiffxl(kk)+fdix - tdiffyl(kk)=tdiffyl(kk)+fdiy - tdiffzl(kk)=tdiffzl(kk)+fdiz + 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 @@ -1451,17 +1461,17 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! fdiz = fdiz + (xnu*(dwdymid+dvdzmid)*dx*dz) enddo - tconvxl(kk)=tconvxl(kk)+fcvx - tconvyl(kk)=tconvyl(kk)+fcvy - tconvzl(kk)=tconvzl(kk)+fcvz + tconvxl(2)=tconvxl(2)+fcvx + tconvyl(2)=tconvyl(2)+fcvy + tconvzl(2)=tconvzl(2)+fcvz - tpresxl(kk)=tpresxl(kk)+fprx - tpresyl(kk)=tpresyl(kk)+fpry - tpreszl(kk)=tpreszl(kk)+fprz + tpresxl(2)=tpresxl(2)+fprx + ! tpresyl(2)=tpresyl(2)+fpry + tpreszl(2)=tpreszl(2)+fprz - tdiffxl(kk)=tdiffxl(kk)+fdix - tdiffyl(kk)=tdiffyl(kk)+fdiy - tdiffzl(kk)=tdiffzl(kk)+fdiz + tdiffxl(2)=tdiffxl(2)+fdix + tdiffyl(2)=tdiffyl(2)+fdiy + tdiffzl(2)=tdiffzl(2)+fdiz enddo endif @@ -1524,17 +1534,17 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! 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 + tconvxl(3)=tconvxl(3)+fcvx + tconvyl(3)=tconvyl(3)+fcvy + tconvzl(3)=tconvzl(3)+fcvz - tpresxl(kk)=tpresxl(kk)+fprx - tpresyl(kk)=tpresyl(kk)+fpry - tpreszl(kk)=tpreszl(kk)+fprz + ! tpresxl(3)=tpresxl(3)+fprx + tpresyl(3)=tpresyl(3)+fpry + tpreszl(3)=tpreszl(3)+fprz - tdiffxl(kk)=tdiffxl(kk)+fdix - tdiffyl(kk)=tdiffyl(kk)+fdiy - tdiffzl(kk)=tdiffzl(kk)+fdiz + tdiffxl(3)=tdiffxl(3)+fdix + tdiffyl(3)=tdiffyl(3)+fdiy + tdiffzl(3)=tdiffzl(3)+fdiz enddo endif @@ -1599,17 +1609,17 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! 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 + tconvxl(4)=tconvxl(4)+fcvx + tconvyl(4)=tconvyl(4)+fcvy + tconvzl(4)=tconvzl(4)+fcvz - tpresxl(kk)=tpresxl(kk)+fprx - tpresyl(kk)=tpresyl(kk)+fpry - tpreszl(kk)=tpreszl(kk)+fprz + ! tpresxl(4)=tpresxl(4)+fprx + tpresyl(4)=tpresyl(4)+fpry + tpreszl(4)=tpreszl(4)+fprz - tdiffxl(kk)=tdiffxl(kk)+fdix - tdiffyl(kk)=tdiffyl(kk)+fdiy - tdiffzl(kk)=tdiffzl(kk)+fdiz + tdiffxl(4)=tdiffxl(4)+fdix + tdiffyl(4)=tdiffyl(4)+fdiy + tdiffzl(4)=tdiffzl(4)+fdiz enddo endif @@ -1677,13 +1687,15 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !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 + 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 @@ -1749,15 +1761,17 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 - tpresxl(kk) =tpresxl(kk) +fcvx - tpresyl(kk) =tpresyl(kk) +fcvy - tpreszl(kk) =tpreszl(kk) +fprz - tdiffxl2(kk)=tdiffxl2(kk)+fdix - tdiffyl2(kk)=tdiffyl2(kk)+fdiy - tdiffzl2(kk)=tdiffzl2(kk)+fdiz + tconvxl2(6)=tconvxl2(6)+fcvx + tconvyl2(6)=tconvyl2(6)+fcvy + tconvzl2(6)=tconvzl2(6)+fcvz + + tpresxl(6) =tpresxl(6) +fcvx + tpresyl(6) =tpresyl(6) +fcvy + ! 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) diff --git a/src/module_param.f90 b/src/module_param.f90 index 1dfe0351b..ff3167d7a 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -622,6 +622,6 @@ module ibm_param real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega, tconv2_sign, shear_velocity integer :: inana ! Analytical BC as Input - integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free, shear_flow_ybc, shear_flow_zbc + integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free, shear_flow_ybc, shear_flow_zbc,torq_debug end module ibm_param !############################################################################ From aa32ea4aea3c498ab8c0fc7bf8ce8b0bbc7e0226 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 8 Aug 2024 15:03:15 +0100 Subject: [PATCH 078/125] added torq_debug var to input reading --- src/parameters.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameters.f90 b/src/parameters.f90 index 3e63f4547..e5d1090f5 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -63,7 +63,7 @@ subroutine parameter(input_i3d) NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & 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 + torques_flag, orientations_free, shear_flow_ybc, shear_flow_zbc, shear_velocity, torq_debug 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, & From f3a8c2036e210b89ffb45e69773ed667a2d7e8cf Mon Sep 17 00:00:00 2001 From: s2006749 Date: Fri, 9 Aug 2024 15:10:51 +0100 Subject: [PATCH 079/125] added debug csvs for torque calc --- src/forces.f90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/forces.f90 b/src/forces.f90 index 741c85a59..e7299aafe 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1837,6 +1837,22 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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) + + call flush(100) + call flush(101) + call flush(102) + call flush(103) + call flush(104) + call flush(105) + endif endif ! if (mod(itime, ioutput).eq.0) then ! if (nrank .eq. 0) then From 5883f81e81101aae23d7b41a87731553d03b68fc Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 12 Aug 2024 10:50:22 +0100 Subject: [PATCH 080/125] removed double scaling of pressure terms in debug output --- src/forces.f90 | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index e7299aafe..76d20c3a8 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1805,21 +1805,21 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) dra2 = -(sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) dra3 = -(sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) - do k=1,zsize(3) + ! do k=1,zsize(3) - tpresx(k)=tpresx(k)/dt - tpresy(k)=tpresy(k)/dt - tpresz(k)=tpresz(k)/dt + ! 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) + ! 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 + ! enddo !Edited by F. Schuch xDrag_mean = sum(xDrag(:))/real(nz,mytype) From 0ea0d712e56b8abf7b54df935960572e63fb4344 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 12 Aug 2024 11:11:11 +0100 Subject: [PATCH 081/125] Found bug in tpresxl(6), fixed --- src/forces.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 76d20c3a8..61df3ea4e 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1765,8 +1765,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) tconvyl2(6)=tconvyl2(6)+fcvy tconvzl2(6)=tconvzl2(6)+fcvz - tpresxl(6) =tpresxl(6) +fcvx - tpresyl(6) =tpresyl(6) +fcvy + tpresxl(6) =tpresxl(6) +fprx !!!!!!!! + tpresyl(6) =tpresyl(6) +fpry ! tpreszl(6) =tpreszl(6) +fprz tdiffxl2(6)=tdiffxl2(6)+fdix From e6479a87792a5ffb4612c25f18a5c3ff307b6163 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 13 Aug 2024 11:59:06 +0100 Subject: [PATCH 082/125] added more debugging outputs for torque calculation --- src/forces.f90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/forces.f90 b/src/forces.f90 index 61df3ea4e..1877c4e9e 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1167,6 +1167,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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",status='unknown',form='formatted') + open(107,file="ztorque_decomposition",status='unknown',form='formatted') endif enddo @@ -1846,12 +1848,18 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 From c9db24e73a0f52fc9422546afdd9288ca0d6425a Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 13 Aug 2024 13:46:49 +0100 Subject: [PATCH 083/125] flipped sign on torque calc --- src/forces.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 1877c4e9e..961f26074 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1803,9 +1803,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 = -(sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) - dra2 = -(sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) - dra3 = -(sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) + dra1 = (sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) + dra2 = (sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) + dra3 = (sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) ! do k=1,zsize(3) From ebfb75b9f671cc053c49fe17a2826f9b59d44d48 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 14 Aug 2024 11:34:46 +0100 Subject: [PATCH 084/125] added option to flip torque sign --- src/forces.f90 | 6 +++--- src/module_param.f90 | 2 +- src/parameters.f90 | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 961f26074..44915cf61 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1803,9 +1803,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 = (sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) - dra2 = (sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) - dra3 = (sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) + dra1 = -(sum(tdiffx) + sum(tdiffx2) + tp1 - mom1)*(1.0-2.0*torq_flip) + dra2 = -(sum(tdiffy) + sum(tdiffy2) + tp2 - mom2)*(1.0-2.0*torq_flip) + dra3 = -(sum(tdiffz) + sum(tdiffz2) + tp3 - mom3)*(1.0-2.0*torq_flip) ! do k=1,zsize(3) diff --git a/src/module_param.f90 b/src/module_param.f90 index ff3167d7a..1342d389a 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -622,6 +622,6 @@ module ibm_param real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega, tconv2_sign, shear_velocity integer :: inana ! Analytical BC as Input - integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free, shear_flow_ybc, shear_flow_zbc,torq_debug + integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free, shear_flow_ybc, shear_flow_zbc,torq_debug, torq_flip end module ibm_param !############################################################################ diff --git a/src/parameters.f90 b/src/parameters.f90 index e5d1090f5..a7818016f 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -63,7 +63,7 @@ subroutine parameter(input_i3d) NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & 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 + torques_flag, orientations_free, shear_flow_ybc, shear_flow_zbc, shear_velocity, torq_debug, torq_flip 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, & From 300686e11a4258ad66dc0a911b2fff5487b8250c Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 15 Aug 2024 16:01:32 +0100 Subject: [PATCH 085/125] added csv output of body position --- src/forces.f90 | 5 +++++ src/xcompact3d.f90 | 30 ++++++++++++++++++++---------- 2 files changed, 25 insertions(+), 10 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 44915cf61..bb68e9f06 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -451,6 +451,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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') @@ -1039,6 +1042,8 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index d757c64c0..8634f356f 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -29,14 +29,17 @@ program 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='replace',action='write',iostat=ierr) - if (ierr /= 0) then - print *, 'Error opening file.' - stop - end if - write(*,*) 'Outputting forces' - end if + 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 + open(unit=12, file='body.dat1', status='unknown', form='formatted') + endif ! do i = 1,100 ! x(i) = i ! enddo @@ -134,10 +137,10 @@ program xcompact3d endif if ((nrank==0).and.(force_csv.eq.1)) then - open(unit=20, file='force_out.dat', action='write') - write(20, *) linearForce(1), linearForce(2), linearForce(3), '\n' + ! open(unit=20, file='force_out.dat', action='write') + write(20, *) linearForce(1), linearForce(2), linearForce(3) write(*,*) 'Writing forces', linearForce(1), linearForce(2), linearForce(3) - close(20) + flush(20) endif @@ -160,6 +163,13 @@ program xcompact3d orientation = orientation_1 angularVelocity = angularVelocity_1 + + + + if (nrank==0) then + write(12 ,*) t, position(1), position(2), position(3), orientation(1), orientation(2), orientation(3), orientation(4), linearVelocity(1), linearVelocity(2), linearVelocity(3), angularVelocity(2), angularVelocity(3), angularVelocity(4), drag, lift, lat, xtorq, ytorq, ztorq + flush(12) + endif ! endif if ((nrank==0).and.(mod(itime,ilist)==0)) then From 556e7a6afbc61bda39d0d411f1fa9ae43ffb0512 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 20 Aug 2024 14:23:58 +0100 Subject: [PATCH 086/125] fixed signs in torque face 6 integrals. Changed switch to rotating frame --- src/forces.f90 | 98 +++++++++++++++++++++++++------------------------- 1 file changed, 49 insertions(+), 49 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index bb68e9f06..6e79d1573 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -643,9 +643,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) fcvx = fcvx -uxmid*uymid*dx*dz fcvy = fcvy -uymid*uymid*dx*dz @@ -702,9 +702,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) fcvx = fcvx +uxmid*uymid*dx*dz fcvy = fcvy +uymid*uymid*dx*dz @@ -761,9 +761,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at left x boundary', [xm,ym,zm] !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) fcvx = fcvx -uxmid*uxmid*del_y(j)*dz @@ -819,9 +819,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) fcvx = fcvx + uxmid*uxmid*del_y(j)*dz @@ -883,9 +883,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) fcvx= fcvx +uxmid*uzmid*dx*dy fcvy= fcvy +uymid*uzmid*dx*dy @@ -944,9 +944,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) fcvx= fcvx -uxmid*uzmid*dx*dy fcvy= fcvy -uymid*uzmid*dx*dy @@ -1269,8 +1269,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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) + ! 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 @@ -1364,9 +1364,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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 @@ -1437,9 +1437,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) radial = [xm,ym,zm]-position - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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 @@ -1509,9 +1509,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) radial = [xm,ym,zm]-position call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(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 @@ -1581,9 +1581,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) fcvx = fcvx +(uymid*radial(3)-uzmid*radial(2))*uxmid*del_y(j)*dz @@ -1596,8 +1596,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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)) + 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)) @@ -1660,13 +1660,13 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) radial = [xm,ym,zm]-position call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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) + 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)) @@ -1681,9 +1681,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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*(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) @@ -1734,13 +1734,13 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) - rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) - rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) - rotationalComponent(3) + uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) + uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) + uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(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) + 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 From 592a0414e0b5ae15656ba65508e7a451c8e7cb60 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Fri, 6 Sep 2024 14:18:10 +0100 Subject: [PATCH 087/125] fixed CalculatePointVelocity --- src/ellip_utils.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index f3a707a8a..2a517075a 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -250,7 +250,7 @@ subroutine CalculatePointVelocity(point, center, angularVelocity, linearVelocity ! Compute the cross product of angular velocity and distance vector - call CrossProduct(angularVelocity, distance, crossed) + call CrossProduct(distance, angularVelocity, crossed) ! Calculate the velocity at the point pointVelocity = crossed + linearVelocity From 7e1f0dba408a15a774870023e7dd8819e484ab57 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Fri, 6 Sep 2024 14:45:21 +0100 Subject: [PATCH 088/125] fixed name of torque decomp files --- src/forces.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 6e79d1573..2895f3e68 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1172,8 +1172,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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",status='unknown',form='formatted') - open(107,file="ztorque_decomposition",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 From 4a8db0fd1d0280980b584f05e77547147ed0fb01 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 9 Sep 2024 12:30:45 +0100 Subject: [PATCH 089/125] fixed ibm points and angularVelocity handling --- src/ellip_utils.f90 | 7 +-- src/forces.f90 | 28 +++++----- src/ibm.f90 | 125 ++++++++++++++++++++++++++++++++++++++++---- 3 files changed, 132 insertions(+), 28 deletions(-) diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 2a517075a..db683465f 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -241,7 +241,7 @@ subroutine CrossProduct(a, b, result) end subroutine CrossProduct subroutine CalculatePointVelocity(point, center, angularVelocity, linearVelocity, pointVelocity) - real(mytype), intent(in) :: point(3), center(3), linearVelocity(3), angularVelocity(3) + 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 @@ -250,7 +250,8 @@ subroutine CalculatePointVelocity(point, center, angularVelocity, linearVelocity ! Compute the cross product of angular velocity and distance vector - call CrossProduct(distance, angularVelocity, crossed) + call CrossProduct(distance, angularVelocity(2:4), crossed) + ! Calculate the velocity at the point pointVelocity = crossed + linearVelocity @@ -271,7 +272,7 @@ end subroutine is_inside_ellipsoid subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1, ep1_x, ep1_y, ep1_z) use param use decomp_2d - real(mytype), intent(in) :: center(3), linearVelocity(3), angularVelocity(3) + real(mytype), intent(in) :: center(3), linearVelocity(3), angularVelocity(4) 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) diff --git a/src/forces.f90 b/src/forces.f90 index 2895f3e68..74f606757 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -552,8 +552,8 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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) + call coriolis_force(angularVelocity(2:4),[fac1,fac2,fac3],coriolis) + call centrifugal_force(angularVelocity(2:4), [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 @@ -642,7 +642,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at upper y boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) @@ -701,7 +701,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at lower y boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) @@ -760,7 +760,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ym=real(jj,mytype)*dz ! write(*,*) 'Calculating force at left x boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) @@ -818,7 +818,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at right x boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) @@ -882,7 +882,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at left z boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) @@ -941,7 +941,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ii=xstart(1)+i-1 xm=real(ii,mytype)*dx !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) @@ -1363,7 +1363,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) radial = [xm,ym,zm]-position !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) @@ -1435,7 +1435,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at lower y boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) radial = [xm,ym,zm]-position uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) @@ -1508,7 +1508,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux radial = [xm,ym,zm]-position - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) @@ -1580,7 +1580,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) radial = [xm,ym,zm]-position !momentum flux - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) @@ -1659,7 +1659,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux radial = [xm,ym,zm]-position - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) @@ -1731,7 +1731,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) !momentum flux radial = [xm,ym,zm]-position - call crossProduct(angularVelocity,[xm,ym,zm]-position,rotationalComponent) + call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) ! write(*,*) 'Calculating force at right z boundary', [xm,ym,zm] uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) diff --git a/src/ibm.f90 b/src/ibm.f90 index 3f4cc296f..8a389b574 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -402,7 +402,7 @@ subroutine cubsplx(u,lind) USE decomp_2d USE variables USE ibm_param - USE ellipsoid_utils, ONLY: CalculatePointVelocity + USE ellipsoid_utils, ONLY: CalculatePointVelocity, EllipsoidalRadius ! implicit none ! @@ -420,7 +420,7 @@ subroutine cubsplx(u,lind) integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf ! Position of Boundary (Analytically) real(mytype) :: point(3),pointVelocity(3) - real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv + real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv, dummy ! ! Initialise Arrays xa(:)=0. @@ -430,15 +430,18 @@ subroutine cubsplx(u,lind) ! bcimp=lind ! write(*,*) lind ! + dummy=0.0 do k=1,xsize(3) - zm=real(xstart(3)+k-2,mytype)*dz + zm=real(xstart(3)+k-1,mytype)*dz do j=1,xsize(2) - ym=real(xstart(2)+j-2,mytype)*dy + 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 - I DON'T UNDERSTAND THIS XM CONVERSION. - xm=real(xstart(1)+i-2,mytype)*dx + ! 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 @@ -450,6 +453,14 @@ subroutine cubsplx(u,lind) endif point=[xm,ym,zm] call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, 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 x_pv=pointVelocity(1) y_pv=pointVelocity(2) z_pv=pointVelocity(3) @@ -519,6 +530,42 @@ 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 + xm = xf(i,j,k) + point=[xm,ym,zm] + call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, 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 + 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=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 ya(ia)=bcimp if(xf(i,j,k).lt.xlx)then ! Immersed Object inxf=0 @@ -624,13 +671,13 @@ subroutine cubsply(u,lind) ! do k=1,ysize(3) - zm=real(ystart(3)+k-2,mytype)*dz + zm=real(ystart(3)+k-1,mytype)*dz do i=1,ysize(1) - xm=real(ystart(1)+i-2,mytype)*dx + xm=real(ystart(1)+i-1,mytype)*dx if(nobjy(i,k).ne.0)then ia=0 do j=1,nobjy(i,k) - ym=real(ystart(2)+j-2,mytype)*dy + ! ym=real(ystart(2)+j-2,mytype)*dy ! 1st Boundary nypif=npif ia=ia+1 @@ -641,6 +688,7 @@ 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(point, position, angularVelocity, linearVelocity, pointVelocity) x_pv=pointVelocity(1) @@ -716,6 +764,33 @@ 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(point, position, angularVelocity, linearVelocity, pointVelocity) + 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=x_pv + 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 ya(ia)=bcimp if(yf(j,i,k).lt.yly)then ! Immersed Object jy=1 @@ -822,14 +897,14 @@ subroutine cubsplz(u,lind) ! do j=1,zsize(2) - ym=real(zstart(2)+j-2,mytype)*dy + ym=real(zstart(2)+j-1,mytype)*dy do i=1,zsize(1) - xm=real(zstart(1)+i-2,mytype)*dx + 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 + ! zm=real(zstart(3)+k-2,mytype)*dz nzpif=npif ia=ia+1 if (ianal.eq.0) then @@ -839,6 +914,7 @@ 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(point, position, angularVelocity, linearVelocity, pointVelocity) x_pv=pointVelocity(1) @@ -907,6 +983,33 @@ 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(point, position, angularVelocity, linearVelocity, pointVelocity) + 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=x_pv + 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 ya(ia)=bcimp if(zf(k,i,j).lt.zlz)then ! Immersed Object inxf=0 From e73e5e80837ca5ebb3f57680fe8d98e5ce763b3e Mon Sep 17 00:00:00 2001 From: adfboyd Date: Mon, 16 Sep 2024 00:47:47 +0100 Subject: [PATCH 090/125] added option for only ztorq --- src/module_param.f90 | 2 +- src/parameters.f90 | 2 +- src/xcompact3d.f90 | 3 +++ 3 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/module_param.f90 b/src/module_param.f90 index 1342d389a..90386e2a1 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -622,6 +622,6 @@ module ibm_param real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) real(mytype) :: chord,thickness,omega, tconv2_sign, shear_velocity integer :: inana ! Analytical BC as Input - integer :: imove, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free, shear_flow_ybc, shear_flow_zbc,torq_debug, torq_flip + 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 end module ibm_param !############################################################################ diff --git a/src/parameters.f90 b/src/parameters.f90 index a7818016f..bdee32469 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -63,7 +63,7 @@ subroutine parameter(input_i3d) NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & 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 + torques_flag, orientations_free, shear_flow_ybc, shear_flow_zbc, shear_velocity, torq_debug, torq_flip, ztorq_only 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, & diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 8634f356f..ffec99fb0 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -149,6 +149,9 @@ program xcompact3d endif if (orientations_free.eq.1) then torque = [xtorq,ytorq,ztorq] + if (ztorq_only.eq.1) then + torque = [0.0_mytype, 0.0_mytype, ztorq] + endif else torque(:) = zero endif From bafdf492c8fc82107a7a29d47afaf44824d50b31 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 9 Oct 2024 16:25:35 +0100 Subject: [PATCH 091/125] vectorising all global body parameters to handle up to 10 bodies --- src/BC-Ellipsoid.f90 | 75 ++++++++++++------------ src/ellip_utils.f90 | 17 ++++++ src/forces.f90 | 132 +++++++++++++++++++++---------------------- src/genepsi3d.f90 | 70 +++++++++++++++++++---- src/module_param.f90 | 9 +-- src/parameters.f90 | 8 ++- src/xcompact3d.f90 | 63 ++++++++++++--------- 7 files changed, 228 insertions(+), 146 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index c54e03a40..94fc95625 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -31,7 +31,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) real(mytype),dimension(ny) :: yp real(mytype) :: dx,dz real(mytype) :: remp - integer :: i,j,k + integer :: i,j,k, i_body real(mytype) :: xm,ym,zm,r,rads2,kcon real(mytype) :: zeromach real(mytype) :: cexx,ceyy,cezz,dist_axi @@ -81,27 +81,30 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) xm=real(i-1,mytype)*dx point=[xm, ym, zm] ! call EllipsoidalRadius(point, position, orientation, shape, r) - if (cube_flag.eq.0) then - call EllipsoidalRadius(point,position,orientation,shape,r) - is_inside = (r-ra).lt.zeromach - - if (ra /= ra) then - write(*,*) "Nrank = ", nrank - write(*,*) "Point = ", point + 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 (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 - else if (cube_flag.eq.1) then - is_inside = (abs(xm-position(1)).lt.ra).and.(abs(ym-position(2)).lt.ra).and.(abs(zm-position(3)).lt.ra) - endif - ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two+(zm-cezz)**two) - ! r=sqrt_prec((xm-cexx)**two+(ym-ceyy)**two) - if (.not.is_inside) then - ! write(*,*) i, j, k - cycle - 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 + ! epsi(i,j,k)=remp ! write(*,*) remp enddo enddo @@ -290,26 +293,26 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) ! write(*,*) 'INSIDE INIT ELLIP' - eqr=(shx*shy*shz)**(1.0/3.0) - shape=[shx/eqr,shy/eqr,shz/eqr] + ! eqr=(sh(1)*sh(2)*sh(3))**(1.0/3.0) + ! shape=sh(:)/eqr - orientation=[oriw,orii,orij,orik] - call NormalizeQuaternion(orientation) - position=[cex,cey,cez] - linearVelocity=[lvx,lvy,lvz] - angularVelocity=[zero,avx,avy,avz] - call ellipInertiaCalculate(shape,rho_s,inertia) - call ellipMassCalculate(shape,rho_s,ellip_m) + ! 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 (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 diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index db683465f..ee2cf0b54 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -7,6 +7,7 @@ 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 @@ -257,6 +258,22 @@ subroutine CalculatePointVelocity(point, center, angularVelocity, linearVelocity 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 = minloc(radii) + + 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 diff --git a/src/forces.f90 b/src/forces.f90 index 74f606757..044673aa9 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -388,7 +388,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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,dra2,dra3 + 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 @@ -552,8 +552,8 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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(2:4),[fac1,fac2,fac3],coriolis) - call centrifugal_force(angularVelocity(2:4), [xm,ym,zm]-position,centrifugal) + 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 @@ -642,10 +642,10 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at upper y boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -701,10 +701,10 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at lower y boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -760,10 +760,10 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ym=real(jj,mytype)*dz ! write(*,*) 'Calculating force at left x boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -818,10 +818,10 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at right x boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -882,10 +882,10 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at left z boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -941,12 +941,12 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ii=xstart(1)+i-1 xm=real(ii,mytype)*dx !momentum flux - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) + 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(1) + rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -1006,9 +1006,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 = (sum(tdiffx) + sum(tdiffx2) + tp1 - mom1) - dra2 = (sum(tdiffy) + sum(tdiffy2) + tp2 - mom2) - dra3 = (sum(tdiffz) + sum(tdiffz2) + tp3 - mom3) + 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) @@ -1096,7 +1096,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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,dra2,dra3 + 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 @@ -1165,7 +1165,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) open(45+(iv-1),file=filename,status='unknown',form='formatted') ! write(*,*) 'Opened file: ', filename, 'number = ', 38+(iv-1) endif - if ((nrank.eq.0).and.(torq_debug.eq.1)) then + 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') @@ -1276,7 +1276,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! 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, angular_velocity_result) + 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 @@ -1360,13 +1360,13 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 + radial = [xm,ym,zm]-position(iv,:) !momentum flux - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -1435,11 +1435,11 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at lower y boundary', [xm,ym,zm] !momentum flux - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - radial = [xm,ym,zm]-position - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -1506,12 +1506,12 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ym=real(jj,mytype)*dz ! write(*,*) 'Calculating force at left x boundary', [xm,ym,zm] !momentum flux - radial = [xm,ym,zm]-position + radial = [xm,ym,zm]-position(iv,:) - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -1577,13 +1577,13 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ym=real(jj,mytype)*dy ! write(*,*) 'Calculating force at right x boundary', [xm,ym,zm] - radial = [xm,ym,zm]-position + radial = [xm,ym,zm]-position(iv,:) !momentum flux - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux2(i,j,k)+ux2(i,j+1,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy2(i,j,k)+uy2(i,j+1,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz2(i,j,k)+uz2(i,j+1,k)) - linearVelocity(3) + rotationalComponent(3) + 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 @@ -1657,12 +1657,12 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Calculating force at left z boundary', [xm,ym,zm] !momentum flux - radial = [xm,ym,zm]-position + radial = [xm,ym,zm]-position(iv,:) - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) - uxmid = half*(ux1(i,j,k)+ux1(i+1,j,k)) - linearVelocity(1) + rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) + 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) @@ -1729,14 +1729,14 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ii=xstart(1)+i-1 xm=real(ii,mytype)*dx !momentum flux - radial = [xm,ym,zm]-position + radial = [xm,ym,zm]-position(iv,:) - call crossProduct(angularVelocity(2:4),[xm,ym,zm]-position,rotationalComponent) + 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(1) + rotationalComponent(1) - uymid = half*(uy1(i,j,k)+uy1(i+1,j,k)) - linearVelocity(2) + rotationalComponent(2) - uzmid = half*(uz1(i,j,k)+uz1(i+1,j,k)) - linearVelocity(3) + rotationalComponent(3) + 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) @@ -1808,9 +1808,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 = -(sum(tdiffx) + sum(tdiffx2) + tp1 - mom1)*(1.0-2.0*torq_flip) - dra2 = -(sum(tdiffy) + sum(tdiffy2) + tp2 - mom2)*(1.0-2.0*torq_flip) - dra3 = -(sum(tdiffz) + sum(tdiffz2) + tp3 - mom3)*(1.0-2.0*torq_flip) + 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) diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 23475ff5b..dcc3e91db 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -91,16 +91,66 @@ subroutine param_assign() use ibm_param use ellipsoid_utils, only: NormalizeQuaternion,ellipInertiaCalculate,ellipMassCalculate use param - real(mytype) :: eqr - - eqr=(shx*shy*shz)**(1.0/3.0) - shape=[shx/eqr,shy/eqr,shz/eqr] - - orientation=[oriw,orii,orij,orik] - call NormalizeQuaternion(orientation) - position=[cex,cey,cez] - linearVelocity=[lvx,lvy,lvz] - angularVelocity=[zero,avx,avy,avz] + real(mytype) :: eqr, ori_dummy(4) + 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 + write(*,*) "Body ", i, ", eqr = ", eqr + do j = 1,3 + shape(i,j) = sh(ii+j)/eqr + enddo + enddo + do i = 1,nbody + write(*,*) i, "'s shape = ", shape(i,:) + 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) + write(*,*) "Body, ", i, "orientation = ", ori_dummy + + 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 + write(*,*) "Nbody", i, "position = ", position(i, :) + 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 + write(*,*) "Nbody", i, "angvel = ", angularVelocity(i, :) + enddo + write(*,*) "Ra = ", ra call ellipInertiaCalculate(shape,rho_s,inertia) call ellipMassCalculate(shape,rho_s,ellip_m) diff --git a/src/module_param.f90 b/src/module_param.f90 index 90386e2a1..49be26798 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -617,11 +617,12 @@ end module simulation_stats !############################################################################ module ibm_param use decomp_2d, only : mytype - real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra,ubcx,ubcy,ubcz,rads,rho_s,ellip_m,c_air,cvl_scalar,grav_y,grav_x,grav_z - real(mytype) :: position(3),orientation(4),linearVelocity(3),angularVelocity(4),linearAcceleration(3),linearForce(3),torque(3),shape(3),inertia(3,3) - real(mytype) :: position_1(3),linearVelocity_1(3),orientation_1(4),angularVelocity_1(4) + real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ubcx,ubcy,ubcz,rads,ellip_m,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),inertia(3,3) + real(mytype) :: position_1(10,3),linearVelocity_1(10,3),orientation_1(10,4),angularVelocity_1(10,4),ra(10),rho_s(10) 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, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free, shear_flow_ybc, shear_flow_zbc,torq_debug, torq_flip, ztorq_only + 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 end module ibm_param !############################################################################ diff --git a/src/parameters.f90 b/src/parameters.f90 index bdee32469..6dab42419 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -60,10 +60,10 @@ subroutine parameter(input_i3d) NAMELIST /LESModel/ jles, smagcst, smagwalldamp, nSmag, walecst, maxdsmagcst, iwall NAMELIST /WallModel/ smagwalldamp NAMELIST /Tripping/ itrip,A_tr,xs_tr_tbl,ys_tr_tbl,ts_tr_tbl,x0_tr_tbl - NAMELIST /ibmstuff/ cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ra, & + NAMELIST /ibmstuff/ ce,sh,ori,lv,av,ra, & 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 + torques_flag, orientations_free, shear_flow_ybc, shear_flow_zbc, shear_velocity, torq_debug, torq_flip, ztorq_only, nbody 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, & @@ -574,7 +574,7 @@ subroutine parameter_defaults() use probes, only : nprobes, flag_all_digits, flag_extra_probes use visu, only : output2D use forces, only : iforces, nvol - use ibm_param, only : oriw,rho_s,cvl_scalar,grav_y,grav_x,grav_z,nozdrift,force_csv + use ibm_param, only : oriw,rho_s,cvl_scalar,grav_y,grav_x,grav_z,nozdrift,force_csv,nbody,ra implicit none @@ -622,6 +622,8 @@ subroutine parameter_defaults() grav_z=zero nozdrift=0 force_csv=0 + nbody=1 + ra(:) = 1.0 !! Gravity field gravx = zero diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index ffec99fb0..4127f9bd6 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -17,9 +17,9 @@ program xcompact3d use ibm, only : body use genepsi, only : genepsi3d 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 + use forces, only : force, init_forces, iforces,update_forces, xld,xrd,yld,yud,zld,zrd,torque_calc,nvol implicit none - real(mytype) :: dummy,drag,lift,lat,grav_effy,grav_effx,grav_effz,xtorq,ytorq,ztorq,maxrad + 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 real, dimension(100) :: x @@ -76,20 +76,24 @@ program xcompact3d if (imove.eq.1) then ! update epsi for moving objects if ((iibm.eq.2).or.(iibm.eq.3)) then call genepsi3d(ep1) - maxrad = max(shape(1),shape(2),shape(3)) - if (iforces.eq.1) then - xld(1) = position(1) - maxrad * ra * cvl_scalar - xrd(1) = position(1) + maxrad * ra * cvl_scalar - yld(1) = position(2) - maxrad * ra * cvl_scalar - yud(1) = position(2) + maxrad * ra * cvl_scalar - zld(1) = position(3) - maxrad * ra * cvl_scalar - zrd(1) = position(3) + maxrad * ra * cvl_scalar - if (itime.eq.ifirst) then - call init_forces() - else - call update_forces() + 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) + 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 @@ -127,19 +131,21 @@ program xcompact3d grav_effx = grav_x*(rho_s-1.0) grav_effy = grav_y*(rho_s-1.0) grav_effz = grav_z*(rho_s-1.0) - linearForce=[drag-grav_effx,lift-grav_effy,lat-grav_effz] + do i = 1,nbody + linearForce(i,:) = [drag(i)-grav_effx(i), lift(i)-grav_effy(i), lat(i)-grav_effz(i)] + enddo if (nozdrift==1) then - linearForce(3)=zero + linearForce(:,3)=zero endif if (bodies_fixed==1) then - linearForce(:)=zero + linearForce(:,:)=zero endif if ((nrank==0).and.(force_csv.eq.1)) then ! open(unit=20, file='force_out.dat', action='write') - write(20, *) linearForce(1), linearForce(2), linearForce(3) - write(*,*) 'Writing forces', linearForce(1), linearForce(2), linearForce(3) + write(20, *) linearForce(1,1), linearForce(1,2), linearForce(1,3) + write(*,*) 'Writing forces', linearForce(1,1), linearForce(1,2), linearForce(1,3) flush(20) endif @@ -148,12 +154,15 @@ program xcompact3d call torque_calc(ux1,uy1,uz1,ep1,xtorq,ytorq,ztorq,1) endif if (orientations_free.eq.1) then - torque = [xtorq,ytorq,ztorq] + do i = 1,nvol + torque(i,:) = [xtorq(i), ytorq(i), ztorq(i)] + enddo if (ztorq_only.eq.1) then - torque = [0.0_mytype, 0.0_mytype, ztorq] + torque(:,1) = zero + torque(:,2) = zero endif else - torque(:) = zero + torque(:,:) = zero endif ! if (nrank==0) then @@ -169,10 +178,10 @@ program xcompact3d - if (nrank==0) then - write(12 ,*) t, position(1), position(2), position(3), orientation(1), orientation(2), orientation(3), orientation(4), linearVelocity(1), linearVelocity(2), linearVelocity(3), angularVelocity(2), angularVelocity(3), angularVelocity(4), drag, lift, lat, xtorq, ytorq, ztorq - flush(12) - endif + ! if (nrank==0) then + ! write(12 ,*) t, position(1), position(2), position(3), orientation(1), orientation(2), orientation(3), orientation(4), linearVelocity(1), linearVelocity(2), linearVelocity(3), angularVelocity(2), angularVelocity(3), angularVelocity(4), drag, lift, lat, xtorq, ytorq, ztorq + ! flush(12) + ! endif ! endif if ((nrank==0).and.(mod(itime,ilist)==0)) then From 9c35d4964d244a5672df9d4c1adf2654f294237c Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 10 Oct 2024 15:58:22 +0100 Subject: [PATCH 092/125] almost complete multi_body functionality - something strange going on with the orientations being halfed --- src/BC-Cylinder.f90 | 2 +- src/BC-Ellipsoid.f90 | 6 +- src/case.f90 | 2 +- src/ellip_utils.f90 | 103 ++++++++++++++++++++--- src/genepsi3d.f90 | 22 +++-- src/ibm.f90 | 195 +++++++------------------------------------ src/module_param.f90 | 6 +- src/navier.f90 | 2 +- src/tools.f90 | 4 +- src/xcompact3d.f90 | 31 ++++--- 10 files changed, 171 insertions(+), 202 deletions(-) diff --git a/src/BC-Cylinder.f90 b/src/BC-Cylinder.f90 index a492e3b9d..dfc675139 100644 --- a/src/BC-Cylinder.f90 +++ b/src/BC-Cylinder.f90 @@ -76,7 +76,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_prec((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 diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 94fc95625..a919ae23a 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -22,7 +22,7 @@ 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 dbg_schemes, only: sqrt_prec - use ellipsoid_utils, only: NormalizeQuaternion, EllipsoidalRadius + use ellipsoid_utils, only: NormalizeQuaternion, EllipsoidalRadius, EllipsoidalRadius_debug implicit none @@ -85,7 +85,9 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) 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 diff --git a/src/case.f90 b/src/case.f90 index a334b2b4c..e613c2588 100644 --- a/src/case.f90 +++ b/src/case.f90 @@ -369,7 +369,7 @@ subroutine postprocess_case(rho,ux,uy,uz,pp,phi,ep) if (iforces.eq.1) then ! write(*,*) "Calling force from case" - call force(ux,uy,uz,ep,dummy1,dummy2,dummy3,0) + ! call force(ux,uy,uz,ep,dummy1,dummy2,dummy3,0) call restart_forces(1) endif diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index ee2cf0b54..deaa590cd 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -232,6 +232,50 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) 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_prec(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) @@ -269,7 +313,14 @@ subroutine CalculatePointVelocity_Multi(point, pointVelocity) call EllipsoidalRadius(point, position(i,:), orientation(i,:), shape(i,:), r) radii(i) = r enddo - i_closest = minloc(radii) + 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 @@ -286,10 +337,9 @@ subroutine is_inside_ellipsoid(point, centre, orientation, shape, ra, zeromach, end subroutine is_inside_ellipsoid - subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1, ep1_x, ep1_y, ep1_z) + subroutine navierFieldGen(ep1, ep1_x, ep1_y, ep1_z) use param use decomp_2d - real(mytype), intent(in) :: center(3), linearVelocity(3), angularVelocity(4) 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) @@ -303,7 +353,7 @@ subroutine navierFieldGen(center, linearVelocity, angularVelocity, ep1, ep1_x, e xm=real(i+xstart(1)-2, mytype)*dx point=[xm,ym,zm] if (ep1(i,j,k).eq.1) then - call CalculatePointVelocity(point, center, angularVelocity, linearVelocity, pointVelocity) + call CalculatePointVelocity_Multi(point, pointVelocity) x_pv=pointVelocity(1) y_pv=pointVelocity(2) z_pv=pointVelocity(3) @@ -572,10 +622,10 @@ subroutine ang_full_step(q,omega_q,q_half,omega_n_half,torque_vec,q_full,omega_f end subroutine ang_full_step - subroutine ang_step(q,omega_q,torque_vec,time_step,q1,omega1) + 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),time_step + ! 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) @@ -607,9 +657,9 @@ subroutine ang_step(q,omega_q,torque_vec,time_step,q1,omega1) end subroutine ang_step - subroutine lin_step(position,linearVelocity,linearForce,time_step,position_1,linearVelocity_1) - use ibm_param, only: ellip_m - real(mytype),intent(in) :: position(3),linearVelocity(3),linearForce(3),time_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) @@ -654,5 +704,38 @@ subroutine ellipInertiaCalculate(shape,rho_s,inertia) 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=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/genepsi3d.f90 b/src/genepsi3d.f90 index dcc3e91db..0a1f10620 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -91,7 +91,7 @@ subroutine param_assign() use ibm_param use ellipsoid_utils, only: NormalizeQuaternion,ellipInertiaCalculate,ellipMassCalculate use param - real(mytype) :: eqr, ori_dummy(4) + real(mytype) :: eqr, ori_dummy(4), ellip_m_dummy, inertia_dummy(3,3) integer :: i,ii,j do i =1,nbody @@ -105,8 +105,6 @@ subroutine param_assign() do j = 1,3 shape(i,j) = sh(ii+j)/eqr enddo - enddo - do i = 1,nbody write(*,*) i, "'s shape = ", shape(i,:) enddo @@ -150,9 +148,21 @@ subroutine param_assign() enddo write(*,*) "Nbody", i, "angvel = ", angularVelocity(i, :) enddo - write(*,*) "Ra = ", ra - call ellipInertiaCalculate(shape,rho_s,inertia) - call ellipMassCalculate(shape,rho_s,ellip_m) + ! write(*,*) "Ra = ", ra + + do i = 1,nbody + write(*,*) "Nbody = ", i, "Radius = ", ra(i) + enddo + do i = 1,nbody + call ellipInertiaCalculate(shape(i,:),rho_s(i),inertia_dummy) + inertia(i,:,:) = inertia_dummy + write(*,*) "Nbody", i, "InertiaM = ", inertia(i,:,:) + enddo + do i = 1,nbody + call ellipMassCalculate(shape(i,:), rho_s(i), ellip_m_dummy) + ellip_m(i) = ellip_m_dummy + write(*,*) "Nbody", i, "ellip_m = ", ellip_m(i) + enddo end subroutine param_assign !############################################################################ diff --git a/src/ibm.f90 b/src/ibm.f90 index 8a389b574..14c56931d 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -402,7 +402,7 @@ subroutine cubsplx(u,lind) USE decomp_2d USE variables USE ibm_param - USE ellipsoid_utils, ONLY: CalculatePointVelocity, EllipsoidalRadius + USE ellipsoid_utils, ONLY: CalculatePointVelocity_Multi, ibm_bcimp_calc ! implicit none ! @@ -420,7 +420,7 @@ subroutine cubsplx(u,lind) integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf ! Position of Boundary (Analytically) real(mytype) :: point(3),pointVelocity(3) - real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv, dummy + real(mytype) :: xm,ym,zm ! ! Initialise Arrays xa(:)=0. @@ -430,7 +430,6 @@ subroutine cubsplx(u,lind) ! bcimp=lind ! write(*,*) lind ! - dummy=0.0 do k=1,xsize(3) zm=real(xstart(3)+k-1,mytype)*dz do j=1,xsize(2) @@ -452,7 +451,7 @@ subroutine cubsplx(u,lind) xa(ia)=ana_resi endif point=[xm,ym,zm] - call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, pointVelocity) + 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)))) @@ -461,31 +460,8 @@ subroutine cubsplx(u,lind) ! endif ! write(*,*) "Radius = ", dummy ! write(*,*) "radius = ", dummy, "At point", point - 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=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 + call ibm_bcimp_calc(pointVelocity, lind, bcimp) + ya(ia)=bcimp if(xi(i,j,k).gt.0.)then ! Immersed Object inxi=0 @@ -532,7 +508,7 @@ subroutine cubsplx(u,lind) endif xm = xf(i,j,k) point=[xm,ym,zm] - call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, pointVelocity) + call CalculatePointVelocity_Multi(point, pointVelocity) ! write(*,*) "Called CPV at ", point, "returned", pointVelocity ! call EllipsoidalRadius(point, position, orientation, shape, dummy) ! dummy = maxval(abs(point-position)) @@ -541,31 +517,8 @@ subroutine cubsplx(u,lind) ! if ((dummy.gt.(1.01)).or.(dummy.lt.0.99)) then ! write(*,*) "At ", point, "r = ", dummy ! endif - 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=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 + call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + ya(ia)=bcimp if(xf(i,j,k).lt.xlx)then ! Immersed Object inxf=0 @@ -641,7 +594,7 @@ subroutine cubsply(u,lind) USE decomp_2d USE variables USE ibm_param - USE ellipsoid_utils, ONLY: CalculatePointVelocity + USE ellipsoid_utils, ONLY: CalculatePointVelocity_Multi, ibm_bcimp_calc ! implicit none ! @@ -659,7 +612,7 @@ subroutine cubsply(u,lind) integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf real(mytype) :: point(3),pointVelocity(3) - real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv + real(mytype) :: xm,ym,zm ! ! Initialise Arrays xa(:)=0. @@ -690,31 +643,10 @@ subroutine cubsply(u,lind) endif ym = yi(j,i,k) point=[xm,ym,zm] - call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, pointVelocity) - 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=x_pv - 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 + call CalculatePointVelocity_Multi(point, pointVelocity) + + call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + ya(ia)=bcimp if(yi(j,i,k).gt.0.)then ! Immersed Object jy=1 @@ -766,31 +698,10 @@ subroutine cubsply(u,lind) endif ym = yf(j,i,k) point=[xm,ym,zm] - call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, pointVelocity) - 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=x_pv - 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 + call CalculatePointVelocity_Multi(point, pointVelocity) + + call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + ya(ia)=bcimp if(yf(j,i,k).lt.yly)then ! Immersed Object jy=1 @@ -866,7 +777,7 @@ subroutine cubsplz(u,lind) USE decomp_2d USE variables USE ibm_param - USE ellipsoid_utils, ONLY: CalculatePointVelocity + USE ellipsoid_utils, ONLY: CalculatePointVelocity_Multi, ibm_bcimp_calc ! implicit none ! @@ -884,7 +795,7 @@ subroutine cubsplz(u,lind) integer :: inxi,inxf real(mytype) :: ana_resi,ana_resf real(mytype) :: point(3),pointVelocity(3) - real(mytype) :: xm,ym,zm,x_pv,y_pv,z_pv + real(mytype) :: xm,ym,zm ! ! Initialise Arrays @@ -916,31 +827,10 @@ subroutine cubsplz(u,lind) endif zm = zi(k,i,j) point=[xm,ym,zm] - call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, pointVelocity) - 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=x_pv - 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 + call CalculatePointVelocity_Multi(point, pointVelocity) + + call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + ya(ia)=bcimp if(zi(k,i,j).gt.0.)then ! Immersed Object inxi=0 @@ -985,31 +875,10 @@ subroutine cubsplz(u,lind) endif zm = zi(k,i,j) point=[xm,ym,zm] - call CalculatePointVelocity(point, position, angularVelocity, linearVelocity, pointVelocity) - 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=x_pv - 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 + call CalculatePointVelocity_Multi(point, pointVelocity) + + call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + ya(ia)=bcimp if(zf(k,i,j).lt.zlz)then ! Immersed Object inxf=0 @@ -1197,9 +1066,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 @@ -1228,9 +1097,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/module_param.f90 b/src/module_param.f90 index 49be26798..33778c705 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -617,9 +617,9 @@ end module simulation_stats !############################################################################ module ibm_param use decomp_2d, only : mytype - real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,ubcx,ubcy,ubcz,rads,ellip_m,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),inertia(3,3) - real(mytype) :: position_1(10,3),linearVelocity_1(10,3),orientation_1(10,4),angularVelocity_1(10,4),ra(10),rho_s(10) + real(mytype) :: cex,cey,cez,shx,shy,shz,oriw,orii,orij,orik,lvx,lvy,lvz,avx,avy,avz,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 diff --git a/src/navier.f90 b/src/navier.f90 index 534f77543..5196846e6 100644 --- a/src/navier.f90 +++ b/src/navier.f90 @@ -289,7 +289,7 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) tb1(:,:,:) = uy1(:,:,:) tc1(:,:,:) = uz1(:,:,:) else if (itype.eq.itype_ellip) then - call navierFieldGen(position, linearVelocity, angularVelocity,ep1, ep1_ux, ep1_uy, ep1_uz) + 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(:,:,:) diff --git a/src/tools.f90 b/src/tools.f90 index 2723f7ac5..fe4712e50 100644 --- a/src/tools.f90 +++ b/src/tools.f90 @@ -166,8 +166,8 @@ subroutine simu_stats(iwhen) call cpu_time(time1) write(*,*) '===========================================================' write(*,"(' Time step =',i7,'/',i7,', Time unit =',F9.4)") itime,ilast,t - write(*,*) 'Centroid position = ',real(position(1),4),real(position(2),4),real(position(3),4) - write(*,*) 'Orientation = ',real(orientation(1),4),real(orientation(2),4),real(orientation(3),4),real(orientation(4),4) + ! write(*,*) 'Centroid position = ',real(position(1),4),real(position(2),4),real(position(3),4) + ! write(*,*) 'Orientation = ',real(orientation(1),4),real(orientation(2),4),real(orientation(3),4),real(orientation(4),4) endif else if ((iwhen == 3).and.(itime > ifirst)) then !AT THE END OF A TIME STEP if (nrank == 0.and.(mod(itime, ilist) == 0 .or. itime == ifirst .or. itime==ilast)) then diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 4127f9bd6..785bd7a24 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -167,15 +167,17 @@ program xcompact3d ! if (nrank==0) then ! if (bodies_fixed==0) then - call lin_step(position,linearVelocity,linearForce,dt,position_1,linearVelocity_1) - call ang_step(orientation,angularVelocity,torque,dt,orientation_1,angularVelocity_1) + do i = 1,nvol - position = position_1 - linearVelocity = linearVelocity_1 - - orientation = orientation_1 - angularVelocity = angularVelocity_1 + 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) then @@ -185,12 +187,15 @@ program xcompact3d ! endif if ((nrank==0).and.(mod(itime,ilist)==0)) then - write(*,*) "Position = ", position_1 - write(*,*) "Orientation = ", orientation_1 - write(*,*) "Linear velocity = ", linearVelocity - write(*,*) "Angular velocity = ", angularVelocity - write(*,*) "Linear Force = ", [drag,lift,lat] - write(*,*) "Torque = ", [xtorq,ytorq,ztorq] + 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 From 20edc2491268ec247fb72c3b58398fd591be2873 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Fri, 11 Oct 2024 10:49:34 +0100 Subject: [PATCH 093/125] fixed orientation issue --- src/BC-Ellipsoid.f90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index a919ae23a..711ebac7c 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -45,7 +45,9 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) zeromach = ten*zeromach is_inside=.false. ! orientation=[oriw, orii, orij, orik] - call NormalizeQuaternion(orientation) + do i = 1,nbody + call NormalizeQuaternion(orientation(i,:)) + enddo ! shape=[shx, shy, shz] ! write(*,*) shape, 'SHAPE' From 3d4480564e11c093deac217041eddc7da3fccc9c Mon Sep 17 00:00:00 2001 From: adfboyd Date: Sun, 13 Oct 2024 22:11:36 +0100 Subject: [PATCH 094/125] added inviscid option if Re<0.0001 --- src/parameters.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/parameters.f90 b/src/parameters.f90 index 6dab42419..8c9bcc49b 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -255,7 +255,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) From 5cd52b86ea016faea47727ce91c70fbcea8d6dd7 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 16 Oct 2024 13:32:36 +0100 Subject: [PATCH 095/125] cleaned up startup outputs --- src/genepsi3d.f90 | 138 ++++++++++++++++++++++++++-------------------- 1 file changed, 78 insertions(+), 60 deletions(-) diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 0a1f10620..cd29c7f8d 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -91,78 +91,96 @@ 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 - write(*,*) "Body ", i, ", eqr = ", eqr - do j = 1,3 - shape(i,j) = sh(ii+j)/eqr + 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 - write(*,*) i, "'s shape = ", shape(i,:) - enddo - do i = 1,nbody - ii = (i-1)*4 - do j = 1,4 - ori_dummy(j) = ori(ii+j) + 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 - - ! write(*,*) "Body, ", i, "orientation = ", ori_dummy - call NormalizeQuaternion(ori_dummy) - write(*,*) "Body, ", i, "orientation = ", ori_dummy - - 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) + ! 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 - write(*,*) "Nbody", i, "position = ", position(i, :) - 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) + + 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 - enddo + ! write(*,*) "Ra = ", ra - do i = 1,nbody - ii = (i-1)*3 - angularVelocity(i,1)=zero - do j = 1,3 - angularVelocity(i,j+1)=av(ii+j) + 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 - write(*,*) "Nbody", i, "angvel = ", angularVelocity(i, :) - enddo - ! write(*,*) "Ra = ", ra - - do i = 1,nbody - write(*,*) "Nbody = ", i, "Radius = ", ra(i) - enddo - do i = 1,nbody - call ellipInertiaCalculate(shape(i,:),rho_s(i),inertia_dummy) - inertia(i,:,:) = inertia_dummy - write(*,*) "Nbody", i, "InertiaM = ", inertia(i,:,:) - enddo - do i = 1,nbody - call ellipMassCalculate(shape(i,:), rho_s(i), ellip_m_dummy) - ellip_m(i) = ellip_m_dummy - write(*,*) "Nbody", i, "ellip_m = ", ellip_m(i) - enddo end subroutine param_assign !############################################################################ From 04ede5ddf1d989e27665c140f94fa0132c5d4381 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 16 Oct 2024 14:34:06 +0100 Subject: [PATCH 096/125] added output of forces (although zero) at first timestep. Won't output at second for some reason --- src/forces.f90 | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/src/forces.f90 b/src/forces.f90 index 044673aa9..f59c6329b 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -457,6 +457,8 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 @@ -471,6 +473,12 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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) @@ -1163,6 +1171,8 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 @@ -1188,6 +1198,13 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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) From 7a86f25ac48e49f7b8a8e8731878944b780f797d Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 17 Oct 2024 15:33:15 +0100 Subject: [PATCH 097/125] zeroed force/torque outputs before calculations --- src/forces.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/forces.f90 b/src/forces.f90 index f59c6329b..0ee212ec4 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -436,6 +436,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Inside FORCE' + dra1(:) = zero + dra2(:) = zero + dra3(:) = zero nvect1=xsize(1)*xsize(2)*xsize(3) nvect2=ysize(1)*ysize(2)*ysize(3) @@ -1152,6 +1155,9 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) ! write(*,*) 'Inside FORCE' + dra1(:) = zero + dra2(:) = zero + dra3(:) = zero nvect1=xsize(1)*xsize(2)*xsize(3) From 97fd522e615c113efe8b683c1d45e9dd3ffdd85b Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 17 Oct 2024 15:37:56 +0100 Subject: [PATCH 098/125] removed itime2 torque writing --- src/forces.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 0ee212ec4..e3b41fdee 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1204,13 +1204,13 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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 + ! 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) From 845f90c8d2dd3fc22a99a2c67c81f036e89c361d Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 21 Oct 2024 11:41:31 +0100 Subject: [PATCH 099/125] z components of restart files --- src/forces.f90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/forces.f90 b/src/forces.f90 index e3b41fdee..f97e6d0c3 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -343,12 +343,18 @@ 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) From c6092b72ccad4c93a6be299f38e00f5c06073d71 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 22 Oct 2024 14:45:30 +0100 Subject: [PATCH 100/125] added debugging outputs to BC-ellipsoid --- src/BC-Ellipsoid.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 711ebac7c..a4f616d60 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -85,6 +85,10 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) ! call EllipsoidalRadius(point, position, orientation, shape, r) do i_body = 1,nbody if (cube_flag.eq.0) then + if ((nrank.eq.0).and.(torq_debug.eq.1)) then + write(*,*) "Point, position, orientation, shape for body", i_body, " = " + write(*,*) point,position(i_body,:),orientation(i_body,:),shape(i_body,:) + endif 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 From 6de9114dc18766e16d5e33aa357160e10715d9ed Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 22 Oct 2024 14:51:38 +0100 Subject: [PATCH 101/125] modified debug --- src/BC-Ellipsoid.f90 | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index a4f616d60..53dce403b 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -85,11 +85,18 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) ! call EllipsoidalRadius(point, position, orientation, shape, r) do i_body = 1,nbody if (cube_flag.eq.0) then - if ((nrank.eq.0).and.(torq_debug.eq.1)) then + ! if ((nrank.eq.0).and.(torq_debug.eq.1)) then + ! write(*,*) "Point, position, orientation, shape for body", i_body, " = " + ! write(*,*) point,position(i_body,:),orientation(i_body,:),shape(i_body,:) + ! endif + call EllipsoidalRadius(point,position(i_body,:),orientation(i_body,:),shape(i_body,:),r) + if (r /= r) then write(*,*) "Point, position, orientation, shape for body", i_body, " = " write(*,*) point,position(i_body,:),orientation(i_body,:),shape(i_body,:) + write(*,*) "R calculated = ", r + write(*,*) "Timestep = ", itime endif - 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) From a5ce915ebb381a80a4e5364a7073cb833daf7170 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 22 Oct 2024 15:05:45 +0100 Subject: [PATCH 102/125] more debugging outputs --- src/BC-Ellipsoid.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 53dce403b..076c3e769 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -55,6 +55,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) ! Intitialise epsi epsi(:,:,:)=zero + ! Update center of moving ellipsoid ! if (t.ne.0.) then @@ -79,6 +80,10 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) do j=nyi,nyf ! ym=(real(j-1,mytype))*dy ym=yp(j) + if (ym /= ym) then + write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", jj + endif + do i=nxi,nxf xm=real(i-1,mytype)*dx point=[xm, ym, zm] From 3e07d50dcb24f1ed810fc801fed8a7eedc89b828 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 22 Oct 2024 15:06:32 +0100 Subject: [PATCH 103/125] fixed debug --- src/BC-Ellipsoid.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 076c3e769..91a7b3b68 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -81,7 +81,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) ! ym=(real(j-1,mytype))*dy ym=yp(j) if (ym /= ym) then - write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", jj + write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", j endif do i=nxi,nxf From 4e44842785b91c202843ba75403618c9228d67fc Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 22 Oct 2024 15:09:09 +0100 Subject: [PATCH 104/125] more outputs --- src/BC-Ellipsoid.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 91a7b3b68..5272de529 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -82,6 +82,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) ym=yp(j) if (ym /= ym) then write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", j + write(*,*) "yp = ", yp endif do i=nxi,nxf From c3c7dd8af66874f5b822d767f6a265379c5430b1 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 22 Oct 2024 15:18:48 +0100 Subject: [PATCH 105/125] narrowed down issue to ypraf --- src/BC-Ellipsoid.f90 | 3 ++- src/genepsi3d.f90 | 1 + 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 5272de529..d95e22b07 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -23,6 +23,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) use ibm_param use dbg_schemes, only: sqrt_prec use ellipsoid_utils, only: NormalizeQuaternion, EllipsoidalRadius, EllipsoidalRadius_debug + use complex_geometry, only: nraf implicit none @@ -81,7 +82,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) ! ym=(real(j-1,mytype))*dy ym=yp(j) if (ym /= ym) then - write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", j + write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", j, " (or maybe it should be ", ((real(j-1,mytype))*dy)/real(nraf,mytype), ")" write(*,*) "yp = ", yp endif diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index cd29c7f8d..1d925c697 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -317,6 +317,7 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& 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) + write(*,*) "At j = ", j, ", jraf = ", jraf, "ypraf = ", yp(j)+real(jraf-1, mytype)*(yp(j+1)-yp(j))/real(nraf, mytype) enddo enddo if(.not.ncly)ypraf(nyraf)=yp(ny) From f1df1240008be53ef7170456ba5f8685105365f0 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 22 Oct 2024 15:25:12 +0100 Subject: [PATCH 106/125] tidier outputs --- src/genepsi3d.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 1d925c697..51b0092a3 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -317,10 +317,13 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& 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) - write(*,*) "At j = ", j, ", jraf = ", jraf, "ypraf = ", yp(j)+real(jraf-1, mytype)*(yp(j+1)-yp(j))/real(nraf, mytype) + if (ypraf(jraf+nraf*(j-1)) /= ypraf(jraf+nraf*(j-1))) then + write(*,*) "At j = ", j, ", jraf = ", jraf, "ypraf = ", yp(j)+real(jraf-1, mytype)*(yp(j+1)-yp(j))/real(nraf, mytype) + endif enddo enddo if(.not.ncly)ypraf(nyraf)=yp(ny) + if(.not.ncly)write(*,*) "Changed ypraf (", nyraf, "). To ", 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' From 0b09803657d99c3d57c0bbfab2a3e949b73a2d73 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 22 Oct 2024 15:37:04 +0100 Subject: [PATCH 107/125] tidierer inputs --- src/BC-Ellipsoid.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index d95e22b07..c8d72d102 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -23,7 +23,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) use ibm_param use dbg_schemes, only: sqrt_prec use ellipsoid_utils, only: NormalizeQuaternion, EllipsoidalRadius, EllipsoidalRadius_debug - use complex_geometry, only: nraf + use complex_geometry, only: nraf,nyraf implicit none @@ -83,7 +83,9 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) ym=yp(j) if (ym /= ym) then write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", j, " (or maybe it should be ", ((real(j-1,mytype))*dy)/real(nraf,mytype), ")" - write(*,*) "yp = ", yp + if (j.lt.(nyraf)) then + write(*,*) "yp(j-1) = ", yp(j-1), " yp(j+1) = ", yp(j+1) + endif endif do i=nxi,nxf From bf8e6181a0f63313a1ade4591bf07cd7e098b45c Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 23 Oct 2024 13:45:47 +0100 Subject: [PATCH 108/125] added buffer to ypraf --- src/BC-Ellipsoid.f90 | 14 +++++++------- src/genepsi3d.f90 | 2 +- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index c8d72d102..0abe7501c 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -84,7 +84,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) if (ym /= ym) then write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", j, " (or maybe it should be ", ((real(j-1,mytype))*dy)/real(nraf,mytype), ")" if (j.lt.(nyraf)) then - write(*,*) "yp(j-1) = ", yp(j-1), " yp(j+1) = ", yp(j+1) + write(*,*) "yp(j-1) = ", yp(j-1), " yp(j+1,..) = ", yp(j+1:) endif endif @@ -99,12 +99,12 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) ! write(*,*) point,position(i_body,:),orientation(i_body,:),shape(i_body,:) ! endif call EllipsoidalRadius(point,position(i_body,:),orientation(i_body,:),shape(i_body,:),r) - if (r /= r) then - write(*,*) "Point, position, orientation, shape for body", i_body, " = " - write(*,*) point,position(i_body,:),orientation(i_body,:),shape(i_body,:) - write(*,*) "R calculated = ", r - write(*,*) "Timestep = ", itime - endif + ! if (r /= r) then + ! write(*,*) "Point, position, orientation, shape for body", i_body, " = " + ! write(*,*) point,position(i_body,:),orientation(i_body,:),shape(i_body,:) + ! write(*,*) "R calculated = ", r + ! write(*,*) "Timestep = ", itime + ! endif is_inside = (r-ra(i_body)).lt.zeromach ! if (is_inside) then diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 51b0092a3..6bd7f4b83 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -276,7 +276,7 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& real(mytype),dimension(ysize(1),nyraf,ysize(3)) :: yepsi real(mytype),dimension(zsize(1),zsize(2),nzraf) :: zepsi real(mytype),dimension(ny) :: yp - real(mytype),dimension(nyraf) :: ypraf + real(mytype),dimension(nyraf+20) :: ypraf real(mytype) :: dxraf,dyraf,dzraf integer :: i,j,k integer :: ii,jj,kk From 13537d0cae9f1579bec66c2d39021bd228095d1b Mon Sep 17 00:00:00 2001 From: s2006749 Date: Wed, 23 Oct 2024 14:04:27 +0100 Subject: [PATCH 109/125] added buffer to nyraf --- src/variables.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/variables.f90 b/src/variables.f90 index bb3917716..f67446a4e 100644 --- a/src/variables.f90 +++ b/src/variables.f90 @@ -591,7 +591,7 @@ subroutine init_variables !complex_geometry nxraf=(nxm)*nraf if (.not.nclx) nxraf=nxraf+1 - nyraf=(nym)*nraf + nyraf=(nym)*nraf+20 if (.not.ncly) nyraf=nyraf+1 nzraf=(nzm)*nraf if (.not.nclz) nzraf=nzraf+1 From 233309b77fc45157eb6dc13d7ed868ee7c563ac6 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 24 Oct 2024 13:10:20 +0100 Subject: [PATCH 110/125] added extra bit to deal with final part of ypraf in periodic case --- src/BC-Ellipsoid.f90 | 2 +- src/genepsi3d.f90 | 27 ++++++++++++++++++--------- src/variables.f90 | 2 +- 3 files changed, 20 insertions(+), 11 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 0abe7501c..474331e1e 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -84,7 +84,7 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) if (ym /= ym) then write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", j, " (or maybe it should be ", ((real(j-1,mytype))*dy)/real(nraf,mytype), ")" if (j.lt.(nyraf)) then - write(*,*) "yp(j-1) = ", yp(j-1), " yp(j+1,..) = ", yp(j+1:) + write(*,*) "yp(j-1) = ", yp(j-1), " yp(j+1) = ", yp(j+1) endif endif diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 6bd7f4b83..2ecd5d400 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -55,11 +55,11 @@ subroutine geomcomplex(epsi, nxi, nxf, ny, nyi, nyf, nzi, nzf, dx, yp, dz, remp) IMPLICIT NONE - INTEGER :: nxi,nxf,ny,nyi,nyf,nzi,nzf + INTEGER, intent(in) :: nxi,nxf,ny,nyi,nyf,nzi,nzf REAL(mytype),DIMENSION(nxi:nxf,nyi:nyf,nzi:nzf) :: epsi - REAL(mytype) :: dx,dz - REAL(mytype),DIMENSION(ny) :: yp - REAL(mytype) :: remp + REAL(mytype), intent(in) :: dx,dz + REAL(mytype),DIMENSION(ny), intent(in) :: yp + REAL(mytype), intent(in) :: remp IF (itype.EQ.itype_cyl) THEN @@ -276,7 +276,7 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& real(mytype),dimension(ysize(1),nyraf,ysize(3)) :: yepsi real(mytype),dimension(zsize(1),zsize(2),nzraf) :: zepsi real(mytype),dimension(ny) :: yp - real(mytype),dimension(nyraf+20) :: ypraf + real(mytype),dimension(nyraf) :: ypraf real(mytype) :: dxraf,dyraf,dzraf integer :: i,j,k integer :: ii,jj,kk @@ -314,16 +314,25 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& else dyraf =yly/real(nyraf-1, mytype) endif + write(*,*) ny, size(yp), size(ypraf), nraf 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) - if (ypraf(jraf+nraf*(j-1)) /= ypraf(jraf+nraf*(j-1))) then - write(*,*) "At j = ", j, ", jraf = ", jraf, "ypraf = ", yp(j)+real(jraf-1, mytype)*(yp(j+1)-yp(j))/real(nraf, mytype) - endif + ! if (ypraf(jraf+nraf*(j-1)) /= ypraf(jraf+nraf*(j-1))) then + ! write(*,*) "At j = ", j, ", jraf = ", jraf, "ypraf = ", yp(j)+real(jraf-1, mytype)*(yp(j+1)-yp(j))/real(nraf, mytype) + ! endif 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 + ! write(*,*) yp if(.not.ncly)ypraf(nyraf)=yp(ny) - if(.not.ncly)write(*,*) "Changed ypraf (", nyraf, "). To ", yp(ny) + ! if(.not.ncly)write(*,*) "Changed ypraf (", nyraf, "). To ", yp(ny) + ! write(*,*) ypraf + 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/variables.f90 b/src/variables.f90 index f67446a4e..bb3917716 100644 --- a/src/variables.f90 +++ b/src/variables.f90 @@ -591,7 +591,7 @@ subroutine init_variables !complex_geometry nxraf=(nxm)*nraf if (.not.nclx) nxraf=nxraf+1 - nyraf=(nym)*nraf+20 + nyraf=(nym)*nraf if (.not.ncly) nyraf=nyraf+1 nzraf=(nzm)*nraf if (.not.nclz) nzraf=nzraf+1 From 46e6e8f749dbcb6fafe75b43a64e3420b06a747a Mon Sep 17 00:00:00 2001 From: s2006749 Date: Thu, 24 Oct 2024 13:14:02 +0100 Subject: [PATCH 111/125] removed write line --- src/genepsi3d.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 2ecd5d400..72f48df5b 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -314,7 +314,7 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& else dyraf =yly/real(nyraf-1, mytype) endif - write(*,*) ny, size(yp), size(ypraf), nraf + ! write(*,*) ny, size(yp), size(ypraf), nraf 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) From c3e762ac9374a804e70b57955e0182a39509b2e9 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 4 Nov 2024 11:42:34 +0000 Subject: [PATCH 112/125] fixed csv outputs --- src/forces.f90 | 4 ++-- src/xcompact3d.f90 | 18 ++++++++++++------ 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index f97e6d0c3..316f367de 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1054,7 +1054,7 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) if ((itime==ifirst).or.(itime==0)) then endif - if ((nrank .eq. 0).and.(record_var.eq.1)) then + 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 @@ -1868,7 +1868,7 @@ subroutine torque_calc(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) if ((itime==ifirst).or.(itime==0)) then endif - if ((nrank .eq. 0).and.(record_var.eq.1)) then + 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 diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 785bd7a24..b96b537e7 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -22,6 +22,8 @@ program xcompact3d 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 real, dimension(100) :: x + character(len=30) :: filename!, filename2 + call init_xcompact3d() @@ -38,7 +40,10 @@ program xcompact3d end if if (nrank==0) then - open(unit=12, file='body.dat1', status='unknown', form='formatted') + 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 @@ -180,11 +185,12 @@ program xcompact3d enddo - ! if (nrank==0) then - ! write(12 ,*) t, position(1), position(2), position(3), orientation(1), orientation(2), orientation(3), orientation(4), linearVelocity(1), linearVelocity(2), linearVelocity(3), angularVelocity(2), angularVelocity(3), angularVelocity(4), drag, lift, lat, xtorq, ytorq, ztorq - ! flush(12) - ! endif - ! endif + if (nrank==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 From 950b128d17fdabf9e5bc717af47ae439e7430772 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 4 Nov 2024 12:02:50 +0000 Subject: [PATCH 113/125] added sample rate to body csvs --- src/xcompact3d.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index b96b537e7..96055fa11 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -185,7 +185,7 @@ program xcompact3d enddo - if (nrank==0) then + 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) From 87e85bdb92ceaf99ebeebf6c1627c466892c6ba5 Mon Sep 17 00:00:00 2001 From: not populated Date: Fri, 15 Nov 2024 09:37:14 +0000 Subject: [PATCH 114/125] Added extra debug flags --- Makefile | 2 +- src/BC-Ellipsoid.f90 | 37 ++++++++++++++++++++----------------- 2 files changed, 21 insertions(+), 18 deletions(-) diff --git a/Makefile b/Makefile index 5bf421801..ffef59533 100644 --- a/Makefile +++ b/Makefile @@ -27,7 +27,7 @@ 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 +FFLAGS = -cpp -g3 -Og -fexceptions -ftrapv FFLAGS += -ffpe-trap=invalid,zero -fcheck=bounds -fimplicit-none else FFLAGS = -cpp -O3 -funroll-loops -floop-optimize -g diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 474331e1e..106f12879 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -363,22 +363,25 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) 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 + + if (init_noise.gt.0.001) then + 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 + endif !modulation of the random noise do k=1,xsize(3) @@ -532,4 +535,4 @@ subroutine visu_ellip(ux1, uy1, uz1, pp3, phi1, ep1, num) end subroutine visu_ellip end module ellip - \ No newline at end of file + From 3a1ce05a50753c7c04f011851cdae531a63bac0d Mon Sep 17 00:00:00 2001 From: not populated Date: Fri, 15 Nov 2024 10:29:16 +0000 Subject: [PATCH 115/125] fixed integer overflow issue in io.f90 --- decomp2d/io.f90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/decomp2d/io.f90 b/decomp2d/io.f90 index 84a0b2216..31c47f696 100644 --- a/decomp2d/io.f90 +++ b/decomp2d/io.f90 @@ -1176,8 +1176,13 @@ subroutine mpiio_write_real_coarse(ipencil,var,dirname,varname,icoarse,io_name,o 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) + sizes(1) * sizes(2) * sizes(3) * disp_bytes + 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) From fc5ea022cc08643f6257c7e0f79659300a5c4d12 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Fri, 17 Jan 2025 12:31:11 +0000 Subject: [PATCH 116/125] tidying comments --- src/genepsi3d.f90 | 9 +-------- src/xcompact3d.f90 | 9 ++++++--- 2 files changed, 7 insertions(+), 11 deletions(-) diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 72f48df5b..504b18096 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -314,13 +314,9 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& else dyraf =yly/real(nyraf-1, mytype) endif - ! write(*,*) ny, size(yp), size(ypraf), nraf 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) - ! if (ypraf(jraf+nraf*(j-1)) /= ypraf(jraf+nraf*(j-1))) then - ! write(*,*) "At j = ", j, ", jraf = ", jraf, "ypraf = ", yp(j)+real(jraf-1, mytype)*(yp(j+1)-yp(j))/real(nraf, mytype) - ! endif enddo enddo if (ncly) then @@ -328,11 +324,8 @@ subroutine gene_epsi_3D(ep1,nx,ny,nz,dx,dy,dz,xlx,yly,zlz ,& ypraf(jraf+nraf*(ny-1))=yp(ny)+real(jraf-1,mytype)*(yly-yp(ny))/real(nraf,mytype) enddo endif - ! write(*,*) yp - if(.not.ncly)ypraf(nyraf)=yp(ny) - ! if(.not.ncly)write(*,*) "Changed ypraf (", nyraf, "). To ", yp(ny) - ! write(*,*) ypraf + 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/xcompact3d.f90 b/src/xcompact3d.f90 index 96055fa11..62daf00a3 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, & @@ -20,7 +20,7 @@ program xcompact3d 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 + integer :: iounit,ierr,i,code,ierror real, dimension(100) :: x character(len=30) :: filename!, filename2 @@ -91,7 +91,10 @@ program xcompact3d 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 From d44307071867af627db245e0d0f3813582c94b44 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Fri, 17 Jan 2025 15:29:21 +0000 Subject: [PATCH 117/125] started testing after merge to current x3D --- src/CMakeLists.txt | 2 ++ src/ellip_utils.f90 | 14 +++++++------- 2 files changed, 9 insertions(+), 7 deletions(-) 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/ellip_utils.f90 b/src/ellip_utils.f90 index deaa590cd..1e437faf1 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -4,9 +4,9 @@ module ellipsoid_utils - use decomp_2d, only: mytype + ! use decomp_2d, only: mytype use param, only: zero, one, two - use dbg_schemes, only: sqrt_prec, cos_prec, exp_prec, sin_prec + ! use dbg_schemes, only: sqrt_prec, cos_prec, exp_prec, sin_prec use ibm_param implicit none @@ -153,7 +153,7 @@ subroutine QuaternionNorm(q,norm) real(mytype),intent(in) :: q(4) real(mytype),intent(out):: norm - norm = sqrt_prec(q(1)**2+q(2)**2+q(3)**2+q(4)**2) + norm = sqrt(q(1)**2+q(2)**2+q(3)**2+q(4)**2) end subroutine QuaternionNorm @@ -217,7 +217,7 @@ subroutine EllipsoidalRadius(point, centre, orientation, shape, radius) scaled_point(i)=rotated_point(i)/shape(i) end do - radius=sqrt_prec(scaled_point(1)**2+scaled_point(2)**2+scaled_point(3)**2) + 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!" @@ -259,7 +259,7 @@ subroutine EllipsoidalRadius_debug(point, centre, orientation, shape, radius) write(*,*) "Scaled point = ", scaled_point - radius=sqrt_prec(scaled_point(1)**2+scaled_point(2)**2+scaled_point(3)**2) + radius=sqrt(scaled_point(1)**2+scaled_point(2)**2+scaled_point(3)**2) write(*,*) "Radius = ", radius @@ -411,9 +411,9 @@ subroutine orientation_stepper(q1, omega_q, time_step, q_n1) real(mytype) :: mag, re_part, im_sc, im_part(3), omega_n1(4) call QuaternionNorm(omega_q, mag) - re_part=cos_prec(mag*time_step*half) + re_part=cos(mag*time_step*half) if (mag.gt.zero) then - im_sc = sin_prec(mag*time_step*half)/mag + im_sc = sin(mag*time_step*half)/mag else im_sc = zero endif From 258ba35316f691dd72acf8c9eb4941033c1959fb Mon Sep 17 00:00:00 2001 From: s2006749 Date: Sun, 2 Mar 2025 21:52:17 +0000 Subject: [PATCH 118/125] brought all changes up to more recent branch of X3D. Can't get tests to compile and have ignored i2dsim option --- src/BC-Ellipsoid.f90 | 75 ++++++---------- src/Case-ABL.f90 | 8 +- src/Case-Cylinder-wake.f90 | 20 ++--- src/Case-PTBL.f90 | 108 ++++++++++++------------ src/Case-Periodic-hill.f90 | 18 ++-- src/Case-TGV.f90 | 18 ++-- src/case.f90 | 2 +- src/ellip_utils.f90 | 35 ++++++-- src/forces.f90 | 41 +++++++++ src/genepsi3d.f90 | 2 - src/ibm.f90 | 40 ++++++--- src/les_models.f90 | 24 +++--- src/mhd.f90 | 78 ++++++++--------- src/module_param.f90 | 14 +-- src/navier.f90 | 18 ++-- src/tools.f90 | 18 ++-- tests/TGV-Taylor-Green-vortex/input.i3d | 0 17 files changed, 283 insertions(+), 236 deletions(-) create mode 100644 tests/TGV-Taylor-Green-vortex/input.i3d diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 106f12879..616d045b5 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -1,5 +1,7 @@ module ellip +USE decomp_2d_constants +USE decomp_2d_mpi USE decomp_2d USE variables USE param @@ -18,10 +20,8 @@ module ellip subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) - use decomp_2d, only : mytype use param, only : one, two, ten use ibm_param - use dbg_schemes, only: sqrt_prec use ellipsoid_utils, only: NormalizeQuaternion, EllipsoidalRadius, EllipsoidalRadius_debug use complex_geometry, only: nraf,nyraf @@ -80,32 +80,14 @@ subroutine geomcomplex_ellip(epsi,nxi,nxf,ny,nyi,nyf,nzi,nzf,dx,yp,dz,remp) ! write(*,*) k, zm do j=nyi,nyf ! ym=(real(j-1,mytype))*dy - ym=yp(j) - if (ym /= ym) then - write(*,*) "ym = ", ym, " should be ", ((real(j-1,mytype))*dy), ", as j = ", j, " (or maybe it should be ", ((real(j-1,mytype))*dy)/real(nraf,mytype), ")" - if (j.lt.(nyraf)) then - write(*,*) "yp(j-1) = ", yp(j-1), " yp(j+1) = ", yp(j+1) - endif - endif - - do i=nxi,nxf - xm=real(i-1,mytype)*dx - point=[xm, ym, zm] + 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 + do i_body = 1,nbody if (cube_flag.eq.0) then - ! if ((nrank.eq.0).and.(torq_debug.eq.1)) then - ! write(*,*) "Point, position, orientation, shape for body", i_body, " = " - ! write(*,*) point,position(i_body,:),orientation(i_body,:),shape(i_body,:) - ! endif call EllipsoidalRadius(point,position(i_body,:),orientation(i_body,:),shape(i_body,:),r) - ! if (r /= r) then - ! write(*,*) "Point, position, orientation, shape for body", i_body, " = " - ! write(*,*) point,position(i_body,:),orientation(i_body,:),shape(i_body,:) - ! write(*,*) "R calculated = ", r - ! write(*,*) "Timestep = ", itime - ! endif - 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) @@ -303,7 +285,6 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) USE param USE MPI USE ibm_param - use dbg_schemes, only: exp_prec use ellipsoid_utils, only: NormalizeQuaternion,ellipInertiaCalculate,ellipMassCalculate @@ -363,32 +344,29 @@ subroutine init_ellip (ux1,uy1,uz1,phi1) if (iin.ne.0) then call system_clock(count=code) if (iin.eq.2) code=0 - - if (init_noise.gt.0.001) then - 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 - endif + 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_prec(-zptwo*y*y) + 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) @@ -433,7 +411,6 @@ subroutine postprocess_ellip(ux1,uy1,uz1,ep1) 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 - use dbg_schemes, only: sqrt_prec real(mytype),intent(in),dimension(xsize(1),xsize(2),xsize(3)) :: ux1, uy1, uz1, ep1 @@ -441,7 +418,7 @@ end subroutine postprocess_ellip subroutine visu_ellip_init (visu_initialised) - use decomp_2d, only : mytype + use decomp_2d use decomp_2d_io, only : decomp_2d_register_variable use visu, only : io_name, output2D @@ -535,4 +512,4 @@ subroutine visu_ellip(ux1, uy1, uz1, pp3, phi1, ep1, num) end subroutine visu_ellip end module ellip - + \ No newline at end of file diff --git a/src/Case-ABL.f90 b/src/Case-ABL.f90 index d2bbdd117..30c328aad 100644 --- a/src/Case-ABL.f90 +++ b/src/Case-ABL.f90 @@ -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-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-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-TGV.f90 b/src/Case-TGV.f90 index 34863f832..67d0c88d3 100644 --- a/src/Case-TGV.f90 +++ b/src/Case-TGV.f90 @@ -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) diff --git a/src/case.f90 b/src/case.f90 index 3888b8f5d..7d450d92b 100644 --- a/src/case.f90 +++ b/src/case.f90 @@ -402,7 +402,7 @@ subroutine postprocess_case(rho,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 diff --git a/src/ellip_utils.f90 b/src/ellip_utils.f90 index 1e437faf1..75c618d01 100644 --- a/src/ellip_utils.f90 +++ b/src/ellip_utils.f90 @@ -717,23 +717,42 @@ subroutine ibm_bcimp_calc(pointVelocity, lind, bcimp) if (lind.eq.0) then bcimp=zero elseif (lind.eq.1) then - bcimp=x_pv + bcimp=ubcx ! write(*,*) bcimp elseif (lind.eq.2) then - bcimp=y_pv + bcimp=ubcy elseif (lind.eq.3) then - bcimp=z_pv + bcimp=ubcz elseif (lind.eq.4) then - bcimp=x_pv*x_pv + bcimp=ubcx*ubcx elseif (lind.eq.5) then - bcimp=y_pv*y_pv + bcimp=ubcy*ubcy elseif (lind.eq.6) then - bcimp=z_pv*z_pv + bcimp=ubcz*ubcz elseif (lind.eq.7) then - bcimp=x_pv*y_pv + bcimp=ubcx*ubcy elseif (lind.eq.8) then - bcimp=x_pv*z_pv + 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 diff --git a/src/forces.f90 b/src/forces.f90 index f665aa4b2..295e6a7c9 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -305,6 +305,47 @@ end subroutine update_forces ! yld2(:) = yld(:) ! yud2(:) = yud(:) ! endif + + subroutine setup_forces(iounit) + + implicit none + + ! Argument + integer, intent(in) :: iounit + + 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 + + ! 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 + subroutine restart_forces(itest1) USE decomp_2d_io diff --git a/src/genepsi3d.f90 b/src/genepsi3d.f90 index 4eda925ac..26bbd8398 100644 --- a/src/genepsi3d.f90 +++ b/src/genepsi3d.f90 @@ -50,8 +50,6 @@ 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_ellip,itype_pipe - USE decomp_2d, ONLY : mytype - USE cyl, ONLY : geomcomplex_cyl USE hill, ONLY : geomcomplex_hill USE channel, ONLY : geomcomplex_channel diff --git a/src/ibm.f90 b/src/ibm.f90 index bb8fd07ec..b95243733 100644 --- a/src/ibm.f90 +++ b/src/ibm.f90 @@ -52,7 +52,7 @@ end subroutine corgp_IBM !############################################################################ subroutine body(ux1,uy1,uz1,ep1) use param, only : zero, one, dx, dz - use decomp_2d, only : xstart, xend, xsize, mytype, nrank + use decomp_2d, only : xstart, xend, xsize !use decomp_2d_io use variables, only : ny implicit none @@ -419,7 +419,7 @@ 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) @@ -431,8 +431,12 @@ subroutine cubsplx(u,lind) 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) @@ -463,7 +467,7 @@ subroutine cubsplx(u,lind) ! endif ! write(*,*) "Radius = ", dummy ! write(*,*) "radius = ", dummy, "At point", point - call ibm_bcimp_calc(pointVelocity, lind, bcimp) + call ibm_bcimp_calc(pointVelocity, lind_2, bcimp) ya(ia)=bcimp if(xi(i,j,k).gt.0.)then ! Immersed Object @@ -520,7 +524,7 @@ subroutine cubsplx(u,lind) ! if ((dummy.gt.(1.01)).or.(dummy.lt.0.99)) then ! write(*,*) "At ", point, "r = ", dummy ! endif - call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + 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 @@ -612,7 +616,7 @@ 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 @@ -624,7 +628,11 @@ subroutine cubsply(u,lind) 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 @@ -648,7 +656,7 @@ subroutine cubsply(u,lind) point=[xm,ym,zm] call CalculatePointVelocity_Multi(point, pointVelocity) - call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + 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 @@ -703,7 +711,7 @@ subroutine cubsply(u,lind) point=[xm,ym,zm] call CalculatePointVelocity_Multi(point, pointVelocity) - call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + 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 @@ -795,7 +803,7 @@ 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 @@ -808,7 +816,11 @@ subroutine cubsplz(u,lind) 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 @@ -832,7 +844,7 @@ subroutine cubsplz(u,lind) point=[xm,ym,zm] call CalculatePointVelocity_Multi(point, pointVelocity) - call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + 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 @@ -880,7 +892,7 @@ subroutine cubsplz(u,lind) point=[xm,ym,zm] call CalculatePointVelocity_Multi(point, pointVelocity) - call ibm_bcimp_calc(pointVelocity, lind, bcimp) !take correct part of pointVelocity for equation type. + 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 diff --git a/src/les_models.f90 b/src/les_models.f90 index 757822b7e..75c706cac 100644 --- a/src/les_models.f90 +++ b/src/les_models.f90 @@ -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,1) - 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) + 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(:,:,:) @@ -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 a84dfadaa..cb1404e2e 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 @@ -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 diff --git a/src/navier.f90 b/src/navier.f90 index 7949c6b15..8bfd75537 100644 --- a/src/navier.f90 +++ b/src/navier.f90 @@ -896,7 +896,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(:,:,:) @@ -911,7 +911,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 @@ -931,7 +931,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(:,:,:) @@ -949,7 +949,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 @@ -969,7 +969,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(:,:,:) @@ -984,7 +984,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 @@ -1091,16 +1091,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(:,:,:) diff --git a/src/tools.f90 b/src/tools.f90 index cfde2a567..515114b0c 100644 --- a/src/tools.f90 +++ b/src/tools.f90 @@ -622,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 @@ -638,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 @@ -655,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 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 From f03c16b69b40362d50c4b6d591bbb44750cdd75e Mon Sep 17 00:00:00 2001 From: s2006749 Date: Sun, 2 Mar 2025 22:21:32 +0000 Subject: [PATCH 119/125] adding in divergence visualisation tool --- src/navier.f90 | 4 ++++ src/variables.f90 | 4 +++- src/visu.f90 | 22 ++++++++++++++++++++++ 3 files changed, 29 insertions(+), 1 deletion(-) diff --git a/src/navier.f90 b/src/navier.f90 index 8bfd75537..826f9d8d7 100644 --- a/src/navier.f90 +++ b/src/navier.f90 @@ -277,6 +277,8 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) 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 @@ -375,6 +377,8 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) endif endif + div_visu_var(:,:,:,:)=pp3(:,:,:,:) + return end subroutine divergence !############################################################################ 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 7227ab581..cdd826e49 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -195,6 +195,8 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) 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) :: div_visu_var + real(mytype), dimension(xsize(1), xsize(2), xsize(3), numscalar), intent(in) :: phi1 integer, intent(in) :: itime integer, intent(out) :: num @@ -261,6 +263,26 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, phi1, ep1, itime, num) ! Write pressure call write_field(ta1, ".", "pp", num, .true., flush=.true.) + ! 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.) + ! LMN - write density if (ilmn) call write_field(rho1(:,:,:,1), ".", "rho", num) From 2508be68280ef445e5066d5730486ede84fdd2e4 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Mon, 3 Mar 2025 22:16:45 +0000 Subject: [PATCH 120/125] added div_visu output --- .vscode/settings.json | 3 +- src/case.f90 | 18 ++--- src/navier.f90 | 150 ++++++++++++++++++++++++++++++++++++++---- src/visu.f90 | 7 +- src/xcompact3d.f90 | 122 +++++++++++++++++----------------- 5 files changed, 216 insertions(+), 84 deletions(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index 63e4335fc..4171cd2d5 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -1,3 +1,4 @@ { - "fortran.fortls.disabled": true + "fortran.fortls.disabled": true, + "makefile.configureOnOpen": false } \ No newline at end of file diff --git a/src/case.f90 b/src/case.f90 index 7d450d92b..71f156359 100644 --- a/src/case.f90 +++ b/src/case.f90 @@ -261,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 @@ -270,7 +270,7 @@ 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 @@ -279,15 +279,15 @@ subroutine postprocessing(rho1, ux1, uy1, uz1, pp3, phi1, ep1) 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 @@ -304,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 @@ -640,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 @@ -653,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/navier.f90 b/src/navier.f90 index 826f9d8d7..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 @@ -276,8 +276,8 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) !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 + 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 @@ -377,10 +377,138 @@ subroutine divergence (pp3,rho1,ux1,uy1,uz1,ep1,drho1,divu3,nlock) endif endif - div_visu_var(:,:,:,:)=pp3(:,:,:,:) + 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 @@ -1238,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 @@ -1248,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) @@ -1281,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))) diff --git a/src/visu.f90 b/src/visu.f90 index cdd826e49..d1887514d 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -170,7 +170,7 @@ 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 @@ -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,8 +195,8 @@ 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) :: div_visu_var + 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 diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 01fc117ca..5a4d0e139 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -126,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 @@ -145,79 +145,81 @@ program xcompact3d ! if (nrank.eq.0) then ! write(*,*) 'Going to call force from xcompact3d, itr = ', itr ! endif - 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 (nozdrift==1) then - linearForce(:,3)=zero - endif - - if (bodies_fixed==1) then - linearForce(:,:)=zero - endif - - if ((nrank==0).and.(force_csv.eq.1)) then - ! open(unit=20, file='force_out.dat', action='write') - write(20, *) linearForce(1,1), linearForce(1,2), linearForce(1,3) - write(*,*) 'Writing forces', linearForce(1,1), linearForce(1,2), linearForce(1,3) - flush(20) - 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 (nozdrift==1) then + linearForce(:,3)=zero + endif + if (bodies_fixed==1) then + linearForce(:,:)=zero + endif - 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 + if ((nrank==0).and.(force_csv.eq.1)) then + ! open(unit=20, file='force_out.dat', action='write') + write(20, *) linearForce(1,1), linearForce(1,2), linearForce(1,3) + write(*,*) 'Writing forces', linearForce(1,1), linearForce(1,2), linearForce(1,3) + flush(20) 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) + 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 - position(i,:) = position_1 - linearVelocity(i,:) = linearVelocity_1 + ! if (bodies_fixed==0) then + do i = 1,nvol - orientation(i,:) = orientation_1 - angularVelocity(i,:) = angularVelocity_1 - enddo + 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 - 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) + orientation(i,:) = orientation_1 + angularVelocity(i,:) = angularVelocity_1 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,:) + 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 - ! call QuaternionNorm(angularVelocity,dummy) + endif - ! write(*,*) 'Norm of angvel = ', dummy + 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 @@ -239,7 +241,7 @@ 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 From 6845f72cf2866f1caef81ffc52b469f840b3c9d7 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 4 Mar 2025 11:04:34 +0000 Subject: [PATCH 121/125] closest to official branch without printing div_visu --- src/visu.f90 | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/visu.f90 b/src/visu.f90 index d1887514d..443ad6fbc 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -264,25 +264,25 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1, iti ! Write pressure call write_field(ta1, ".", "pp", num, .true., flush=.true.) - ! 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.) + ! ! 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.) ! LMN - write density if (ilmn) call write_field(rho1(:,:,:,1), ".", "rho", num) From 2469e68ee1a3aec078839879e4e9d2bf4abc1dd3 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 4 Mar 2025 11:07:38 +0000 Subject: [PATCH 122/125] added inviscid_output option to not output flow data --- src/BC-Ellipsoid.f90 | 5 ++++- src/visu.f90 | 15 +++++++++------ 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 616d045b5..9d296837a 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -499,6 +499,9 @@ subroutine visu_ellip(ux1, uy1, uz1, pp3, phi1, ep1, num) 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 @@ -508,7 +511,7 @@ subroutine visu_ellip(ux1, uy1, uz1, pp3, phi1, ep1, num) - 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 diff --git a/src/visu.f90 b/src/visu.f90 index 443ad6fbc..c1fcfc67d 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -238,9 +238,12 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1, iti 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.) @@ -260,10 +263,10 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1, iti ! 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 ! ! Interpolate div_visu_var ! !WORK Z-PENCILS ! call interzpv(ppi3,div_visu_var(:,:,:,1),dip3,sz,cifip6z,cisip6z,ciwip6z,cifz6,cisz6,ciwz6,& From 854065f7813ebc72ddf21e0ea4ecd335df53fbe1 Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 4 Mar 2025 11:16:12 +0000 Subject: [PATCH 123/125] fully added inviscid_output parameter --- src/BC-Ellipsoid.f90 | 2 +- src/module_param.f90 | 2 +- src/parameters.f90 | 4 +++- src/visu.f90 | 2 +- 4 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/BC-Ellipsoid.f90 b/src/BC-Ellipsoid.f90 index 9d296837a..f25fd8a83 100644 --- a/src/BC-Ellipsoid.f90 +++ b/src/BC-Ellipsoid.f90 @@ -446,7 +446,7 @@ subroutine visu_ellip(ux1, uy1, uz1, pp3, phi1, ep1, num) 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 + use ibm_param, only : ubcx,ubcy,ubcz,inviscid_output implicit none diff --git a/src/module_param.f90 b/src/module_param.f90 index cb1404e2e..9ce0040be 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -671,7 +671,7 @@ module ibm_param 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, nozdrift, force_csv, bodies_fixed, cube_flag, torques_flag,orientations_free, shear_flow_ybc, shear_flow_zbc,torq_debug, torq_flip, ztorq_only, nbody + 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 end module ibm_param !############################################################################ !############################################################################ diff --git a/src/parameters.f90 b/src/parameters.f90 index d893165be..79b1920a8 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -72,7 +72,8 @@ subroutine parameter(input_i3d) NAMELIST /ibmstuff/ ce,sh,ori,lv,av,ra, & 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 + torques_flag, orientations_free, shear_flow_ybc, shear_flow_zbc, shear_velocity, torq_debug, torq_flip, ztorq_only, nbody, & + inviscid_output 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, & @@ -770,6 +771,7 @@ subroutine parameter_defaults() nozdrift=0 force_csv=0 nbody=1 + inviscid_output=0 ra(:) = 1.0 !! Gravity field diff --git a/src/visu.f90 b/src/visu.f90 index c1fcfc67d..ed0b4ca92 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -175,7 +175,7 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1, iti use decomp_2d_io, only : decomp_2d_start_io use param, only : nrhotime, ilmn, iscalar, ioutput, irestart - + use ibm_param, only : inviscid_output 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 From ef5f99020ee56dee359854dcf587da46b926d86d Mon Sep 17 00:00:00 2001 From: s2006749 Date: Tue, 4 Mar 2025 12:43:27 +0000 Subject: [PATCH 124/125] added option for div_visu --- src/module_param.f90 | 2 +- src/parameters.f90 | 3 ++- src/visu.f90 | 42 ++++++++++++++++++++++-------------------- 3 files changed, 25 insertions(+), 22 deletions(-) diff --git a/src/module_param.f90 b/src/module_param.f90 index 9ce0040be..7c63620b7 100644 --- a/src/module_param.f90 +++ b/src/module_param.f90 @@ -671,7 +671,7 @@ module ibm_param 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, 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 + 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/parameters.f90 b/src/parameters.f90 index 79b1920a8..7aac0dda6 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -73,7 +73,7 @@ subroutine parameter(input_i3d) 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 + 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, & @@ -772,6 +772,7 @@ subroutine parameter_defaults() force_csv=0 nbody=1 inviscid_output=0 + div_visu_flag=0 ra(:) = 1.0 !! Gravity field diff --git a/src/visu.f90 b/src/visu.f90 index ed0b4ca92..1f46058e7 100644 --- a/src/visu.f90 +++ b/src/visu.f90 @@ -175,7 +175,7 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1, iti use decomp_2d_io, only : decomp_2d_start_io use param, only : nrhotime, ilmn, iscalar, ioutput, irestart - use ibm_param, only : inviscid_output + 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 @@ -267,26 +267,28 @@ subroutine write_snapshot(rho1, ux1, uy1, uz1, pp3, div_visu_var, phi1, ep1, iti ! Write pressure call write_field(ta1, ".", "pp", num, .true., flush=.true.) endif - ! ! 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.) + 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) From d9717414bdc7c897d4b31885c6145d4d58c928ce Mon Sep 17 00:00:00 2001 From: s2006749 Date: Sun, 30 Mar 2025 22:33:54 +0100 Subject: [PATCH 125/125] fixed test passes --- src/forces.f90 | 6 +++--- src/parameters.f90 | 2 +- src/xcompact3d.f90 | 18 +++--------------- 3 files changed, 7 insertions(+), 19 deletions(-) diff --git a/src/forces.f90 b/src/forces.f90 index 295e6a7c9..c1408e83d 100644 --- a/src/forces.f90 +++ b/src/forces.f90 @@ -1044,9 +1044,9 @@ subroutine force(ux1,uy1,uz1,ep1,dra1,dra2,dra3,record_var) 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(:)) + 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) diff --git a/src/parameters.f90 b/src/parameters.f90 index 7aac0dda6..00005898e 100644 --- a/src/parameters.f90 +++ b/src/parameters.f90 @@ -69,7 +69,7 @@ subroutine parameter(input_i3d) 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/ ce,sh,ori,lv,av,ra, & + 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, & diff --git a/src/xcompact3d.f90 b/src/xcompact3d.f90 index 5a4d0e139..ba0846150 100644 --- a/src/xcompact3d.f90 +++ b/src/xcompact3d.f90 @@ -153,20 +153,6 @@ program xcompact3d do i = 1,nbody linearForce(i,:) = [drag(i)-grav_effx(i), lift(i)-grav_effy(i), lat(i)-grav_effz(i)] enddo - if (nozdrift==1) then - linearForce(:,3)=zero - endif - - if (bodies_fixed==1) then - linearForce(:,:)=zero - endif - - if ((nrank==0).and.(force_csv.eq.1)) then - ! open(unit=20, file='force_out.dat', action='write') - write(20, *) linearForce(1,1), linearForce(1,2), linearForce(1,3) - write(*,*) 'Writing forces', linearForce(1,1), linearForce(1,2), linearForce(1,3) - flush(20) - endif if (torques_flag.eq.1) then @@ -345,7 +331,9 @@ subroutine init_xcompact3d() call decomp_info_init(nxm, nym, nz, ph3) call init_variables() - call param_assign() + if (itype.eq.itype_ellip) then + call param_assign() + endif call schemes()