diff --git a/CMakeLists.txt b/CMakeLists.txt index ca85ccba..e79e7910 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -21,9 +21,12 @@ set(DECOMP_LIBRARY_PATH "${DECOMP_PATH}/lib") set(DECOMP_INCLUDE_PATH "${DECOMP_PATH}/include") # Where to look for Lib_VTK_IO -set(VTK_IO_PATH $ENV{VTK_IO_PATH}) -set(VTK_IO_LIBRARY_PATH "${VTK_IO_PATH}/lib") -set(VTK_IO_INCLUDE_PATH "${VTK_IO_PATH}/modules") +# set(VTK_IO_PATH $ENV{VTK_IO_PATH}) +# set(VTK_IO_LIBRARY_PATH "${VTK_IO_PATH}/lib") +# set(VTK_IO_INCLUDE_PATH "${VTK_IO_PATH}/modules") +# set(VTK_IO_PATH $ENV{VTK_IO_PATH}) +# set(VTK_IO_LIBRARY_PATH "${VTK_IO_PATH}/lib") +# set(VTK_IO_INCLUDE_PATH "${VTK_IO_PATH}/modules") # Where to look for HDF5 set(HDF5_PATH $ENV{HDF5_PATH}) @@ -58,27 +61,29 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU_OSX") if ( CMAKE_BUILD_TYPE MATCHES "Release" ) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Wall -Wconversion -Wextra -Waliasing -fopenmp -ffree-form -ffree-line-length-none -ffast-math -funroll-loops -fno-protect-parens -fno-unsafe-math-optimizations -frounding-math -fsignaling-nans") elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) - set(CMAKE_Fortran_FLAGS "-Og -g -fbacktrace -pg -llapack -ffree-form -ffree-line-length-none -fopenmp -fbounds-check -ffpe-trap=zero,overflow -Wall -Wconversion -Wextra -Waliasing -Wsurprising -fno-unsafe-math-optimizations -frounding-math -fsignaling-nans") + set(CMAKE_Fortran_FLAGS "-Og -g -fbacktrace -pg -ffree-form -ffree-line-length-none -fopenmp -fbounds-check -ffpe-trap=zero,overflow -Wall -Wconversion -Wextra -Waliasing -Wsurprising -fno-unsafe-math-optimizations -frounding-math -fsignaling-nans") endif() # Standard GNU compilers elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") if ( CMAKE_BUILD_TYPE MATCHES "Release" ) - if ($ENV{ARCH_OPT_FLAG}) - set(OPTFLAG "-march=native") - else() - set(OPTFLAG $ENV{ARCH_OPT_FLAG}) - endif() - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Wall -Wconversion -Wextra -Waliasing -ffree-form -ffree-line-length-none -ffast-math ${OPTFLAG} -funroll-loops -fno-protect-parens -fopenmp") + if ($ENV{ARCH_OPT_FLAG}) + # set(OPTFLAG "-march=native") + set(OPTFLAG $ENV{ARCH_OPT_FLAG}) + else() + set(OPTFLAG $ENV{ARCH_OPT_FLAG}) + endif() + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Wall -Wconversion -Wextra -Waliasing -ffree-form -ffree-line-length-none -ffast-math ${OPTFLAG} -funroll-loops -fno-protect-parens -fopenmp -fallow-argument-mismatch -finit-integer=0 -finit-real=zero") elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) - set(CMAKE_Fortran_FLAGS "-Og -g -fbacktrace -pg -llapack -ffree-form -ffree-line-length-none -fcheck=all -fbounds-check -ffpe-trap=zero,overflow -Wall -Wconversion -Wextra -Waliasing -Wsurprising") + set(CMAKE_Fortran_FLAGS "-Og -g -fbacktrace -pg -ffree-form -ffree-line-length-none -fcheck=all -fbounds-check -ffpe-trap=zero,overflow -Wall -Wconversion -Wextra -Waliasing -Wsurprising") endif() elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "Cray") if ( CMAKE_BUILD_TYPE MATCHES "Release" ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Wall -Wconversion -Wextra -Waliasing -ffree-form -ffree-line-length-none -ffast-math -march=native -funroll-loops -fno-protect-parens -fopenmp") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -h omp -hlist=a") + # set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Wall -Wconversion -Wextra -Waliasing -ffree-form -ffree-line-length-none -ffast-math -funroll-loops -fno-protect-parens -fopenmp -finit-integer=0 -finit-real=zero") elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) - set(CMAKE_Fortran_FLAGS "-Og -g -fbacktrace -pg -llapack -ffree-form -ffree-line-length-none -fcheck=all -fbounds-check -ffpe-trap=zero,overflow -Wall -Wconversion -Wextra -Waliasing -Wsurprising") + set(CMAKE_Fortran_FLAGS "-Og -g -fbacktrace -pg -ffree-form -ffree-line-length-none -fcheck=all -fbounds-check -ffpe-trap=zero,overflow -Wall -Wconversion -Wextra -Waliasing -Wsurprising") endif() elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "IBM") diff --git a/problems/incompressible/diurnal_concurrent.F90 b/problems/incompressible/diurnal_concurrent.F90 index 26e89da0..1073e037 100644 --- a/problems/incompressible/diurnal_concurrent.F90 +++ b/problems/incompressible/diurnal_concurrent.F90 @@ -50,7 +50,7 @@ program diurnal_concurrent call precursor%start_io(.true.) if (primary%usefringe) then - call primary%fringe_x%associateFringeTargets(precursor%u, precursor%v, precursor%wC, precursor%T) + call primary%fringe_x%associateFringeTargets(precursor%u, precursor%v, precursor%w, precursor%T) end if call budg_tavg%init(primary_inputfile, primary) !<-- Budget class initialization diff --git a/problems/incompressible/gablsdyn_igrid.F90 b/problems/incompressible/gablsdyn_igrid.F90 new file mode 100644 index 00000000..933e4782 --- /dev/null +++ b/problems/incompressible/gablsdyn_igrid.F90 @@ -0,0 +1,64 @@ +! Template for PadeOps + +#include "gablsdyn_igrid_files/initialize.F90" +#include "gablsdyn_igrid_files/temporalHook.F90" + +program gabls_igrid + use mpi + use kind_parameters, only: clen + use IncompressibleGrid, only: igrid + use temporalhook, only: doTemporalStuff, initialize_controller_location + use timer, only: tic, toc + use budgets_xy_avg_mod, only: budgets_xy_avg + use budgets_time_avg_mod, only: budgets_time_avg + use exits, only: message + + implicit none + + type(igrid), allocatable, target :: igp + character(len=clen) :: inputfile + integer :: ierr + type(budgets_xy_avg) :: budg_xy + type(budgets_time_avg) :: budg_tavg + + call MPI_Init(ierr) !<-- Begin MPI + + call GETARG(1,inputfile) !<-- Get the location of the input file + + allocate(igp) !<-- Initialize hit_grid with defaults + + call compute_xdim_udim(inputfile) + call igp%init(inputfile) !<-- Properly initialize the hit_grid solver (see hit_grid.F90) + + !call igp%start_io(.false.) !<-- Start I/O by creating a header file (see io.F90) + + call igp%printDivergence() + + call initialize_controller_location(igp, inputfile) + + ! call budg_xy%init(inputfile, igp) !<-- Budget class initialization + call budg_tavg%init(inputfile, igp) !<-- Budget class initialization + + call tic() + do while (igp%tsim < igp%tstop) + + call igp%timeAdvance() !<-- Time stepping scheme + Pressure Proj. (see igridWallM.F90) + call doTemporalStuff(igp) !<-- Go to the temporal hook (see temporalHook.F90) + + !call budg_xy%doBudgets() !<--- perform budget related operations + call budg_tavg%doBudgets() !<--- perform budget related operations + end do + + !call budg_xy%destroy() !<-- release memory taken by the budget class + call budg_tavg%destroy() !<-- release memory taken by the budget class + + call igp%finalize_io() !<-- Close the header file (wrap up i/o) + + call igp%destroy() !<-- Destroy the IGRID derived type + + + deallocate(igp) !<-- Deallocate all the memory associated with scalar defaults + + call MPI_Finalize(ierr) !<-- Terminate MPI + +end program diff --git a/problems/incompressible/gablsdyn_igrid_files/initialize.F90 b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 new file mode 100644 index 00000000..c2b4bd07 --- /dev/null +++ b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 @@ -0,0 +1,355 @@ +module gabls_igrid_parameters + + ! TAKE CARE OF TIME NON-DIMENSIONALIZATION IN THIS MODULE + + use exits, only: message + use kind_parameters, only: rkind + use constants, only: zero, kappa, pi + implicit none + integer :: seedu = 321341 + integer :: seedv = 423424 + integer :: seedw = 131344 + real(rkind) :: randomScaleFact = 0.002_rkind ! 0.2% of the mean value + integer :: nxg, nyg, nzg + + real(rkind) :: xdim = 400._rkind, udim =8._rkind, timeDim = zero + real(rkind), parameter :: g = 9.81_rkind, omega = 0.0000729_rkind ! dimensionalizing values g (gravity) and omega (rotation rate) +end module + +subroutine compute_xdim_udim(inputfile) + use kind_parameters, only: rkind, clen + use gabls_igrid_parameters, only: xdim, udim, timeDim, g, omega, message + character(len=*), intent(in) :: inputfile + character(len=:), allocatable :: buffer + character(len=clen) :: line + real(rkind) :: Ro, Fr + integer :: iunit + + namelist /PHYSICS/Ro, Fr ! ignore all other variables + + ! All this work is just so we don't need to read ALL of the &PHYSICS namelist... + ! What we are doing here is finding JUST the variables "Fr" and "Ro" and making a + ! new internal namelist to parse + buffer = "&PHYSICS" // new_line('a') + open(unit=10, file=trim(inputfile), form='formatted') + do + read(10,'(A)', iostat=iunit) line + if (iunit /= 0) exit + ! find lines beginning with "Fr " or "Ro ": + if (index(adjustl(line), "Fr ") == 1 .or. index(adjustl(line), "Ro ") == 1) then + ! strip comments: + if (index(line, "!") > 0) line = line(:index(line, "!")-1) + buffer = buffer // trim(adjustl(line)) // new_line('a') + end if + end do + buffer = buffer // "/" // new_line('a') + close(10) + + read(buffer, NML=PHYSICS) + + xdim = g * (Fr / Ro / omega)**2 + udim = g * Fr**2 / omega / Ro + timeDim = xdim/max(abs(udim),0.0001) + + ! For some reason, the following lines print once per processor, so I've just commented them out: + ! if (nrank == 0) then + ! call message(0, "Computed the following dimensional values from the Rossby and Froude numbers:") + ! call message(1, " xdim", xdim) + ! call message(1, " udim", udim) + ! call message(1, " timeDim", timeDim) + ! end if +end subroutine + +subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) + use gabls_igrid_parameters + use kind_parameters, only: rkind + use constants, only: zero, one, two, pi, half + use gridtools, only: alloc_buffs + use random, only: gaussian_random + use decomp_2d + use reductions, only: p_maxval + use constants, only: pi + implicit none + type(decomp_info), intent(in) :: decompC + type(decomp_info), intent(in) :: decompE + character(len=*), intent(in) :: inputfile + real(rkind), dimension(:,:,:,:), intent(in), target :: mesh + real(rkind), dimension(:,:,:,:), intent(inout), target :: fieldsC + real(rkind), dimension(:,:,:,:), intent(inout), target :: fieldsE + integer :: ioUnit + real(rkind), dimension(:,:,:), pointer :: u, v, w, wC, T, x, y, z + real(rkind), dimension(:,:,:), allocatable :: ybuffC, ybuffE, zbuffC, zbuffE + integer :: nz, nzE, k + real(rkind) :: sig, hpert=zero, hpert_ + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, dTsurf_dt = zero, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero + real(rkind), dimension(:,:,:), allocatable :: randArr, Tpurt, eta + + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + + !!!!!!!!!!!!!!!!!!!!! DON'T CHANGE THE POINTERS / ALLOCATIONS !!!!!!!!!!!!!!!!!!!!!! + u => fieldsC(:,:,:,1); v => fieldsC(:,:,:,2); wC => fieldsC(:,:,:,3) + w => fieldsE(:,:,:,1); T => fieldsC(:,:,:,7) + z => mesh(:,:,:,3); y => mesh(:,:,:,2); x => mesh(:,:,:,1) + !allocate(Tpurt(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) + !allocate(randArr(size(T,1),size(T,2),size(T,3))) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + u = one + v = zero + wC = zero + + allocate(Tpurt(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) + + T = Tsurf0 + where (z >= inv_height .and. z < inv_height + inv_thickness) + T = Tsurf0 + inv_strength * (z - inv_height) / inv_thickness + elsewhere (z >= inv_height + inv_thickness) + T = Tsurf0 + inv_strength + lapse_rate * (z - inv_height - inv_thickness) + end where + + ! Add random numbers + allocate(randArr(size(T,1),size(T,2),size(T,3))) + call gaussian_random(randArr,zero,one,seedu + 10*nrank) + do k = 1,size(u,3) + sig = 0.08 + Tpurt(:,:,k) = sig*randArr(:,:,k) + end do + if(allocated(randArr)) deallocate(randArr) + + if(hpert>zero)then + hpert_ = hpert + else + hpert_ = 50.d0/xdim + end if + call message(1,"Perturbing temperature up to ", hpert_) + + where (z > hpert_) + Tpurt = zero + end where + T = T + Tpurt + + if(allocated(Tpurt)) deallocate(Tpurt) + + !!!!!!!!!!!!!!!!!!!!! DON'T CHANGE ANYTHING UNDER THIS !!!!!!!!!!!!!!!!!!!!!! + ! Interpolate wC to w + allocate(ybuffC(decompC%ysz(1),decompC%ysz(2), decompC%ysz(3))) + allocate(ybuffE(decompE%ysz(1),decompE%ysz(2), decompE%ysz(3))) + allocate(zbuffC(decompC%zsz(1),decompC%zsz(2), decompC%zsz(3))) + allocate(zbuffE(decompE%zsz(1),decompE%zsz(2), decompE%zsz(3))) + nz = decompC%zsz(3) + nzE = nz + 1 + call transpose_x_to_y(wC,ybuffC,decompC) + call transpose_y_to_z(ybuffC,zbuffC,decompC) + zbuffE = zero + zbuffE(:,:,2:nzE-1) = half*(zbuffC(:,:,1:nz-1) + zbuffC(:,:,2:nz)) + call transpose_z_to_y(zbuffE,ybuffE,decompE) + call transpose_y_to_x(ybuffE,w,decompE) + ! Deallocate local memory + deallocate(ybuffC,ybuffE,zbuffC, zbuffE) + nullify(u,v,w,x,y,z) + call message(0,"Velocity Field Initialized") + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +end subroutine + +subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) + use kind_parameters, only: rkind + use constants, only: one, zero + implicit none + + character(len=*), intent(in) :: inputfile + real(rkind), intent(out) :: wTh_surf + integer :: ioUnit + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, dTsurf_dt = zero, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero, hpert=zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + ! Do nothing really since temperature BC is dirichlet +end subroutine + +subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) + use kind_parameters, only: rkind + use gabls_igrid_parameters + use constants, only: one, zero + implicit none + real(rkind), intent(out) :: Tsurf, dTsurf_dt + character(len=*), intent(in) :: inputfile + integer :: ioUnit + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero, hpert=zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + dTsurf_dt = dTsurf_dt / 3600.d0 + + ! Normalize + dTsurf_dt = dTsurf_dt * timeDim + + Tsurf = Tsurf0 +end subroutine + +subroutine set_planes_io(xplanes, yplanes, zplanes) + implicit none + integer, dimension(:), allocatable, intent(inout) :: xplanes + integer, dimension(:), allocatable, intent(inout) :: yplanes + integer, dimension(:), allocatable, intent(inout) :: zplanes + integer, parameter :: nxplanes = 1, nyplanes = 1, nzplanes = 1 + + allocate(xplanes(nxplanes), yplanes(nyplanes), zplanes(nzplanes)) + + xplanes = [64] + yplanes = [64] + zplanes = [256] + +end subroutine + +subroutine hook_probes(inputfile, probe_locs) + use kind_parameters, only: rkind + real(rkind), dimension(:,:), allocatable, intent(inout) :: probe_locs + character(len=*), intent(in) :: inputfile + integer, parameter :: nprobes = 2 + + ! IMPORTANT : Convention is to allocate probe_locs(3,nprobes) + ! Example: If you have at least 3 probes: + ! probe_locs(1,3) : x -location of the third probe + ! probe_locs(2,3) : y -location of the third probe + ! probe_locs(3,3) : z -location of the third probe + + + ! Add probes here if needed + ! Example code: The following allocates 2 probes at (0.1,0.1,0.1) and + ! (0.2,0.2,0.2) + allocate(probe_locs(3,nprobes)) + probe_locs(1,1) = 0.1d0; probe_locs(2,1) = 0.1d0; probe_locs(3,1) = 0.1d0; + probe_locs(1,2) = 0.2d0; probe_locs(2,2) = 0.2d0; probe_locs(3,2) = 0.2d0; + +end subroutine + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!! THE SUBROUTINES UNDER THIS DON'T TYPICALLY NEED TO BE CHANGED !!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) + use gabls_igrid_parameters + use kind_parameters, only: rkind + use constants, only: one,two + use decomp_2d, only: decomp_info + implicit none + + type(decomp_info), intent(in) :: decomp + real(rkind), intent(inout) :: dx,dy,dz + real(rkind), dimension(:,:,:,:), intent(inout) :: mesh + integer :: i,j,k, ioUnit + character(len=*), intent(in) :: inputfile + integer :: ix1, ixn, iy1, iyn, iz1, izn + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, dTsurf_dt = zero, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero, hpert=zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + !Lx = two*pi; Ly = two*pi; Lz = one + + nxg = decomp%xsz(1); nyg = decomp%ysz(2); nzg = decomp%zsz(3) + + ! If base decomposition is in Y + ix1 = decomp%xst(1); iy1 = decomp%xst(2); iz1 = decomp%xst(3) + ixn = decomp%xen(1); iyn = decomp%xen(2); izn = decomp%xen(3) + + associate( x => mesh(:,:,:,1), y => mesh(:,:,:,2), z => mesh(:,:,:,3) ) + + dx = Lx/real(nxg,rkind) + dy = Ly/real(nyg,rkind) + dz = Lz/real(nzg,rkind) + + do k=1,size(mesh,3) + do j=1,size(mesh,2) + do i=1,size(mesh,1) + x(i,j,k) = real( ix1 + i - 1, rkind ) * dx + y(i,j,k) = real( iy1 + j - 1, rkind ) * dy + z(i,j,k) = real( iz1 + k - 1, rkind ) * dz + dz/two + end do + end do + end do + + ! Shift everything to the origin + x = x - dx + y = y - dy + z = z - dz + + end associate + +end subroutine + +subroutine set_Reference_Temperature(inputfile, Thetaref) + use kind_parameters, only: rkind + use constants, only: one, zero + implicit none + character(len=*), intent(in) :: inputfile + real(rkind), intent(out) :: Thetaref + integer :: ioUnit + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, dTsurf_dt = zero, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero, hpert=zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + Thetaref = Tref + ! This will set the value of Tref. + +end subroutine + + +subroutine set_KS_planes_io(planesCoarseGrid, planesFineGrid) + integer, dimension(:), allocatable, intent(inout) :: planesFineGrid + integer, dimension(:), allocatable, intent(inout) :: planesCoarseGrid + + allocate(planesCoarseGrid(1), planesFineGrid(1)) + planesCoarseGrid = [8] + planesFineGrid = [16] + +end subroutine + +subroutine initScalar(decompC, inpDirectory, mesh, scalar_id, scalarField) + use kind_parameters, only: rkind + use decomp_2d, only: decomp_info + type(decomp_info), intent(in) :: decompC + character(len=*), intent(in) :: inpDirectory + real(rkind), dimension(:,:,:,:), intent(in) :: mesh + integer, intent(in) :: scalar_id + real(rkind), dimension(:,:,:), intent(out) :: scalarField + + scalarField = 0.d0 +end subroutine + +subroutine setScalar_source(decompC, inpDirectory, mesh, scalar_id, scalarSource) + use kind_parameters, only: rkind + use decomp_2d, only: decomp_info + type(decomp_info), intent(in) :: decompC + character(len=*), intent(in) :: inpDirectory + real(rkind), dimension(:,:,:,:), intent(in) :: mesh + integer, intent(in) :: scalar_id + real(rkind), dimension(:,:,:), intent(out) :: scalarSource + + scalarSource = 0.d0 +end subroutine \ No newline at end of file diff --git a/problems/incompressible/gablsdyn_igrid_files/input_gablsdyn.dat b/problems/incompressible/gablsdyn_igrid_files/input_gablsdyn.dat new file mode 100644 index 00000000..23a04dc9 --- /dev/null +++ b/problems/incompressible/gablsdyn_igrid_files/input_gablsdyn.dat @@ -0,0 +1,172 @@ +&INPUT +inputdir = "/scratch/10829/kali/PadeOps_Sims/test_cases/stable/C025" ! Directory for any input files +outputdir = "/scratch/10829/kali/PadeOps_Sims/test_cases/stable/C025" ! Directory for all output files +nx = 250 ! Number of points in X +ny = 100 ! Number of points in Y +nz = 200 ! Number of points in Z +tstop = 576.D0 ! Physical time to stop the simulation +CFL = 0.8D0 ! CFL criterion for calculating the time step (Set to negative to disable) +dt = 0.001D0 ! Fixed time step value (only used if CFL is set to negative) +prow = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +pcol = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +useRestartFile = .FALSE. ! Set to false if it's a fresh simulation +restartFile_TID = 50605 ! TimeID of the restart file being used +restartFile_RID = 1 ! RunID of the restart file being used +/ +/ +&NUMERICS +AdvectionTerm = 1 ! 0: Rotational Form, 1: Skew-Symmetric Form (use this for Compact Scheme) +ComputeStokesPressure = .TRUE. ! This would be FALSE only is very special circumstances. +NumericalSchemeVert = 1 ! 0: Second order FD, 1: Sixth order Compact Difference (CD06) +useDealiasFilterVert = .FALSE. ! Dealiasing filter used in vertical direction +t_DivergenceCheck = 100 ! Check divergence every $ timesteps. Reproject if needed. +TimeSteppingScheme = 2 ! 0: Adams-Bashforth, 1: TVD-RK3 (use this), 2: SSP-RK45 +useExhaustiveFFT = .TRUE. +/ +/ +&IO +RunID = 1 ! Run Label (All output files will be tagged with this nubber) +t_restartDump = 2250 ! Restart File Dumping Frequency (# of timesteps) +t_dataDump = 2250 ! Data dumping frequency (# of timesteps) +ioType = 0 ! 0: Fortran Binaries, 1: .vtk files +dumpPlanes = .FALSE. ! Dump plane visualations. Select planes in initialize.F90 +t_planeDump = 100 ! Plane dumping frequency (# of timesteps) +t_start_planeDump = 3500 ! When do you want to start dumping planes? +t_stop_planeDump = 5000 ! When do you want to stop dumping planes? +dump_NU_SGS = .TRUE. ! Do you want to dump eddy viscosity? +dump_KAPPA_SGS = .TRUE. ! Do you want to dump scalar eddy diffusivity? +/ +/ +&STATS +tid_StatsDump = 100000 ! Dumping Frequency for Statistics file (# of time steps) +tid_compStats = 10 ! Frequency of Computing Statistics +tSimStartStats = 20.d0 ! Simulation time for starting stats calculations +normStatsByUstar = .FALSE. ! Normalize Statistics by ustar at each instant +computeSpectra = .FALSE. ! Compute and time average x - spectra on the run +timeAvgFullFields = .FALSE. ! Time average and store fields on the run +/ +/ +&OS_INTERACTIONS +useSystemInteractions = .FALSE. ! Do you wish to interact with the program while its running +tSystemInteractions = 10 ! Check for interactions commands after these many time steps +controlDir = "null" ! Check in this directory for command files (NULL = Check in output directory) +/ +/ +&PHYSICS +isInviscid = .TRUE. ! Is this an inviscid simulation? +useCoriolis = .TRUE. ! Activate the coriolis term? +useExtraForcing = .FALSE. ! Is an extra forcing term being used? (non-Geostrophic forcing only) +isStratified = .TRUE. ! Use Stratification / active scalar in momentum +Re = 3.42D8 ! Reynolds Number; used when isInvisid is FALSE +Ro = 274.27D0 ! Rossby Number used when Coriolis is ON +Pr = 0.85D0 ! Turbulent Prandtl Number; used when +Fr = 0.1483D0 ! Froude number; used when isStratified is TRUE +useSGS = .TRUE. ! Do you want to use the SGS model? +useGeostrophicForcing = .TRUE. ! This is true if forcing is provided using the coriolis term +G_geostrophic = 1.D0 ! Geostrophic wind speed +G_alpha = 0.D0 ! Geostrophic wind angle (degrees, from +x axis) +dPfdx = 0.D0 ! Additional Acceleration in X; used if useExtraForcing is ON +dPfdy = 0.D0 ! Additional Acceleration in Y; used if useExtraForcing is ON +dPfdz = 0.D0 ! Additional Acceleration in Z; used if useExtraForcing is ON +assume_fplane = .TRUE. ! F-plane assumption for horizontal component? +latitude = 37.0D0 ! latitude +useHITForcing = .FALSE. ! Use an extra forcing term used for HIT? +frameAngle = 0.d0 ! Frame angle (degrees) +/ +/ +&PRESSURE_CALC +fastCalcPressure = .TRUE. ! Compute and store pressure at every time step using the faster algorithm? +storePressure = .FALSE. ! Would you like to compute and store pressure? +P_dumpFreq = 100 ! How often (timesteps) do you want to dump pressure? +P_compFreq = 100 ! How often (timesteps) do you want to compute pressure? +/ +/ +&BCs +botWall = 3 ! no_slip = 1, slip = 2, wall model = 3 +topWall = 2 ! no_slip = 1, slip = 2, wall model = 3 +useSpongeLayer = .TRUE. ! Use a sponge layer at the top +zstSponge = 0.75 ! Height above which the sponge layer is active +SpongeTscale = 20.d0 ! e-folding time to dt ratio (somewhere between 10 - 50) +useFringe = .FALSE. ! This is false if simulation is periodic. +botBC_Temp = 0 ! 0: Dirichlet (could be time dependent), 1: Homog. Neumann (no-flux) +useControl = .TRUE. ! Use PI control to fix yaw angle at the height specified below +/ +/ +&SGS_MODEL +DynamicProcedureType = 0 ! 0: No dynamic procedure, 1: Planar Avg. Dynamic Proc., 2: Global Dynamic Proc. +SGSModelID = 2 ! 0: smagorinsky, 1: sigma, 2: AMD +useWallDamping = .FALSE. ! Use the Wall Damping Function +ncWall = 3.d0 ! Wall Damping Function Exponent +Csgs = 0.8d0 ! Asymptotic model constant (wall damping function) +wallModelType = 2 ! 1: Moeng's original model, 2: Bou-Zeid's fully local model +explicitCalcEdgeEddyViscosity = .FALSE. ! Explicitely compute eddy viscosity at edges? or interpolate? +DynProcFreq = 5 ! Dynamic procedure used every DYNPROCFREQ timesteps. +useSGSDynamicRestart = .FALSE. ! Clip the constant values when they are negative +useVerticalTfilter = .FALSE. ! Test filter in the vertical direction? Used for Dynamic Procedure +SGSDynamicRestartFile = "null" ! Clip the constant values when they are negative +useFullyLocalWM = .FALSE. +z0 = 1.6D-5 ! Nondimensionalized roughness length +/ +/ +&WINDTURBINES +useWindTurbines = .FALSE. ! Do you want to use Wind turbines ? +num_turbines = 24 ! How many turbines? +ADM = .TRUE. ! Are these actuator disks? +turbInfoDir = "/home/nghaisas/ActuatorDisk/" ! Where are the turbine info files located? +/ +/ +&KSPREPROCESS +PreprocessForKS = .FALSE. ! Do you want to generate preprocessing files for KS? +KSoutputDir = "location" ! Directory where KS files are dumped. +KSRunID = 99 ! RunID tag for KS files +t_dumpKSprep = 10 ! Dumping Frequency for KS files +/ +/ +&CONTROL +beta = 0.03d2 ! 0.08d3,0.0278 Integrator tuning parameter (appropriate non-dimensionalized) +sigma = 3.995d0 ! 3.995d0 Time constant for filter for rotation rate +phi_ref = 0.d0 ! Desired degrees at z_ref +z_ref = 6 ! Index of desired phi_ref +alpha = 0.d0 ! Proportional gain constant +controlType = 1 ! 1: Meneveau 2014, 2: Control G_alpha +angleTrigger = 0.1d0 ! Angle at z_ref where control turns on +/ +/ +&PROBLEM_INPUT +Lx = 2.0D1 ! Domain Length (appropriate dimesnions/non-dimensionalized) +Ly = 8.0D0 ! Domain Width (appropriate dimesnions/non-dimensionalized) +Lz = 8.0D0 ! Domain Height (appropriate dimesnions/non-dimensionalized) +Tref = 263.5d0 ! Reference Temp. +Tsurf0 = 265.0d0 ! Surface Temp. (at tsim=0) in K (need to take care of the dimensions) +dTsurf_dt = -0.25D0 ! Surface Temp. decrease rate in K/hr. (need to take care of the dimensions) +z0init = 1.6D-5 ! Roughness scale used to initialize the profile +frameAngle = 0.d0 ! Frame angle set to be the same as above, used for initialization +dTdz = 1.5D0 ! Background potential temperature gradient in K/length (need to take care of the dimensions) +z_Tref = 0.4d0 ! Height (proper units) below which T is constant. +/ +/ +&BUDGET_TIME_AVG +do_budgets = .TRUE. ! Perform budget calculations? +budgetType = 0 ! See type descriptions in budget_time_avg.F90 +budgets_dir = "/scratch/10829/kali/PadeOps_Sims/test_cases/stable/C025" ! Write in default output directory +tidx_compute = 5 ! How often should budgets be computed? +tidx_dump = 400 ! How often should budget files be written to disk? +tidx_budget_start = 7875 ! Start budget computation from this timestep onward +restart_budgets = .FALSE. ! use existing budget file to restart budget calculations? +restart_rid = 2 ! Restart budget file run index +restart_tid = 99999 ! Restart budget file time index +restart_counter = 11111 ! Restart budget file counter +/ +/ +&BUDGET_XY_AVG +do_budgets = .FALSE. ! Perform budget calculations? +budgetType = 3 ! See type descriptions in budget_xy_avg.F90 +budgets_dir = "path/to/file" ! Directory for budget files +tidx_compute = 5 ! How often should budgets be computed? +tidx_dump = 50 ! How often should budget files be written to disk? +restart_budgets = .FALSE. ! use existing budget file to restart budget calculations? +restart_rid = 1 ! Restart budget file run index +restart_tid = 170000 ! Restart budget file time index +restart_counter = 16000 ! Restart budget file counter +tidx_budget_start = 100 +/ diff --git a/problems/incompressible/gablsdyn_igrid_files/io.F90 b/problems/incompressible/gablsdyn_igrid_files/io.F90 new file mode 100644 index 00000000..bfbbffb3 --- /dev/null +++ b/problems/incompressible/gablsdyn_igrid_files/io.F90 @@ -0,0 +1,251 @@ +module pbl_IO + + use kind_parameters, only: rkind, clen + use decomp_2d, only: decomp_info,nrank,nproc + use exits, only: GracefulExit, message + implicit none + + integer, dimension(:,:), allocatable :: xst,xen,xsz + integer :: headerfid = 101 + integer :: NumDumps + +contains + + subroutine start_io(gp) + use IncompressibleGridWallM, only: igridWallM + use mpi + + class(igridWallM), target, intent(in) :: gp + character(len=clen) :: fname + character(len=clen) :: tempname + !character(len=clen) :: command + character(len=clen) :: OutputDir + !integer :: system + integer :: runIDX + logical :: isThere + integer :: tag, idx, status(MPI_STATUS_SIZE), ierr + + ! Create data sharing info + if (nrank == 0) then + allocate(xst(0:nproc-1,3),xen(0:nproc-1,3),xsz(0:nproc-1,3)) + end if + + + ! communicate local processor grid info (Assume x-decomposition) + if (nrank == 0) then + xst(0,:) = gp%gpC%xst + xen(0,:) = gp%gpC%xen + + tag = 0 + do idx = 1,nproc-1 + call MPI_RECV(xst(idx,:), 3, MPI_INTEGER, idx, tag,& + MPI_COMM_WORLD, status, ierr) + end do + tag = 1 + do idx = 1,nproc-1 + call MPI_RECV(xen(idx,:), 3, MPI_INTEGER, idx, tag,& + MPI_COMM_WORLD, status, ierr) + end do + tag = 2 + do idx = 1,nproc-1 + call MPI_RECV(xsz(idx,:), 3, MPI_INTEGER, idx, tag,& + MPI_COMM_WORLD, status, ierr) + end do + + else + tag = 0 + call MPI_SEND(gp%gpC%xst, 3, MPI_INTEGER, 0, tag, & + & MPI_COMM_WORLD, ierr) + tag = 1 + call MPI_SEND(gp%gpC%xen, 3, MPI_INTEGER, 0, tag, & + & MPI_COMM_WORLD, ierr) + tag = 2 + call MPI_SEND(gp%gpC%xsz, 3, MPI_INTEGER, 0, tag, & + & MPI_COMM_WORLD, ierr) + + end if + + OutputDir = gp%outputdir + runIDX = gp%runID + + inquire(FILE=trim(OutputDir), exist=isThere) + if (nrank == 0) then + !if (.not. isThere) then + ! print*, "=============================================" + ! print*, "WARNING: Output directory not found. Creating a new one." + ! print*, "=============================================" + ! command = "mkdir "//trim(OutputDir) + ! ierr = system(trim(command)) + !end if + write(tempname,"(A3,I2.2,A6,A4)") "Run", runIDX, "HEADER",".txt" + fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) + + open (headerfid, file=trim(fname), FORM='formatted', STATUS='replace',ACTION='write') + write(headerfid,*)"=========================================================================" + write(headerfid,*)"--------------------- Header file for MATLAB ---------------------------" + write(headerfid,"(A9,A10,A10,A10,A10,A10,A10)") "PROC", "xst", "xen", "yst", "yen","zst","zen" + write(headerfid,*)"-------------------------------------------------------------------------" + do idx = 0,nproc-1 + write(headerfid,"(I8,6I10)") idx, xst(idx,1), xen(idx,1), xst(idx,2), xen(idx,2), xst(idx,3), xen(idx,3) + end do + write(headerfid,*)"-------------------------------------------------------------------------" + write(headerfid,*)"Dumps made at:" + end if + numDumps = 0 + call mpi_barrier(mpi_comm_world,ierr) + + ! Now perform the initializing data dump + !call dumpData4Matlab(gp) + !call gp%dumpFullField(gp%u,'uVel') + !call gp%dumpFullField(gp%v,'vVel') + !call gp%dumpFullField(gp%wC,'wVel') + !call gp%dumpFullField(gp%PfieldsC(:,:,:,7),'Tout') + !call output_tecplot(gp) + end subroutine + + subroutine dumpData4Matlab(gp) + use IncompressibleGridWallM, only: igridWallM + use gridtools, only: alloc_buffs + use decomp_2d, only: transpose_y_to_x + + class(igridWallM), target, intent(in) :: gp + integer :: tid, runIDX + character(len=clen) :: fname + character(len=clen) :: tempname + character(len=clen) :: OutputDir + real(rkind), dimension(:,:,:,:), pointer :: fieldsPhys + integer :: fid = 1234 + + OutputDir = gp%outputdir + fieldsPhys => gp%PfieldsC + runIDX = gp%runID + tid = gp%step + + write(tempname,"(A3,I2.2,A2,I4.4,A2,I6.6,A5,A4)") "Run", RunIDX, "_p",nrank,"_t",tid,"_uVEL",".out" + fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) + open(fid,file=trim(fname),form='unformatted',status='replace') + write(fid) fieldsPhys(:,:,:,1) + close(fid) + + write(tempname,"(A3,I2.2,A2,I4.4,A2,I6.6,A5,A4)") "Run", RunIDX, "_p",nrank,"_t",tid,"_vVEL",".out" + fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) + open(fid,file=trim(fname),form='unformatted',status='replace') + write(fid) fieldsPhys(:,:,:,2) + close(fid) + + write(tempname,"(A3,I2.2,A2,I4.4,A2,I6.6,A5,A4)") "Run", RunIDX, "_p",nrank,"_t",tid,"_wVEL",".out" + fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) + open(fid,file=trim(fname),form='unformatted',status='replace') + write(fid) fieldsPhys(:,:,:,3) + close(fid) + + write(tempname,"(A3,I2.2,A2,I4.4,A2,I6.6,A5,A4)") "Run", RunIDX, "_p",nrank,"_t",tid,"_Tout",".out" + fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) + open(fid,file=trim(fname),form='unformatted',status='replace') + write(fid) fieldsPhys(:,:,:,7) + close(fid) + + + if (nrank == 0) then + write(headerfid,"(I8)") tid + end if + NumDumps = NumDumps + 1 + + nullify(fieldsPhys) + end subroutine + + !subroutine output_tecplot(gp) + ! use IncompressibleGridWallM, only: igridWallM + ! use gridtools, only: alloc_buffs + ! use decomp_2d, only: transpose_y_to_x + ! use turbineMod, only: turbineArray + + ! class(igridWallM), target, intent(in) :: gp + ! integer :: tid, runIDX + ! character(len=clen) :: fname + ! character(len=clen) :: tempname + ! character(len=clen) :: OutputDir + ! real(rkind), dimension(:,:,:,:), pointer :: fieldsPhys, xyz + ! type(turbineArray), pointer :: turbarr + ! integer :: fid = 1234, turbID, blID, ptID, i, j, k, T_indx + + ! OutputDir = gp%outputdir + ! fieldsPhys => gp%PfieldsC + ! xyz => gp%mesh + ! runIDX = gp%runID + ! tid = gp%step + + ! ! output field variables + ! if(gp%isStratified) then + ! T_indx = 7 + ! else + ! T_indx = 3 + ! endif + ! write(tempname,"(A4,I2.2,A2,I4.4,A4)") "tec_", RunIDX, "_p",nrank,".dat" + ! fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) + ! if(tid==0) then + ! open(fid,file=trim(fname),status='replace') + ! write(fid,'(75a)') 'VARIABLES="x","y","z","u","v","wC","T"' + ! write(fid,'(6(a,i7),a)') 'ZONE I=', gp%gpC%xsz(1), ' J=', gp%gpC%xsz(2), ' K=', gp%gpC%xsz(3), ' ZONETYPE=ORDERED' + ! write(fid,'(a,ES26.16)') 'DATAPACKING=POINT, SOLUTIONTIME=', gp%tsim + ! do k = 1, gp%gpC%xsz(3) + ! do j = 1, gp%gpC%xsz(2) + ! do i = 1, gp%gpC%xsz(1) + ! write(fid,'(7ES26.16)') xyz(i,j,k,1:3), fieldsPhys(i,j,k,1:3), fieldsPhys(i,j,k,T_indx) + ! enddo + ! enddo + ! enddo + ! close(fid) + ! else + ! open(fid,file=trim(fname),status='old',action='write',position='append') + ! write(fid,'(6(a,i7),a)') 'ZONE I=', gp%gpC%xsz(1), ' J=', gp%gpC%xsz(2), ' K=', gp%gpC%xsz(3), ' ZONETYPE=ORDERED' + ! write(fid,'(a,ES26.16)') 'DATAPACKING=POINT, SOLUTIONTIME=', gp%tsim + ! write(fid,'(a)') ' VARSHARELIST=([1, 2, 3]=1)' + ! do k = 1, gp%gpC%xsz(3) + ! do j = 1, gp%gpC%xsz(2) + ! do i = 1, gp%gpC%xsz(1) + ! write(fid,'(4ES26.16)') fieldsPhys(i,j,k,1:3), fieldsPhys(i,j,k,T_indx) + ! enddo + ! enddo + ! enddo + ! close(fid) + ! endif + + ! ! output field variables + ! if(gp%useWindTurbines) then + ! turbarr => gp%WindTurbineArr + ! do turbID = 1, turbarr%nTurbines + ! if(turbarr%num_cells_cloud(turbID) > 0) then + ! write(tempname,"(A4,I2.2,A2,I4.4,A3,I2.2,A4)") "tec_", RunIDX,"_p",nrank,"_wt",turbID,".dat" + ! fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) + ! if(tid==0) then + ! open(fid,file=trim(fname),status='replace') + ! write(fid,'(110a)') 'VARIABLES="x","y","z","blade_forcex", "blade_forcey" "blade_forcez"' + ! else + ! open(fid,file=trim(fname),status='old',action='write',position='append') + ! endif + ! write(fid,'(6(a,i7),a)') 'ZONE I=', turbarr%num_blades(turbID)*turbarr%num_blade_points(turbID), ' J=', 1, ' K=', 1, ' ZONETYPE=ORDERED' + ! write(fid,'(a,ES26.16)') 'DATAPACKING=POINT, SOLUTIONTIME=', gp%tsim + ! do blID = 1, turbarr%num_blades(turbID) + ! do ptID = 1, turbarr%num_blade_points(turbID) + ! write(fid,'(7ES26.16)') turbarr%blade_points(:, ptID, blID, turbID), turbarr%blade_forces(:, ptID, blID, turbID) + ! enddo + ! enddo + ! close(fid) + ! endif + ! enddo + ! nullify(turbarr) + ! endif + + ! nullify(fieldsPhys,xyz) + + !end subroutine + + subroutine finalize_io + if (nrank == 0) then + write(headerfid,*) "--------------------------------------------------------------" + write(headerfid,*) "------------------ END OF HEADER FILE ------------------------" + close(headerfid) + end if + end subroutine +end module diff --git a/problems/incompressible/gablsdyn_igrid_files/temporalHook.F90 b/problems/incompressible/gablsdyn_igrid_files/temporalHook.F90 new file mode 100644 index 00000000..68b7f9b6 --- /dev/null +++ b/problems/incompressible/gablsdyn_igrid_files/temporalHook.F90 @@ -0,0 +1,111 @@ +module temporalHook + use kind_parameters, only: rkind + use IncompressibleGrid, only: igrid + use reductions, only: P_MAXVAL, p_minval + use exits, only: message, message_min_max, GracefulExit + use constants, only: half + use timer, only: tic, toc + use mpi + use decomp_2d + use reductions, only: p_sum + + implicit none + + integer :: i, j, nt_print2screen = 1 + real(rkind) :: maxDiv, DomMaxDiv, angle + integer :: ierr + +contains + subroutine initialize_controller_location(igp, filename) + character(len=*), intent(in) :: filename + class(igrid), intent(inout) :: igp + real(rkind) :: beta, sigma, phi_ref, alpha, angleTrigger + integer :: ioUnit, controlType, z_ref = 16 + logical :: dummy_controller=.False. + namelist /CONTROL/ beta, sigma, phi_ref, z_ref, alpha, controlType, angleTrigger, dummy_controller + + ioUnit = 11 + open(unit=ioUnit, file=trim(filename), form='FORMATTED', iostat=ierr) + read(unit=ioUnit, NML=CONTROL) + close(ioUnit) + + igp%zHubindex = z_ref + + + end subroutine + + subroutine doTemporalStuff(igp) + class(igrid), intent(inout) :: igp + real(rkind) :: speedTop, um, vm, speedHub, utop, vtop, maxkappasgs, maxnusgs + igp%rbuffxC(:,:,:,1) = atan2(igp%v, igp%u) !* 180.d0 / 3.14d0 + call transpose_x_to_y(igp%rbuffxC(:,:,:,1),igp%rbuffyC(:,:,:,1),igp%gpC) + call transpose_y_to_z(igp%rbuffyC(:,:,:,1),igp%rbuffzC(:,:,:,1),igp%gpC) + igp%angleHubHeight = p_sum(sum(igp%rbuffzC(:,:,igp%zHubIndex,1))) / & + (real(igp%gpC%xsz(1),rkind) * real(igp%gpC%ysz(2),rkind)) + call transpose_x_to_y(igp%u,igp%rbuffyC(:,:,:,1),igp%gpC) + call transpose_y_to_z(igp%rbuffyC(:,:,:,1),igp%rbuffzC(:,:,:,1),igp%gpC) + call transpose_x_to_y(igp%v,igp%rbuffyC(:,:,:,1),igp%gpC) + call transpose_y_to_z(igp%rbuffyC(:,:,:,1),igp%rbuffzC(:,:,:,2),igp%gpC) + utop = p_sum(sum(igp%rbuffzC(:,:,igp%gpC%zsz(3),1))) / & + (real(igp%gpC%xsz(1),rkind) * real(igp%gpC%ysz(2),rkind)) + vtop = p_sum(sum(igp%rbuffzC(:,:,igp%gpC%zsz(3),2))) / & + (real(igp%gpC%xsz(1),rkind) * real(igp%gpC%ysz(2),rkind)) + speedTop = (utop*utop + vtop*vtop)**0.5 + um = p_sum(sum(igp%rbuffzC(:,:,igp%zHubIndex,1))) / & + (real(igp%gpC%xsz(1),rkind) * real(igp%gpC%ysz(2),rkind)) + vm = p_sum(sum(igp%rbuffzC(:,:,igp%zHubIndex,2))) / & + (real(igp%gpC%xsz(1),rkind) * real(igp%gpC%ysz(2),rkind)) + speedHub = (um*um + vm*vm)**0.5 + igp%angleHubHeight = atan2(vm,um) + + if (mod(igp%step,nt_print2screen) == 0) then + maxDiv = maxval(igp%divergence) + DomMaxDiv = p_maxval(maxDiv) + call message(0,"Time",igp%tsim) + call message(1,"TIDX:",igp%step) + !call message(1,"MaxDiv:",DomMaxDiv) + call message_min_max(1,"Bounds for u:", p_minval(minval(igp%u)), p_maxval(maxval(igp%u))) + call message_min_max(1,"Bounds for v:", p_minval(minval(igp%v)), p_maxval(maxval(igp%v))) + call message_min_max(1,"Bounds for w:", p_minval(minval(igp%w)), p_maxval(maxval(igp%w))) + call message_min_max(1,"Bounds for T:", p_minval(minval(igp%T)), p_maxval(maxval(igp%T))) + call message(1,"u_star:",igp%sgsmodel%get_ustar()) + call message(1,"Inv. Ob. Length:",igp%sgsmodel%get_InvObLength()) + call message(1,"T_surf:",igp%sgsmodel%get_T_surf()) + call message(1,"wTh_surf:",igp%sgsmodel%get_wTh_surf()) + call message(1,"hub angle, degrees:",igp%angleHubHeight * 180.d0/3.14d0) + call message(1,"frameAngle:",igp%frameAngle) + call message(1,"Control w, rad/time:",igp%wFilt) + call message(1,"Control Galpha:", igp%G_alpha) + call message(1,"speed at the top:", speedTop) + call message(1,"u at the top:", utop) + call message(1,"v at the top:", vtop) + call message(1,"speed at the hub:",speedHub) + call message(1,"u at the hub:", um) + call message(1,"v at the hub:", vm) + call message(1,"Hub",igp%zHubIndex) + if (igp%useSGS) then + maxnusgs = p_maxval(igp%nu_SGS) + maxkappasgs = p_maxval(igp%kappaSGS) + call message(1,"Maximum SGS viscosity:", maxnusgs) + call message(1,"Maximum SGS scalar kappa:", maxkappasgs) + if (associated(igp%kappa_bounding)) then + maxkappasgs = p_maxval(igp%kappa_bounding) + call message(1,"Maximum kappa bounding:", maxkappasgs) + end if + if (igp%sgsModel%usingDynProc()) then + call message(1,"Maximum lambda_dynamic:", igp%sgsModel%getMax_DynSmagConst()) + call message(1,"Maximum beta_dynamic:", igp%sgsModel%getMax_DynPrandtl()) + end if + end if + if (igp%useCFL) then + call message(1,"Current dt:",igp%dt) + end if + call message("==========================================================") + call toc() + call tic() + end if + + end subroutine + + +end module diff --git a/problems/incompressible/refine_fields.F90 b/problems/incompressible/refine_fields.F90 new file mode 100644 index 00000000..2ed4b7dd --- /dev/null +++ b/problems/incompressible/refine_fields.F90 @@ -0,0 +1,795 @@ +!=============================================================================== +! Complete example: LES refinement with proper decomp2d integration +! +! This follows the tiling structure but uses spectral interpolation for X-Y +! refinement and physical interpolation for Z refinement. +! +! Structure: +! 1. Read field in X-pencils +! 2. Refine X-Y spectrally (combined operation in Fourier space) +! 3. If refining Z: transpose X→Y→Z, interpolate, transpose back Z→Y→X +! 4. Write refined field +!=============================================================================== + +module refine_fields_mod + use mpi + use exits, only: message, gracefulExit + use kind_parameters, only: rkind, clen + use timer, only: tic, toc + use PadeDerOps, only: Pade6stagg + use spectralMod, only: spectral + use decomp_2d + use decomp_2d_io + use constants, only: zero, half + implicit none + + type(Pade6stagg) :: Pade6opZ + + ! Decomposition info for intermediate grids + ! Following the tiling pattern: original -> upX -> upXY -> upXYZ + ! Cell-centered grids (for u, v, T) + type(decomp_info) :: gpC ! Original coarse grid (cell centers) + type(decomp_info) :: gpC_XY ! Refined in X and Y (cell centers) + type(decomp_info) :: gpC_XYZ ! Refined in X, Y, and Z (cell centers) + + ! Edge-based grids (for w velocity, staggered in z) + type(decomp_info) :: gpE ! Original coarse grid (edges, nz+1) + type(decomp_info) :: gpE_XY ! Refined in X and Y (edges, nz+1) + type(decomp_info) :: gpE_XYZ ! Refined in X, Y, and Z (edges, nz_f+1) + + type(decomp_info) :: decomp_inter_C, decomp_inter_E ! Persistent intermediate decomp + logical :: is_inter_init = .false. + + type(decomp_info), pointer :: Sp_gpC_c, Sp_gpC_XY, Sp_gpE_c, Sp_gpE_XY + type(spectral), target :: spectE_c, spectC_c, spectE_f, spectC_f, spectC_XY, spectE_XY + + ! Intermediate arrays + real(rkind), allocatable :: fxy_inX(:,:,:) ! Refined X-Y, in X-pencils + real(rkind), allocatable :: fxy_inY(:,:,:) ! Refined X-Y, in Y-pencils + real(rkind), allocatable :: fxy_inZ(:,:,:) ! Refined X-Y, in Z-pencils + real(rkind), allocatable :: fxyz_inY(:,:,:) ! Refined X-Y-Z, in Y-pencils + real(rkind), allocatable :: fxyz_inZ(:,:,:) ! Refined X-Y-Z, in Z-pencils + real(rkind), allocatable :: fxyE_inX(:,:,:) ! Refined X-Y, in X-pencils + real(rkind), allocatable :: fxyE_inY(:,:,:) ! Refined X-Y, in Y-pencils + real(rkind), allocatable :: fxyE_inZ(:,:,:) ! Refined X-Y, in Z-pencils + real(rkind), allocatable :: fxyzE_inY(:,:,:) ! Refined X-Y-Z, in Y-pencils + real(rkind), allocatable :: fxyzE_inZ(:,:,:) ! Refined X-Y-Z, in Z-pencils + + complex(rkind), allocatable :: cbuffyC(:,:,:), cbuffzC1(:,:,:), cbuffzC2(:,:,:) + complex(rkind), allocatable :: cbuffyE(:,:,:), cbuffzE1(:,:,:) + + ! Parity flags for ddz + integer :: uBC_bottom, uBC_top, vBC_bottom, vBC_top, wBC_bottom, wBC_top, TBC_bottom, TBC_top, dWdzBC_bottom, dWdzBC_top + + integer :: refine_x=2, refine_y=2, refine_z=1 + logical :: isStratified=.true. + + real(rkind), allocatable :: u_c(:,:,:), v_c(:,:,:), w_c(:,:,:), T_c(:,:,:) + real(rkind), allocatable :: u_f(:,:,:), v_f(:,:,:), w_f(:,:,:), T_f(:,:,:) + + contains + + subroutine write_restart_file(field, outputdir, outputFile_TID, outputFile_RID, name, gp) + implicit none + real(rkind), dimension(:,:,:), intent(in) :: field + character(len=*), intent(in) :: outputdir, name + integer, intent(in) :: outputFile_TID, outputFile_RID + type(decomp_info), intent(in) :: gp + character(len=clen) :: tempname, fname + + write(tempname,"(A7,A4,I2.2,A3,I6.6)") "RESTART", "_Run",outputFile_RID,trim(name),outputFile_TID + fname = trim(outputdir)//"/"//trim(tempname) + call decomp_2d_write_one(1,field,fname, gp) ! write refined fields + end subroutine write_restart_file + + subroutine read_restart_file(field, inputdir, inputFile_TID, inputFile_RID, name, gp) + implicit none + real(rkind), dimension(:,:,:), intent(out) :: field + character(len=*), intent(in) :: inputdir, name + integer, intent(in) :: inputFile_TID, inputFile_RID + type(decomp_info), intent(in) :: gp + character(len=clen) :: tempname, fname + + write(tempname,"(A7,A4,I2.2,A3,I6.6)") "RESTART", "_Run",inputFile_RID,trim(name),inputFile_TID + fname = trim(inputdir)//"/"//trim(tempname) + call decomp_2d_read_one(1,field,fname, gp) ! read original fields + end subroutine read_restart_file + + subroutine get_boundary_conditions_stencil(botWall, TopWall, botBC_Temp, topBC_Temp) + implicit none + integer, intent(in) :: botWall, TopWall, topBC_Temp, botBC_Temp + + wBC_bottom = -1; wBC_top = -1 + uBC_bottom = 0; uBC_top = 1 + vBC_bottom = 0; vBC_top = 1 + TBC_bottom = 1; TBC_top = 0 + dWdzBC_bottom = 0; dWdzBC_top = 0 + + !! Bottom wall + call message(0,"Bottom Wall Boundary Condition is:") + select case (botWall) + case(1) + call message(1,"No-Slip Wall") + ! NOTE: no-slip wall requires both w = 0 and dwdz = 0. Therefore, w + ! is an even extension, which also satisfies w = 0. + uBC_bottom = 0 + vBC_bottom = 0 + wBC_bottom = 1 + dwdzBC_bottom = -1 + case(2) + call message(1,"Slip Wall") + uBC_bottom = 1 + vBC_bottom = 1 + case(3) + call message(1,"Wall Model") + uBC_bottom = 0 + vBC_bottom = 0 + case default + call gracefulExit("Invalid choice for BOTTOM WALL BCs",423) + end select + + !! Top wall + call message(0,"Top Wall Boundary Condition is:") + select case (TopWall) + case(1) + call message(1,"No-Slip Wall") + ! NOTE: no-slip wall requires both w = 0 and dwdz = 0. Therefore, w + ! is an even extension, which also satisfies w = 0. + uBC_top = 0 + vBC_top = 0 + wBC_top = 1 + dwdzBC_top = -1 + case(2) + call message(1,"Slip Wall") + uBC_top = 1 + vBC_top = 1 + case(3) + call message(1,"Wall Model") + uBC_top = 0 + vBC_top = 0 + case default + call gracefulExit("Invalid choice for TOP WALL BCs",13) + end select + + !! Temperature + select case (topBC_Temp) + case(0) ! Dirichlet (default) + TBC_top = 0 + case(1) + TBC_top = 1 + case (2) ! Inhomogeneous Neumann BC for temperature at the top + TBC_top = 0 + case (3) + TBC_top = 0 + end select + select case (botBC_Temp) + case (0) ! Dirichlet BC for temperature at the bottom + TBC_bottom = 0 + case(1) ! Homogenenous Neumann BC at the bottom + TBC_bottom = 1 + case (2) ! Inhomogeneous Neumann BC for temperature at the bottom + TBC_bottom = 0 + case (3) + TBC_bottom = 0 + end select + + end subroutine get_boundary_conditions_stencil + + !----------------------------------------------------------------------------- + ! Refine a single field + ! 1. Refine X-Y spectrally (combined operation) + ! 2. If refining Z: transpose, interpolate, transpose back + ! Optional: handle staggered grids in z-direction + !----------------------------------------------------------------------------- + subroutine refine_single_field(field_c, field_f, dz, n1, n2) + implicit none + + real(rkind), dimension(:,:,:), intent(in) :: field_c + real(rkind), dimension(:,:,:), intent(out) :: field_f + real(rkind), intent(in) :: dz + integer, intent(in) :: n1, n2 + + ! Step 1: Horizontal refinement (X-Y) using spectral interpolation + call refine_horizontally(field_c, fxy_inX, spectC_c, spectC_f, decomp_inter_C) + + ! Step 2: Handle Z-refinement if needed + if (refine_z > 1) then + + call transpose_x_to_y(fxy_inX, fxy_inY, gpC_XY) + call transpose_y_to_z(fxy_inY, fxy_inZ, gpC_XY) + call refine_z_physical(fxy_inZ, fxyz_inZ, dz, .false., n1, n2) + call transpose_z_to_y(fxyz_inZ, fxyz_inY, gpC_XYZ) + call transpose_y_to_x(fxyz_inY, field_f, gpC_XYZ) + + else + field_f(:,:,:) = fxy_inX(:,:,:) + end if + + end subroutine refine_single_field + + subroutine refine_single_fieldE(field_c, field_f, dz, n1, n2, n3, n4) + implicit none + + real(rkind), dimension(:,:,:), intent(in) :: field_c + real(rkind), dimension(:,:,:), intent(out) :: field_f + real(rkind), intent(in) :: dz + integer, intent(in) :: n1, n2, n3, n4 + + ! Step 1: Horizontal refinement (X-Y) using spectral interpolation + call refine_horizontally(field_c, fxyE_inX, spectE_c, spectE_f, decomp_inter_E) + + ! Step 2: Handle Z-refinement if needed + if (refine_z > 1) then + call transpose_x_to_y(fxyE_inX, fxyE_inY, gpE_XY) + call transpose_y_to_z(fxyE_inY, fxyE_inZ, gpE_XY) + call refine_z_physical(fxyE_inZ, fxyzE_inZ, dz, .true., n1, n2, n3=n3, n4=n4) + call transpose_z_to_y(fxyzE_inZ, fxyzE_inY, gpE_XYZ) + call transpose_y_to_x(fxyzE_inY, field_f, gpE_XYZ) + else + field_f(:,:,:) = fxyE_inX(:,:,:) + end if + + end subroutine refine_single_fieldE + + subroutine refine_horizontally(field_c, field_f, spect_c, spect_f, decomp_inter) + implicit none + + ! Arguments + real(rkind), intent(in) :: field_c(:,:,:) ! Coarse Physical (X-pencil) + real(rkind), intent(out) :: field_f(:,:,:) ! Fine Physical (X-pencil) + type(spectral), intent(inout) :: spect_c + type(spectral), intent(inout) :: spect_f + type(decomp_info), intent(inout) :: decomp_inter + + ! Internal Complex Buffers + complex(rkind), allocatable :: hat_c_yp(:,:,:) ! Coarse Y-pencil + complex(rkind), allocatable :: hat_i_yp(:,:,:) ! Intermediate Y-pencil (Fine Y, Coarse X) + complex(rkind), allocatable :: hat_i_xp(:,:,:) ! Intermediate X-pencil (Fine Y, Coarse X) + complex(rkind), allocatable :: hat_f_xp(:,:,:) ! Fine X-pencil (Fine Y, Fine X) + complex(rkind), allocatable :: hat_f_yp(:,:,:) ! Fine Y-pencil (Fine Y, Fine X) + + integer :: nxc_g, nyc_g, nxf_g, nyf_g, nzc_g + integer :: nxc_hat + real(rkind) :: scale + integer :: ky_nyq_c, kx_nyq_c, ky_neg_start_f + + nxc_g = spect_c%nx_g ; nyc_g = spect_c%ny_g ; nzc_g = spect_c%nz_g + nxf_g = spect_f%nx_g ; nyf_g = spect_f%ny_g + nxc_hat = nxc_g/2 + 1 + + !=============================================================== + ! SAFEGUARDS (single place, integer-only checks) + !=============================================================== + ! Rationale: + ! - This routine assumes a “slab-like” process grid where: + ! * y-pencils cover the full global y-range locally (ysz(2) == Ny) + ! * x-pencils cover the full global kx-range locally (xsz(1) == Nx_hat) + ! - It also assumes we can local-copy hat_i_xp -> hat_f_xp, which requires + ! the y/z partitioning (in x-pencil layout) to match between decomp_inter + ! and spect_f%spectdecomp. + ! + ! If any of these assumptions are violated, + ! this routine must fall back to global-index mapping instead of local slices, + ! which is not currently implemented. + !=============================================================== + + !----------------------------- + ! (A) Full-y slabs in y-pencils + !----------------------------- + if (spect_c%spectdecomp%ysz(2) /= spect_c%ny_g)& + call gracefulExit("spect_c does not have full-y in y-pencils.", 001) + + if (spect_f%spectdecomp%ysz(2) /= spect_f%ny_g)& + call gracefulExit("spect_f does not have full-y in y-pencils.", 002) + + !-------------------------------------------- + ! (B) Full-kx slabs in x-pencils for padding + !-------------------------------------------- + ! Intermediate x-pencil should contain full kx = 1..nxc_hat locally + ! where nxc_hat = nx_c/2 + 1 + if (decomp_inter%xsz(1) /= (spect_c%nx_g/2 + 1))& + call gracefulExit("Intermediate decomposition does not have full-kx in x-pencils.", 003) + + ! Fine x-pencil should contain full kx = 1..nx_f/2+1 locally + ! (not strictly required for the copy of only 1:nxc_hat, but it is the + ! assumption behind using local indices without global mapping) + if (spect_f%spectdecomp%xsz(1) /= (spect_f%nx_g/2 + 1))& + call gracefulExit("Fine decomposition does not have full-kx in x-pencils.", 004) + + !--------------------------------------------------------- + ! (C) X-pencil y/z partition must match for local copy + ! hat_f_xp(1:nxc_hat,:,:) = hat_i_xp(1:nxc_hat,:,:) + !--------------------------------------------------------- + if (decomp_inter%xsz(2) /= spect_f%spectdecomp%xsz(2))& + call gracefulExit("Intermediate decomposition y-size in x-pencils does not match fine decomposition.", 005) + + if (decomp_inter%xsz(3) /= spect_f%spectdecomp%xsz(3))& + call gracefulExit("Intermediate decomposition z-size in x-pencils does not match fine decomposition.", 006) + + if (decomp_inter%xst(2) /= spect_f%spectdecomp%xst(2))& + call gracefulExit("Intermediate decomposition y-start in x-pencils does not match fine decomposition.", 007) + + if (decomp_inter%xst(3) /= spect_f%spectdecomp%xst(3))& + call gracefulExit("Intermediate decomposition z-start in x-pencils does not match fine decomposition.", 008) + + if (decomp_inter%xen(2) /= spect_f%spectdecomp%xen(2))& + call gracefulExit("Intermediate decomposition y-end in x-pencils does not match fine decomposition.", 009) + + if (decomp_inter%xen(3) /= spect_f%spectdecomp%xen(3))& + call gracefulExit("Intermediate decomposition z-end in x-pencils does not match fine decomposition.", 010) + + ! 1. Forward FFT -> Result in Y-pencil + allocate(hat_c_yp(spect_c%spectdecomp%ysz(1), spect_c%spectdecomp%ysz(2), spect_c%spectdecomp%ysz(3))) + if (size(hat_c_yp,2) /= nyc_g) call GracefulExit("hat_c_yp does not contain full y locally", 011) + call spect_c%fft(field_c, hat_c_yp) + + ! 2. Pad Y-direction locally (Intermediate Y-pencil) + allocate(hat_i_yp(decomp_inter%ysz(1), decomp_inter%ysz(2), decomp_inter%ysz(3))) + if (size(hat_i_yp,2) /= nyf_g) call GracefulExit("hat_i_yp does not contain full y locally", 012) + hat_i_yp = (zero, zero) + + ky_nyq_c = nyc_g/2 + 1 ! coarse Nyquist index (+Ny/2) + ky_neg_start_f = nyf_g - (nyc_g/2 - 1) + 1 ! = nyf_g - nyc_g/2 + 2 + + ! ky = 0 .. +Ny/2 (includes Nyquist) + hat_i_yp(:, 1:ky_nyq_c, :) = hat_c_yp(:, 1:ky_nyq_c, :) + + ! ky = -Ny/2+1 .. -1 + hat_i_yp(:, ky_neg_start_f:nyf_g, :) = hat_c_yp(:, ky_nyq_c+1:nyc_g, :) + + ! 3. Transpose to X-pencil to handle X-padding locally + allocate(hat_i_xp(decomp_inter%xsz(1), decomp_inter%xsz(2), decomp_inter%xsz(3))) + call transpose_y_to_x(hat_i_yp, hat_i_xp, decomp_inter) + + ! 4. Pad X-direction locally (Fine X-pencil) + ! No halving here! R2C IFFT handles the symmetry automatically. + allocate(hat_f_xp(spect_f%spectdecomp%xsz(1), spect_f%spectdecomp%xsz(2), spect_f%spectdecomp%xsz(3))) + if(size(hat_i_xp,2) /= size(hat_f_xp,2)) call gracefulExit("xp y-size mismatch", 701) + if(size(hat_i_xp,3) /= size(hat_f_xp,3)) call gracefulExit("xp z-size mismatch", 702) + + hat_f_xp = (zero, zero) + kx_nyq_c = nxc_g/2 + 1 ! = nxc_hat + + ! 1) Copy all modes including the coarse Nyquist plane at index kx_nyq_c + ! We enforce real on the Nyquist plane for consistency. + hat_f_xp(1:kx_nyq_c-1, :, :) = hat_i_xp(1:kx_nyq_c-1, :, :) + hat_f_xp(kx_nyq_c, :, :) = cmplx(real(hat_i_xp(kx_nyq_c, :, :), rkind), zero, kind=rkind) + + ! 5. Scaling + scale = (real(nxf_g, rkind)/real(nxc_g, rkind)) * (real(nyf_g, rkind)/real(nyc_g, rkind)) + hat_f_xp = hat_f_xp * scale + + ! 6. Transpose Fine X-pencil back to Fine Y-pencil for the IFFT + allocate(hat_f_yp(spect_f%spectdecomp%ysz(1), spect_f%spectdecomp%ysz(2), spect_f%spectdecomp%ysz(3))) + call transpose_x_to_y(hat_f_xp, hat_f_yp, spect_f%spectdecomp) + + ! 7. Inverse FFT (Fine Y-pencil to Fine X-physical) + call spect_f%ifft(hat_f_yp, field_f) + + ! Cleanup + deallocate(hat_c_yp, hat_i_yp, hat_i_xp, hat_f_xp, hat_f_yp) + + end subroutine refine_horizontally + + subroutine refine_z_physical(field_c, field_f, dz_c, staggered, bottom_flag, top_flag, n3, n4) + !--------------------------------------------------------------------------- + ! Vertical refinement in physical z. + ! + ! - If staggered=.true. (edge nodes): nz_f = nz_c*refine_z, nodes are nz+1. + ! -> pure interval refinement (no extrapolation needed); Hermite everywhere + ! with exact top node copy. + ! + ! - If staggered=.false. (cell centres): nz_f = nz_c*refine_z, nodes are nz. + ! -> fine centres extend +/- (dz_c - dz_f)/2 beyond coarse-centre set. + ! We therefore: + ! * use one-sided Taylor extrapolation for boundary fine centres that + ! lie outside [z_c(1), z_c(nz_c)] + ! * use cubic Hermite in the interior + ! + ! Uses coarse physical gradient computed by: + ! call ddz_R2R(f, dfdz, bottom_flag, top_flag) + ! where dfdz is in physical units (per metre). + !--------------------------------------------------------------------------- + + implicit none + logical, intent(in) :: staggered + real(rkind), intent(in) :: dz_c + integer, intent(in) :: bottom_flag, top_flag + integer, intent(in), optional :: n3, n4 ! optional arguments for staggered fields (w) + + real(rkind), intent(in) :: field_c(:,:,:) ! coarse (centres or edges) + real(rkind), intent(out) :: field_f(:,:,:) ! fine (centres or edges) + + integer :: nx, ny + integer :: nz3_c, nz3_f + integer :: nz_c, nz_f + integer :: nz_nodes_c, nz_nodes_f + integer :: i, j, kf, kc + integer :: q, s + real(rkind) :: t + real(rkind) :: f0, f1, m0, m1 + real(rkind) :: h00, h10, h01, h11 + real(rkind) :: dz_f + real(rkind) :: zc1, zcN, zf + real(rkind) :: z0, fbc, mbc + real(rkind), allocatable :: dfdz_c(:,:,:) + integer :: n3_, n4_ + + nx = size(field_c,1) + ny = size(field_c,2) + nz3_c = size(field_c,3) + nz3_f = size(field_f,3) + + if (refine_z < 1) call GracefulExit("refine_z_physical: refine_z must be >= 1", 801) + dz_f = dz_c / real(refine_z, rkind) + + if (staggered) then + ! edges: field has nz+1 nodes + nz_c = nz3_c - 1 + if (nz_c < 1) call GracefulExit("refine_z_physical: staggered needs >=2 edge nodes", 802) + + nz_f = nz_c * refine_z + if (nz3_f /= nz_f + 1) call GracefulExit("refine_z_physical: fine staggered must be nz_f+1", 803) + + else + ! centres: field has nz nodes + nz_c = nz3_c + if (nz_c < 2) call GracefulExit("refine_z_physical: centred needs >=2 nodes", 804) + + nz_f = nz_c * refine_z + if (nz3_f /= nz_f) call GracefulExit("refine_z_physical: fine centred must be nz_f", 805) + end if + + nz_nodes_c = nz3_c + nz_nodes_f = nz3_f + + ! Coarse physical gradient at the same nodes as field_c + allocate(dfdz_c(nx, ny, nz_nodes_c)) + if(staggered)then + if(present(n3) .and. present(n4)) then + n3_ = n3 + n4_ = n4 + else + n3_ = 0 + n4_ = 0 + end if + call ddz_Edge(field_c, dfdz_c, bottom_flag, top_flag, n3_, n4_) + else + call ddz_Cell(field_c, dfdz_c, bottom_flag, top_flag) + end if + + !--------------------------------------------------------------------------- + ! Precompute coarse-centre bounds only needed for cell-centred extrapolation. + ! For centres: z_c(k) = (k-0.5)*dz_c + ! For edges: not used (edges nest exactly by construction) + !--------------------------------------------------------------------------- + if (.not. staggered) then + zc1 = 0.5_rkind * dz_c + zcN = (real(nz_c, rkind) - 0.5_rkind) * dz_c + end if + + do kf = 1, nz_nodes_f + + if (.not. staggered) then + ! Fine-centre physical location: z_f = (kf-0.5)*dz_f + zf = (real(kf, rkind) - 0.5_rkind) * dz_f + + !--------------------------- + ! Bottom one-sided extrapolation + !--------------------------- + if (zf < zc1) then + z0 = zc1 + do j = 1, ny + do i = 1, nx + fbc = field_c(i,j,1) + mbc = dfdz_c (i,j,1) + field_f(i,j,kf) = fbc + (zf - z0) * mbc + end do + end do + cycle + end if + + !--------------------------- + ! Top one-sided extrapolation + !--------------------------- + if (zf > zcN) then + z0 = zcN + do j = 1, ny + do i = 1, nx + fbc = field_c(i,j,nz_c) + mbc = dfdz_c (i,j,nz_c) + field_f(i,j,kf) = fbc + (zf - z0) * mbc + end do + end do + cycle + end if + end if + + !----------------------------------------------------------------------- + ! Interior mapping (Hermite) using integer quotient+remainder: + ! q = coarse interval index (0-based) + ! s = sub-index within interval (0..refine_z-1) + ! kc = left coarse node index (1-based) + ! t = s/refine_z in [0,1) + !----------------------------------------------------------------------- + q = (kf - 1) / refine_z + s = (kf - 1) - q*refine_z + + if (staggered) then + ! For edges, the very top fine node maps exactly to last coarse node. + if (q >= nz_c) then + do j = 1, ny + do i = 1, nx + field_f(i,j,kf) = field_c(i,j,nz_nodes_c) + end do + end do + cycle + end if + else + ! For centres, we are guaranteed here to be inside [z_c(1), z_c(nz_c)]. + ! Clamp q so kc+1 is safe. + if (q > nz_c - 2) q = nz_c - 2 + end if + + kc = q + 1 + t = real(s, rkind) / real(refine_z, rkind) + + ! Hermite basis + h00 = 2.0_rkind*t*t*t - 3.0_rkind*t*t + 1.0_rkind + h10 = t*t*t - 2.0_rkind*t*t + t + h01 = -2.0_rkind*t*t*t + 3.0_rkind*t*t + h11 = t*t*t - t*t + + do j = 1, ny + do i = 1, nx + f0 = field_c(i,j,kc) + f1 = field_c(i,j,kc+1) + m0 = dfdz_c (i,j,kc) + m1 = dfdz_c (i,j,kc+1) + + field_f(i,j,kf) = h00*f0 + h10*(dz_c*m0) + h01*f1 + h11*(dz_c*m1) + end do + end do + + end do + + deallocate(dfdz_c) + + end subroutine refine_z_physical + + subroutine initializeEverything(Lx, Ly, Lz, nx, ny, nz, p_row, p_col, & + NumericalSchemeVert, botWall, TopWall, botBC_Temp, topBC_Temp) + implicit none + real(rkind), intent(in) :: Lx, Ly, Lz + integer, intent(in) :: nx, ny, nz, p_row, p_col + integer, intent(in) :: NumericalSchemeVert, botWall, TopWall, botBC_Temp, topBC_Temp + integer :: nx_f, ny_f, nz_f + real(rkind) :: dx, dy, dz + + ! Make sure nx, ny are even for spectral refinement + if (mod(nx, 2) /= 0) call gracefulExit("nx must be even for spectral refinement.", 101) + if (mod(ny, 2) /= 0) call gracefulExit("ny must be even for spectral refinement.", 102) + + ! Calculate refined grid sizes + nx_f = nx * refine_x + ny_f = ny * refine_y + nz_f = nz * refine_z + + !----------------------------------------------------------------------------- + ! Initialize decomp2d for the original (coarse) grid + !----------------------------------------------------------------------------- + call decomp_2d_init(nx, ny, nz, p_row, p_col) + + ! Get local decomposition info for array allocation + ! Cell-centered grids + call decomp_info_init(nx, ny, nz, gpC) + call decomp_info_init(nx_f, ny_f, nz, gpC_XY) + call decomp_info_init(nx_f, ny_f, nz_f, gpC_XYZ) + + ! Edge grids (for staggered w) + call decomp_info_init(nx, ny, nz+1, gpE) + call decomp_info_init(nx_f, ny_f, nz+1, gpE_XY) + call decomp_info_init(nx_f, ny_f, nz_f+1, gpE_XYZ) + + call decomp_info_init(nx/2 + 1, ny_f, nz, decomp_inter_C) + call decomp_info_init(nx/2 + 1, ny_f, nz+1, decomp_inter_E) + is_inter_init = .true. + + ! Initialize spectral + dx = Lx/real(nx,rkind); dy = Ly/real(ny,rkind); dz = Lz/real(nz,rkind) + call spectC_c%init("x",nx,ny,nz, dx, dy,dz,"FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + call spectE_c%init("x",nx,ny,nz + 1,dx,dy,dz,"FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + + sp_gpC_c => spectC_c%spectdecomp + sp_gpE_c => spectE_c%spectdecomp + + ! Initialize spectral for fine grid + dx = Lx/real(nx_f,rkind); dy = Ly/real(ny_f,rkind); dz = Lz/real(nz_f,rkind) + call spectC_f%init("x",nx_f,ny_f,nz_f, dx, dy,dz,"FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + call spectE_f%init("x",nx_f,ny_f,nz_f + 1,dx,dy,dz,"FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + + ! Initialize spectral for horizontally fine grid but still coarse in z + dx = Lx/real(nx_f,rkind); dy = Ly/real(ny_f,rkind); dz = Lz/real(nz,rkind) + call spectC_XY%init("x",nx_f,ny_f,nz, dx, dy,dz,"FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + call spectE_XY%init("x",nx_f,ny_f,nz + 1,dx,dy,dz,"FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + sp_gpC_XY => spectC_XY%spectdecomp + sp_gpE_XY => spectE_XY%spectdecomp + + ! PadeOps + call Pade6opz%init(gpC_XY, sp_gpC_XY, gpE_XY, sp_gpE_XY, dz, NumericalSchemeVert,.false., spectC_XY) + + allocate(cbuffyC(sp_gpC_XY%ysz(1),sp_gpC_XY%ysz(2),sp_gpC_XY%ysz(3))) + allocate(cbuffyE(sp_gpE_XY%ysz(1),sp_gpE_XY%ysz(2),sp_gpE_XY%ysz(3))) + allocate(cbuffzC1(sp_gpC_XY%zsz(1),sp_gpC_XY%zsz(2),sp_gpC_XY%zsz(3))) + allocate(cbuffzC2(sp_gpC_XY%zsz(1),sp_gpC_XY%zsz(2),sp_gpC_XY%zsz(3))) + allocate(cbuffzE1(sp_gpE_XY%zsz(1),sp_gpE_XY%zsz(2),sp_gpE_XY%zsz(3))) + + ! BC Stencils + call get_boundary_conditions_stencil(botWall, TopWall, botBC_Temp, topBC_Temp) + + ! Allocations + ! ------------- + ! Coarse grid arrays + allocate(u_c(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3))) + allocate(v_c(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3))) + allocate(w_c(gpE%xsz(1),gpE%xsz(2),gpE%xsz(3))) + + ! Fine grid arrays (cell-centered) + allocate(u_f(gpC_XYZ%xsz(1),gpC_XYZ%xsz(2),gpC_XYZ%xsz(3))) + allocate(v_f(gpC_XYZ%xsz(1),gpC_XYZ%xsz(2),gpC_XYZ%xsz(3))) + allocate(w_f(gpE_XYZ%xsz(1),gpE_XYZ%xsz(2),gpE_XYZ%xsz(3))) + + if(isStratified)then + allocate(T_c(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3))) + allocate(T_f(gpC_XYZ%xsz(1),gpC_XYZ%xsz(2),gpC_XYZ%xsz(3))) + end if + + ! Horizontally refined + allocate(fxy_inX(gpC_XY%xsz(1), gpC_XY%xsz(2), gpC_XY%xsz(3))) + allocate(fxy_inY(gpC_XY%ysz(1), gpC_XY%ysz(2), gpC_XY%ysz(3))) + allocate(fxy_inZ(gpC_XY%zsz(1), gpC_XY%zsz(2), gpC_XY%zsz(3))) + allocate(fxyE_inX(gpE_XY%xsz(1), gpE_XY%xsz(2), gpE_XY%xsz(3))) + allocate(fxyE_inY(gpE_XY%ysz(1), gpE_XY%ysz(2), gpE_XY%ysz(3))) + allocate(fxyE_inZ(gpE_XY%zsz(1), gpE_XY%zsz(2), gpE_XY%zsz(3))) + + ! Fully refined + allocate(fxyz_inY(gpC_XYZ%ysz(1), gpC_XYZ%ysz(2), gpC_XYZ%ysz(3))) + allocate(fxyz_inZ(gpC_XYZ%zsz(1), gpC_XYZ%zsz(2), gpC_XYZ%zsz(3))) + allocate(fxyzE_inY(gpE_XYZ%ysz(1), gpE_XYZ%ysz(2), gpE_XYZ%ysz(3))) + allocate(fxyzE_inZ(gpE_XYZ%zsz(1), gpE_XYZ%zsz(2), gpE_XYZ%zsz(3))) + + end subroutine initializeEverything + + subroutine cleanup() + implicit none + + deallocate(u_c, v_c, w_c) + deallocate(u_f, v_f, w_f) + if (allocated(T_c)) deallocate(T_c) + if (allocated(T_f)) deallocate(T_f) + + deallocate(cbuffyC, cbuffyE, cbuffzC1, cbuffzC2, cbuffzE1) + deallocate(fxy_inX, fxy_inY, fxy_inZ) + deallocate(fxyE_inX, fxyE_inY, fxyE_inZ) + deallocate(fxyz_inY, fxyz_inZ) + deallocate(fxyzE_inY, fxyzE_inZ) + + call spectC_c%destroy() + call spectE_c%destroy() + call spectC_f%destroy() + call spectE_f%destroy() + call spectC_XY%destroy() + call spectE_XY%destroy() + call Pade6opZ%destroy() + + ! Cell-centered grids + call decomp_info_finalize(gpC) + call decomp_info_finalize(gpC_XY) + call decomp_info_finalize(gpC_XYZ) + + ! Edge-based grids + call decomp_info_finalize(gpE) + call decomp_info_finalize(gpE_XY) + call decomp_info_finalize(gpE_XYZ) + + if (is_inter_init)then + call decomp_info_finalize(decomp_inter_C) + call decomp_info_finalize(decomp_inter_E) + end if + + call decomp_2d_finalize() + end subroutine + + subroutine ddz_Cell(f, dfdz, n1, n2) + implicit none + real(rkind), dimension(:,:,:), intent(in) :: f + real(rkind), dimension(:,:,:), intent(out) :: dfdz + integer, intent(in) :: n1, n2 + + call spectC_XY%fft(f, cbuffyC) + call transpose_y_to_z(cbuffyC, cbuffzC1, spectC_XY%spectdecomp) + call Pade6opZ%ddz_C2C(cbuffzC1, cbuffzC2, n1, n2) + call transpose_z_to_y(cbuffzC2, cbuffyC, spectC_XY%spectdecomp) + call spectC_XY%dealias(cbuffyC) + call spectC_XY%ifft(cbuffyC, dfdz) + end subroutine + + subroutine ddz_Edge(f, dfdz, n1, n2, n3, n4) + implicit none + real(rkind), dimension(:,:,:), intent(in) :: f + real(rkind), dimension(:,:,:), intent(out) :: dfdz + integer, intent(in) :: n1, n2, n3, n4 + + call spectE_XY%fft(f, cbuffyE) + call transpose_y_to_z(cbuffyE, cbuffzE1, spectE_XY%spectdecomp) + call Pade6opZ%ddz_E2C(cbuffzE1, cbuffzC1, n1, n2) + call Pade6opZ%interpz_C2E(cbuffzC1, cbuffzE1, n3, n4) + call transpose_z_to_y(cbuffzE1, cbuffyE, spectE_XY%spectdecomp) + call spectE_XY%ifft(cbuffyE, dfdz) + end subroutine + +end module refine_fields_mod + +program refine_fields + use refine_fields_mod + implicit none + + ! Grid parameters + integer :: nx, ny, nz + integer :: ierr, ioUnit, p_row=0, p_col=0 + real(rkind) :: Lx, Ly, Lz, dz + character(len=clen) :: inputfile + character(len=clen) :: outputdir, inputdir + integer :: inputFile_TID, inputFile_RID, outputFile_TID, outputFile_RID + integer :: botWall, TopWall, botBC_Temp, topBC_Temp + integer :: NumericalSchemeVert=1 + + namelist /INPUT/ Lx, Ly, Lz, nx, ny, nz, refine_x, refine_y, refine_z, & + inputdir, outputdir, inputFile_TID, inputFile_RID, & + outputFile_TID, outputFile_RID, isStratified, p_row, p_col, & + NumericalSchemeVert, botWall, TopWall, botBC_Temp, topBC_Temp + + call MPI_Init(ierr) !<-- Begin MPI + call GETARG(1,inputfile) !<-- Get the location of the input file + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=INPUT) + close(ioUnit) + + dz = Lz / real(nz, rkind) + + call initializeEverything(Lx, Ly, Lz, nx, ny, nz, p_row, p_col, & + NumericalSchemeVert, botWall, TopWall, botBC_Temp, topBC_Temp) + + !---------------------------------------------------------- + ! Read coarse fields from restart files (in X-pencils) + !---------------------------------------------------------- + call read_restart_file(u_c, inputdir, inputFile_TID, inputFile_RID, '_u.', gpC) + call read_restart_file(v_c, inputdir, inputFile_TID, inputFile_RID, '_v.', gpC) + call read_restart_file(w_c, inputdir, inputFile_TID, inputFile_RID, '_w.', gpE) + if(isStratified)then + call read_restart_file(T_c, inputdir, inputFile_TID, inputFile_RID, '_T.', gpC) + end if + + ! Refine cell-centered fields (u, v, T) + call refine_single_field(u_c, u_f, dz, uBC_bottom, uBC_top) + call refine_single_field(v_c, v_f, dz, vBC_bottom, vBC_top) + if(isStratified)call refine_single_field(T_c, T_f, dz, TBC_bottom, TBC_top) + + ! Refine w velocity (staggered in z) + call refine_single_fieldE(w_c, w_f, dz, wBC_bottom, wBC_top, dwdzBC_bottom, dwdzBC_top) + + ! Dump to file + call write_restart_file(u_f, outputdir, outputFile_TID, outputFile_RID, '_u.', gpC_XYZ) + call write_restart_file(v_f, outputdir, outputFile_TID, outputFile_RID, '_v.', gpC_XYZ) + call write_restart_file(w_f, outputdir, outputFile_TID, outputFile_RID, '_w.', gpE_XYZ) + if(isStratified)then + call write_restart_file(T_f, outputdir, outputFile_TID, outputFile_RID, '_T.', gpC_XYZ) + end if + + ! Clean up and finalize MPI + call cleanup() + call MPI_FINALIZE(ierr) + +end program refine_fields \ No newline at end of file diff --git a/problems/incompressible/refine_fields_files/input.dat b/problems/incompressible/refine_fields_files/input.dat new file mode 100644 index 00000000..e69de29b diff --git a/problems/incompressible/tile_fields.F90 b/problems/incompressible/tile_fields.F90 index c591f536..195e0cb2 100644 --- a/problems/incompressible/tile_fields.F90 +++ b/problems/incompressible/tile_fields.F90 @@ -160,11 +160,11 @@ program tileFields real(rkind) :: tsim, frameangle=zero, pfact=1e-2 ! small potential temp perturbations character(len=clen) :: tempname, fname character(len=clen), dimension(3) :: keys - keys = [character(len=clen) :: "_u.", "_v.", "_T."] !<-- cell-centered field names - namelist /INPUT/ nx, ny, nz, ntile_x, ntile_y, ntile_z, & inputdir, outputdir, inputFile_TID, inputFile_RID, & - outputFile_TID, outputFile_RID, isStratified, PeriodicInZ, pfact + outputFile_TID, outputFile_RID, isStratified, PeriodicInZ, pfact\ + + keys = [character(len=clen) :: "_u.", "_v.", "_T."] !<-- cell-centered field names call MPI_Init(ierr) !<-- Begin MPI call GETARG(1,inputfile) !<-- Get the location of the input file diff --git a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 new file mode 100644 index 00000000..78d62471 --- /dev/null +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 @@ -0,0 +1,1527 @@ +module constructDeficitBudgets_mod + use mpi + use exits, only: message, gracefulExit + use constants, only: one, two, zero, half + use kind_parameters, only: rkind, clen + use timer, only: tic, toc + use PadeDerOps, only: Pade6stagg + use spectralMod, only: spectral + use decomp_2d + use decomp_2d_io + + implicit none + + external :: mpi_allreduce + + character(len=clen) :: inputdir, outputdir, tag='notag' + real(rkind) :: Lx = one, Ly = one, Lz = one + integer :: botWall=3, topWall=2, botBC_temp=0 + logical :: PeriodicInZ=.false. + type(spectral), target :: spectE, spectC + type(decomp_info) :: gpC, gpE + type(decomp_info), pointer :: sp_gpC, sp_gpE + type(Pade6stagg) :: Pade6opZ + real(rkind) :: dx, dy, dz + real(rkind), dimension(:,:), allocatable, target :: profiles + real(rkind), dimension(:,:,:,:), allocatable, target :: mesh, Budget0, Budget1, Budget2, Budget3, duidxj, baseBudget0, duidxj_base + real(rkind), dimension(:,:,:,:), allocatable, target :: rbuffxC + complex(rkind), dimension(:,:,:), allocatable :: cbuffyC + complex(rkind), dimension(:,:,:,:), allocatable, target :: cbuffzC + integer :: prow=0, pcol=0, nx, ny, nz, RID, BRID, NumericalSchemeVert=1 + integer :: startIDX=-1, endIDX=999999 + integer :: uBC_bottom, uBC_top, vBC_bottom, vBC_top, wBC_bottom, wBC_top + integer :: nx_box, ix1g, ix2g + real(rkind) :: x1=zero, x2=zero, y1=zero, y2=zero, z1=zero, z2=zero + integer :: num_profiles + real(rkind), dimension(:), allocatable :: xstations + logical :: writeDependentVariables = .false. + integer :: budgettype=1 ! 1: x-Momentum, 2: y-Momentum, 3: z-Momentum, 4: TKE + real(rkind), dimension(:,:,:), pointer :: dudx, dudy, dudz + real(rkind), dimension(:,:,:), pointer :: dvdx, dvdy, dvdz + real(rkind), dimension(:,:,:), pointer :: dwdx, dwdy, dwdz + real(rkind), dimension(:,:,:), pointer :: dudx_base, dudy_base, dudz_base + real(rkind), dimension(:,:,:), pointer :: dvdx_base, dvdy_base, dvdz_base + real(rkind), dimension(:,:,:), pointer :: dwdx_base, dwdy_base, dwdz_base + character(len=:), allocatable :: sorted_keys(:), sorted_stamps(:) + logical :: do_box_averaging=.true. + + contains + + subroutine export_csv(key, stamp) + implicit none + character(len=*), intent(in) :: key, stamp + character(clen) :: filename + character(len=3) :: crid, tid + integer :: i, j + integer :: nx, ny + integer :: unit + character(len=3) :: name + + nx = size(profiles, 1) + ny = size(profiles, 2) + unit =1045 + + select case(budgettype) + case(1) + name = 'X' + case(2) + name = 'Y' + case(3) + name = 'Z' + case(4) + name = 'TKE' + end select + + write(crid, '(I2.2)') RID + filename = trim(outputdir)//'/Run'//trim(crid)//'_t'//trim(key)//'_n'//trim(stamp)//'_'//trim(name)//'_Budgets_XProfile_'//trim(tag)//'.csv' + + call message(1, 'Exporting profiles to '//trim(filename)) + + ! Open file + open(newunit=unit, file=filename, status='replace', action='write', form='formatted') + + write(unit, '(A1,",")', advance='no') 'x' + do j = 1, ny + write(tid, '(I3.3)') j + if (j < ny) then + write(unit, '(A,",")', advance='no') 'T'//trim(tid) + else + write(unit, '(A)') 'T'//trim(tid) + end if + end do + + ! Write data row by row + do i = 1, nx + write(unit, '(ES16.8,",")', advance='no') xstations(i) + do j = 1, ny + if (j < ny) then + write(unit, '(ES16.8,",")', advance='no') profiles(i,j) + else + write(unit, '(ES16.8)') profiles(i,j) + end if + end do + end do + + close(unit) + end subroutine export_csv + + subroutine dump_budget_field(field, fieldID, BudgetID, key, stamp) + real(rkind), dimension(:,:,:), intent(in) :: field + character(len=*), intent(in) :: key, stamp, fieldID, BudgetID + character(len=clen) :: fname, tempname + character(len=2) :: crid + + write(crid, '(I2.2)') RID + write(tempname,"(A)") "Run"//crid//"_comp_deficit_budget"//BudgetID//"_term"//fieldID//"_t"//trim(key)//"_n"//trim(stamp)//".s3D" + fname = trim(outputdir)//"/"//trim(tempname) + + call message(2, 'Writing a budget field to '//trim(fname)) + call decomp_2d_write_one(1,field, trim(fname), gpC) + end subroutine + + subroutine compute_budgets(key, stamp) + implicit none + character(len=*), intent(in) :: key, stamp + integer :: idx + real(rkind), dimension(:,:,:), pointer :: buffer + character(len=2) :: idx_str + character(1) :: additional + + buffer => rbuffxC(:,:,:,3) + + do idx=1,num_profiles + + call message(1, 'Computing budget profile with index ', idx) + + select case(budgettype) + case(1) + call compute_X_budget_component(idx, buffer) + additional = '5' + case(2) + call compute_Y_budget_component(idx, buffer) + additional = '6' + case(3) + call compute_Z_budget_component(idx, buffer) + additional = '7' + case(4) + call compute_TKE_budget_component(idx, buffer) + additional = '4' + end select + + ! Average this budget term across the box + if(do_box_averaging) call integrate_box_yz(buffer, profiles(:,idx)) + + ! Write to file calculated dependent variables if requested + if(writeDependentVariables .and. depedent_variable(idx))then + write(idx_str, '(I2.2)') idx + call dump_budget_field(buffer, idx_str, additional, trim(key), trim(stamp)) + end if + end do + + nullify(buffer) + end subroutine + + function depedent_variable(idx) + implicit none + integer, intent(in) :: idx + logical :: depedent_variable + + depedent_variable = .false. + if((budgettype == 1) .or. (budgettype == 2) .or. (budgettype == 3))then + ! X, Y, or Z momentum equation + if((idx < 10) .or. (idx > 15)) depedent_variable = .true. + elseif(budgettype == 4)then + ! TKE equation + if(idx <= 12) depedent_variable = .true. + end if + end function depedent_variable + + subroutine compute_X_budget_component(idx, buffer) + implicit none + integer, intent(in) :: idx + real(rkind), dimension(:,:,:), intent(out) :: buffer + real(rkind), dimension(:,:,:), pointer :: BF1, BF2 + + BF1 => rbuffxC(:,:,:,1) + BF2 => rbuffxC(:,:,:,2) + + buffer = zero + select case(idx) + case(1) + ! Advection: delta u_1 * partial_1 (delta u_1) + buffer = budget0(:,:,:,1) * dudx + case(2) + ! Advection: delta u_2 * partial_2 (delta u_1) + buffer = budget0(:,:,:,2) * dudy + case(3) + ! Advection: delta u_3 * partial_3 (delta u_1) + buffer = budget0(:,:,:,3) * dudz + case(4) + ! Advection: delta u_1 * partial_1 (base u_1) + buffer = budget0(:,:,:,1) * dudx_base + case(5) + ! Advection: delta u_2 * partial_2 (base u_1) + buffer = budget0(:,:,:,2) * dudy_base + case(6) + ! Advection: delta u_3 * partial_3 (base u_1) + buffer = budget0(:,:,:,3) * dudz_base + case(7) + ! Advection: base u_1 * partial_1 (delta u_1) + buffer = baseBudget0(:,:,:,1) * dudx + case(8) + ! Advection: base u_2 * partial_2 (delta u_1) + buffer = baseBudget0(:,:,:,2) * dudy + case(9) + ! Advection: base u_3 * partial_3 (delta u_1) + buffer = baseBudget0(:,:,:,3) * dudz + case(10) + ! pressure gradient: partial_1 (delta p) + buffer = budget0(:,:,:,18) + case(11) + ! Divergence of Reynolds stresses: partial_j mean(delta u_1' delta u_j') + ! partial_j mean(delta u_1' delta u_j') = mean(delta u_j' partial_j delta u_1') + buffer = budget2(:,:,:,1) + case(12) + ! Divergence of Reynolds stresses: partial_j mean(delta u_1' base u_j') + ! partial_j mean(delta u_1' base u_j') = mean(base u_j' partial_j delta u_1') + buffer = budget2(:,:,:,7) + case(13) + ! Divergence of Reynolds stresses: partial_j mean(base u_1' delta u_j') + ! partial_j mean(base u_1' delta u_j') = mean(delta u_j' partial_j base u_1') + buffer = budget2(:,:,:,4) + case(14) + ! u_sgs + buffer = budget0(:,:,:,12) + case(15) + ! u_cor + buffer = budget0(:,:,:,15) + case(16) + ! Divergence of Reynolds stresses: partial_1 mean(delta u_1' delta u_1') + call ddx_R2R(budget1(:,:,:,1), buffer) + case(17) + ! Divergence of Reynolds stresses: partial_2 mean(delta u_1' delta u_2') + call ddy_R2R(budget1(:,:,:,2), buffer) + case(18) + ! Divergence of Reynolds stresses: partial_3 mean(delta u_1' delta u_3') + call ddz_R2R(budget1(:,:,:,3), buffer, -1, -1) ! budget1(:,:,:,3) is odd + case(19) + ! Divergence of Reynolds stresses: partial_1 mean(delta u_1' base u_1') + call ddx_R2R(budget1(:,:,:,7), buffer) + case(20) + ! Divergence of Reynolds stresses: partial_2 mean(delta u_1' base u_2') + call ddy_R2R(budget1(:,:,:,8), buffer) + case(21) + ! Divergence of Reynolds stresses: partial_3 mean(delta u_1' base u_3') + call ddz_R2R(budget1(:,:,:,10), buffer, -1, -1) + case(22) + ! Divergence of Reynolds stresses: partial_1 mean(base u_1' delta u_1') + call ddx_R2R(budget1(:,:,:,7), buffer) + case(23) + ! Divergence of Reynolds stresses: partial_2 mean(base u_1' delta u_2') + call ddy_R2R(budget1(:,:,:,9), buffer) + case(24) + ! Divergence of Reynolds stresses: partial_3 mean(base u_1' delta u_3') + call ddz_R2R(budget1(:,:,:,11), buffer, -1, -1) + end select + end subroutine + + subroutine compute_Y_budget_component(idx, buffer) + implicit none + integer, intent(in) :: idx + real(rkind), dimension(:,:,:), intent(out) :: buffer + real(rkind), dimension(:,:,:), pointer :: BF1, BF2 + + BF1 => rbuffxC(:,:,:,1) + BF2 => rbuffxC(:,:,:,2) + + buffer = zero + select case(idx) + case(1) + ! Advection: delta u_1 * partial_1 (delta u_2) + buffer = budget0(:,:,:,1) * dvdx + case(2) + ! Advection: delta u_2 * partial_2 (delta u_2) + buffer = budget0(:,:,:,2) * dvdy + case(3) + ! Advection: delta u_3 * partial_3 (delta u_2) + buffer = budget0(:,:,:,3) * dvdz + case(4) + ! Advection: delta u_1 * partial_1 (base u_2) + buffer = budget0(:,:,:,1) * dvdx_base + case(5) + ! Advection: delta u_2 * partial_2 (base u_2) + buffer = budget0(:,:,:,2) * dvdy_base + case(6) + ! Advection: delta u_3 * partial_3 (base u_2) + buffer = budget0(:,:,:,3) * dvdz_base + case(7) + ! Advection: base u_1 * partial_1 (delta u_2) + buffer = baseBudget0(:,:,:,1) * dvdx + case(8) + ! Advection: base u_2 * partial_2 (delta u_2) + buffer = baseBudget0(:,:,:,2) * dvdy + case(9) + ! Advection: base u_3 * partial_3 (delta u_2) + buffer = baseBudget0(:,:,:,3) * dvdz + case(10) + ! pressure gradient: partial_2 (delta p) + buffer = budget0(:,:,:,19) + case(11) + ! Divergence of Reynolds stresses: partial_j mean(delta u_2' delta u_j') + ! partial_j mean(delta u_2' delta u_j') = mean(delta u_j' partial_j delta u_2') + buffer = budget2(:,:,:,2) + case(12) + ! Divergence of Reynolds stresses: partial_j mean(delta u_2' base u_j') + ! partial_j mean(delta u_2' base u_j') = mean(base u_j' partial_j delta u_2') + buffer = budget2(:,:,:,8) + case(13) + ! Divergence of Reynolds stresses: partial_j mean(base u_2' delta u_j') + ! partial_j mean(base u_2' delta u_j') = mean(delta u_j' partial_j base u_2') + buffer = budget2(:,:,:,5) + case(14) + ! v_sgs + buffer = budget0(:,:,:,13) + case(15) + ! v_cor + buffer = budget0(:,:,:,16) + case(16) + ! Divergence of Reynolds stresses: partial_1 mean(delta u_2' delta u_1') + call ddx_R2R(budget1(:,:,:,2), buffer) + case(17) + ! Divergence of Reynolds stresses: partial_2 mean(delta u_2' delta u_2') + call ddy_R2R(budget1(:,:,:,4), buffer) + case(18) + ! Divergence of Reynolds stresses: partial_3 mean(delta u_2' delta u_3') + call ddz_R2R(budget1(:,:,:,5), buffer, -1, -1) ! budget1(:,:,:,5) is odd + case(19) + ! Divergence of Reynolds stresses: partial_1 mean(delta u_2' base u_1') + call ddx_R2R(budget1(:,:,:,9), buffer) + case(20) + ! Divergence of Reynolds stresses: partial_2 mean(delta u_2' base u_2') + call ddy_R2R(budget1(:,:,:,12), buffer) + case(21) + ! Divergence of Reynolds stresses: partial_3 mean(delta u_2' base u_3') + call ddz_R2R(budget1(:,:,:,13), buffer, -1, -1) + case(22) + ! Divergence of Reynolds stresses: partial_1 mean(base u_2' delta u_1') + call ddx_R2R(budget1(:,:,:,8), buffer) + case(23) + ! Divergence of Reynolds stresses: partial_2 mean(base u_2' delta u_2') + call ddy_R2R(budget1(:,:,:,12), buffer) + case(24) + ! Divergence of Reynolds stresses: partial_3 mean(base u_2' delta u_3') + call ddz_R2R(budget1(:,:,:,14), buffer, -1, -1) + end select + end subroutine + + subroutine compute_Z_budget_component(idx, buffer) + implicit none + integer, intent(in) :: idx + real(rkind), dimension(:,:,:), intent(out) :: buffer + real(rkind), dimension(:,:,:), pointer :: BF1, BF2 + + BF1 => rbuffxC(:,:,:,1) + BF2 => rbuffxC(:,:,:,2) + + buffer = zero + select case(idx) + case(1) + ! Advection: delta u_1 * partial_1 (delta u_3) + buffer = budget0(:,:,:,1) * dwdx + case(2) + ! Advection: delta u_2 * partial_2 (delta u_3) + buffer = budget0(:,:,:,2) * dwdy + case(3) + ! Advection: delta u_3 * partial_3 (delta u_3) + buffer = budget0(:,:,:,3) * dwdz + case(4) + ! Advection: delta u_1 * partial_1 (base u_3) + buffer = budget0(:,:,:,1) * dwdx_base + case(5) + ! Advection: delta u_2 * partial_2 (base u_3) + buffer = budget0(:,:,:,2) * dwdy_base + case(6) + ! Advection: delta u_3 * partial_3 (base u_3) + buffer = budget0(:,:,:,3) * dwdz_base + case(7) + ! Advection: base u_1 * partial_1 (delta u_3) + buffer = baseBudget0(:,:,:,1) * dwdx + case(8) + ! Advection: base u_2 * partial_2 (delta u_3) + buffer = baseBudget0(:,:,:,2) * dwdy + case(9) + ! Advection: base u_3 * partial_3 (delta u_3) + buffer = baseBudget0(:,:,:,3) * dwdz + case(10) + ! pressure gradient: partial_3 (delta p) + buffer = budget0(:,:,:,20) + case(11) + ! Divergence of Reynolds stresses: partial_j mean(delta u_3' delta u_j') + ! partial_j mean(delta u_3' delta u_j') = mean(delta u_j' partial_j delta u_3') + buffer = budget2(:,:,:,3) + case(12) + ! Divergence of Reynolds stresses: partial_j mean(delta u_3' base u_j') + ! partial_j mean(delta u_3' base u_j') = mean(base u_j' partial_j delta u_3') + buffer = budget2(:,:,:,9) + case(13) + ! Divergence of Reynolds stresses: partial_j mean(base u_2' delta u_j') + ! partial_j mean(base u_2' delta u_j') = mean(delta u_j' partial_j base u_2') + buffer = budget2(:,:,:,6) + case(14) + ! w_sgs + buffer = budget0(:,:,:,14) + case(15) + ! wb + buffer = budget0(:,:,:,17) + case(16) + ! Divergence of Reynolds stresses: partial_1 mean(delta u_3' delta u_1') + call ddx_R2R(budget1(:,:,:,3), buffer) + case(17) + ! Divergence of Reynolds stresses: partial_2 mean(delta u_3' delta u_2') + call ddy_R2R(budget1(:,:,:,5), buffer) + case(18) + ! Divergence of Reynolds stresses: partial_3 mean(delta u_3' delta u_3') + call ddz_R2R(budget1(:,:,:,6), buffer, -1, -1) ! budget1(:,:,:,6) is odd + case(19) + ! Divergence of Reynolds stresses: partial_1 mean(delta u_3' base u_1') + call ddx_R2R(budget1(:,:,:,11), buffer) + case(20) + ! Divergence of Reynolds stresses: partial_2 mean(delta u_3' base u_2') + call ddy_R2R(budget1(:,:,:,14), buffer) + case(21) + ! Divergence of Reynolds stresses: partial_3 mean(delta u_3' base u_3') + call ddz_R2R(budget1(:,:,:,15), buffer, -1, -1) + case(22) + ! Divergence of Reynolds stresses: partial_1 mean(base u_3' delta u_1') + call ddx_R2R(budget1(:,:,:,10), buffer) + case(23) + ! Divergence of Reynolds stresses: partial_2 mean(base u_3' delta u_2') + call ddy_R2R(budget1(:,:,:,13), buffer) + case(24) + ! Divergence of Reynolds stresses: partial_3 mean(base u_3' delta u_3') + call ddz_R2R(budget1(:,:,:,15), buffer, -1, -1) + end select + end subroutine + + subroutine compute_TKE_budget_component(idx, buffer) + implicit none + integer, intent(in) :: idx + real(rkind), dimension(:,:,:), intent(out) :: buffer + real(rkind), dimension(:,:,:), pointer :: BF1, BF2 + + BF1 => rbuffxC(:,:,:,1) + BF2 => rbuffxC(:,:,:,2) + + buffer = zero + select case(idx) + case(1) + ! Advection: delta u_j * partial_j (delta u_i' delta u_i')/2 + BF1 = half*(budget1(:,:,:,1) + budget1(:,:,:,4) + budget1(:,:,:,6)) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*budget0(:,:,:,1) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*budget0(:,:,:,2) + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*budget0(:,:,:,3) ! BF1 is even + + case(2) + ! Advection: delta u_j * partial_j (delta u_i' base u_i') + BF1 = (budget1(:,:,:,7) + budget1(:,:,:,12) + budget1(:,:,:,15)) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*budget0(:,:,:,1) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*budget0(:,:,:,2) + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*budget0(:,:,:,3) ! BF1 is even + + case(3) + ! Advection: delta u_j * partial_j (base u_i' base u_i')/2 + BF1 = half*(baseBudget0(:,:,:,4) + baseBudget0(:,:,:,7) + baseBudget0(:,:,:,9)) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*budget0(:,:,:,1) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*budget0(:,:,:,2) + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*budget0(:,:,:,3) ! BF1 is even + + case(4) + ! Advection: base u_j * partial_j (delta u_i' delta u_i')/2 + BF1 = half*(budget1(:,:,:,1) + budget1(:,:,:,4) + budget1(:,:,:,6)) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*baseBudget0(:,:,:,1) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*baseBudget0(:,:,:,2) + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*baseBudget0(:,:,:,3) ! BF1 is even + + case(5) + ! Advection: base u_j * partial_j (delta u_i' base u_i') + BF1 = (budget1(:,:,:,7) + budget1(:,:,:,12) + budget1(:,:,:,15)) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*baseBudget0(:,:,:,1) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*baseBudget0(:,:,:,2) + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*baseBudget0(:,:,:,3) ! BF1 is even + + case(6) + ! Production: mean(delta u_i' delta u_j') partial_j mean(delta u_i) + buffer = dudx * budget1(:,:,:,1) + dudy * budget1(:,:,:,2) + dudz * budget1(:,:,:,3) + & + dvdx * budget1(:,:,:,2) + dvdy * budget1(:,:,:,4) + dvdz * budget1(:,:,:,5) + & + dwdx * budget1(:,:,:,3) + dwdy * budget1(:,:,:,5) + dwdz * budget1(:,:,:,6) + case(7) + ! Production: mean(delta u_i' base u_j') partial_j mean(delta u_i) + buffer = dudx * budget1(:,:,:,7) + dudy * budget1(:,:,:,8) + dudz * budget1(:,:,:,10) + & + dvdx * budget1(:,:,:,9) + dvdy * budget1(:,:,:,12) + dvdz * budget1(:,:,:,13) + & + dwdx * budget1(:,:,:,11)+ dwdy * budget1(:,:,:,14) + dwdz * budget1(:,:,:,15) + case(8) + ! Production: mean(base u_i' delta u_j') partial_j mean(delta u_i) + buffer = dudx * budget1(:,:,:,7) + dudy * budget1(:,:,:,9) + dudz * budget1(:,:,:,11) + & + dvdx * budget1(:,:,:,8) + dvdy * budget1(:,:,:,12) + dvdz * budget1(:,:,:,14) + & + dwdx * budget1(:,:,:,10)+ dwdy * budget1(:,:,:,13) + dwdz * budget1(:,:,:,15) + case(9) + ! Production: mean(base u_i' base u_j') partial_j mean(delta u_i) + buffer = dudx * baseBudget0(:,:,:,4) + dudy * baseBudget0(:,:,:,5) + dudz * baseBudget0(:,:,:,6) + & + dvdx * baseBudget0(:,:,:,5) + dvdy * baseBudget0(:,:,:,7) + dvdz * baseBudget0(:,:,:,8) + & + dwdx * baseBudget0(:,:,:,6) + dwdy * baseBudget0(:,:,:,8) + dwdz * baseBudget0(:,:,:,9) + case(10) + ! Production: mean(delta u_i' delta u_j') partial_j mean(base u_i) + buffer = dudx_base * budget1(:,:,:,1) + dudy_base * budget1(:,:,:,2) + dudz_base * budget1(:,:,:,3) + & + dvdx_base * budget1(:,:,:,2) + dvdy_base * budget1(:,:,:,4) + dvdz_base * budget1(:,:,:,5) + & + dwdx_base * budget1(:,:,:,3) + dwdy_base * budget1(:,:,:,5) + dwdz_base * budget1(:,:,:,6) + case(11) + ! Production: mean(delta u_i' base u_j') partial_j mean(base u_i) + buffer = dudx_base * budget1(:,:,:,7) + dudy_base * budget1(:,:,:,8) + dudz_base * budget1(:,:,:,10) + & + dvdx_base * budget1(:,:,:,9) + dvdy_base * budget1(:,:,:,12) + dvdz_base * budget1(:,:,:,13) + & + dwdx_base * budget1(:,:,:,11)+ dwdy_base * budget1(:,:,:,14) + dwdz_base * budget1(:,:,:,15) + case(12) + ! Production: mean(base u_i' delta u_j') partial_j mean(base u_i) + buffer = dudx_base * budget1(:,:,:,7) + dudy_base * budget1(:,:,:,9) + dudz_base * budget1(:,:,:,11) + & + dvdx_base * budget1(:,:,:,8) + dvdy_base * budget1(:,:,:,12) + dvdz_base * budget1(:,:,:,14) + & + dwdx_base * budget1(:,:,:,10)+ dwdy_base * budget1(:,:,:,13) + dwdz_base * budget1(:,:,:,15) + + case(13) + ! Buoyancy: mean(delta w' delta wb') + buffer = - budget3(:,:,:,10) + + case(14) + ! Buoyancy: mean(delta w' base wb') + buffer = - budget3(:,:,:,11) + + case(15) + ! Buoyancy covariance: mean(base w' delta wb') + buffer = - budget3(:,:,:,12) + + case(16) + ! Pressure covariance: mean(delta u_j' partial_j delta p') + buffer = budget3(:,:,:,1) + + case(17) + ! Pressure covariance: mean(base u_j' partial_j delta p') + buffer = budget3(:,:,:,2) + + case(18) + ! Pressure covariance: mean(delta u_j' partial_j base p') + buffer = budget3(:,:,:,3) + + case(19) + ! Transport: mean(delta u_i' delta u_j' partial_j delta u_i') + buffer = budget3(:,:,:,19) + + case(20) + ! Transport: mean(delta u_i' base u_j' partial_j delta u_i') + buffer = budget3(:,:,:,18) + + case(21) + ! Transport: mean(delta u_i' delta u_j' partial_j base u_i') + buffer = budget3(:,:,:,17) + + case(22) + ! Transport: mean(base u_i' delta u_j' partial_j delta u_i') + buffer = budget3(:,:,:,16) + + case(23) + ! Transport: mean(delta u_i' base u_j' partial_j base u_i') + buffer = budget3(:,:,:,15) + + case(24) + ! Transport: mean(base u_i' base u_j' partial_j delta u_i') + buffer = budget3(:,:,:,14) + + case(25) + ! Transport: mean(base u_i' delta u_j' partial_j base u_i') + buffer = budget3(:,:,:,13) + + case(26) + ! SGS transport: partial_j mean(base u_i' delta tau_ij') + buffer = budget3(:,:,:,4) + + case(27) + ! SGS transport: partial_j mean(delta u_i' base tau_ij') + buffer = budget3(:,:,:,5) + + case(28) + ! SGS transport: partial_j mean(delta u_i' delta tau_ij') + buffer = budget3(:,:,:,6) + + case(29) + ! SGS Dissipation: mean(delta tau_ij' partial_j base u_i') + buffer = -budget3(:,:,:,7) + + case(30) + ! SGS Dissipation: mean(base tau_ij' partial_j delta u_i') + buffer = -budget3(:,:,:,8) + + case(31) + ! SGS Dissipation: mean(delta tau_ij' partial_j delta u_i') + buffer = -budget3(:,:,:,9) + end select + + nullify(BF1, BF2) + end subroutine + + subroutine resetEverything() + implicit none + + if(allocated(budget0)) budget0 = zero + if(allocated(budget1)) budget1 = zero + if(allocated(budget2)) budget2 = zero + if(allocated(budget3)) budget3 = zero + if(allocated(baseBudget0)) baseBudget0 = zero + if(allocated(duidxj)) duidxj = zero + if(allocated(duidxj_base)) duidxj_base = zero + if(allocated(profiles)) profiles = zero + end subroutine + + subroutine intersectBoxAndMesh() + implicit none + + integer :: iL + integer :: ig + real(rkind) :: xmin, xmax, ymin, ymax, zmin, zmax, xplane + character(len=4) :: ix1gc, ix2gc + integer, parameter :: HUGE_I = huge(1) + integer :: ibox + + ! We use x-pencils. All ranks see the whole x range. All calculations here are local. + + !---------------------------- + ! Bounds (make robust to x1>x2 etc.) + !---------------------------- + xmin = min(x1, x2); xmax = max(x1, x2) + ymin = min(y1, y2); ymax = max(y1, y2) + zmin = min(z1, z2); zmax = max(z1, z2) + + ix1g = HUGE_I + ix2g = -HUGE_I + + do iL = 1, size(mesh,1) + ig = gpC%xst(1) + (iL - 1) ! local-to-global x index + + ! x is constant on an x-plane for structured meshes; sample one point on that plane + xplane = mesh(iL, 1, 1, 1) + + if (xplane >= xmin .and. xplane <= xmax) then + ix1g = min(ix1g, ig) + ix2g = max(ix2g, ig) + end if + end do + + ! Handle: box does not intersect any x-plane anywhere + if (ix2g < ix1g .or. ix1g == HUGE_I .or. ix2g == -HUGE_I) then + call gracefulExit('Invalid box bounds.', 124) + end if + + nx_box = ix2g - ix1g + 1 + write(ix1gc, '(I4.4)')ix1g + write(ix2gc, '(I4.4)')ix2g + call message(0,'Box intersects X dimension between indices '//trim(ix1gc)//' and '//trim(ix2gc)) + + allocate(xstations(nx_box)) + do ibox = 1, nx_box + iL = ix1g + ibox - 1 + xstations(ibox) = mesh(iL,1,1,1) + end do + end subroutine + + subroutine integrate_box_yz(f, prof) + implicit none + real(rkind), intent(in) :: f(:,:,:) ! local field: (xsz1,xsz2,xsz3) + real(rkind), dimension(:), intent(out) :: prof + + ! Locals + integer :: ierr + integer :: iL + integer :: ig + real(rkind) :: xmin, xmax, ymin, ymax, zmin, zmax, xplane + real(rkind), allocatable :: prof_local(:) + logical, allocatable :: mask_yz(:,:) + integer, parameter :: HUGE_I = huge(1) + + prof = zero + allocate(prof_local(nx_box)) + prof_local = zero + + ! mask over local y-z plane + allocate(mask_yz(size(f,2), size(f,3))) + + !---------------------------- + ! Bounds (make robust to x1>x2 etc.) + !---------------------------- + xmin = min(x1, x2); xmax = max(x1, x2) + ymin = min(y1, y2); ymax = max(y1, y2) + zmin = min(z1, z2); zmax = max(z1, z2) + + !---------------------------- + ! Local contribution: for each local x-plane that lies in [xmin,xmax], + ! sum f over (y,z) points whose (y,z) are within box bounds. + ! Accumulate into prof_local at the position corresponding to global x-index. + !---------------------------- + do iL = 1, size(f,1) + ig = gpC%xst(1) + (iL - 1) + xplane = mesh(iL, 1, 1, 1) + + if (xplane >= xmin .and. xplane <= xmax) then + ! mask for this x-plane in y-z + mask_yz = (mesh(iL, :, :, 2) >= ymin .and. mesh(iL, :, :, 2) <= ymax) .and. & + (mesh(iL, :, :, 3) >= zmin .and. mesh(iL, :, :, 3) <= zmax) + + prof_local(ig - ix1g + 1) = prof_local(ig - ix1g + 1) + sum(f(iL, :, :), mask=mask_yz) + end if + end do + prof_local = prof_local * dy*dz ! Area element + + !---------------------------- + ! Global reduction: sum contributions from all ranks + !---------------------------- + call mpi_allreduce(prof_local, prof, nx_box, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) + + deallocate(mask_yz) + deallocate(prof_local) + end subroutine integrate_box_yz + + logical function TimeWithinRange(tidx, istart, iend) + implicit none + character(*), intent(in) :: tidx + integer, intent(in) :: istart, iend + integer :: itime + integer :: ios + + read(tidx, '(I6)', iostat=ios) itime + if (ios /= 0) then + TimeWithinRange = .false. + return + end if + TimeWithinRange = (itime >= istart .and. itime <= iend) + end function TimeWithinRange + + subroutine compute_duidxj() + implicit none + call message(1, 'Computing velocity gradients ...') + + call ddx_R2R(budget0(:,:,:,1), dudx) + call ddy_R2R(budget0(:,:,:,1), dudy) + call ddz_R2R(budget0(:,:,:,1), dudz, uBC_bottom, uBC_top) + call ddx_R2R(budget0(:,:,:,2), dvdx) + call ddy_R2R(budget0(:,:,:,2), dvdy) + call ddz_R2R(budget0(:,:,:,2), dvdz, vBC_bottom, vBC_top) + call ddx_R2R(budget0(:,:,:,3), dwdx) + call ddy_R2R(budget0(:,:,:,3), dwdy) + call ddz_R2R(budget0(:,:,:,3), dwdz, wBC_bottom, wBC_top) + + call ddx_R2R(baseBudget0(:,:,:,1), dudx_base) + call ddy_R2R(baseBudget0(:,:,:,1), dudy_base) + call ddz_R2R(baseBudget0(:,:,:,1), dudz_base, uBC_bottom, uBC_top) + call ddx_R2R(baseBudget0(:,:,:,2), dvdx_base) + call ddy_R2R(baseBudget0(:,:,:,2), dvdy_base) + call ddz_R2R(baseBudget0(:,:,:,2), dvdz_base, vBC_bottom, vBC_top) + call ddx_R2R(baseBudget0(:,:,:,3), dwdx_base) + call ddy_R2R(baseBudget0(:,:,:,3), dwdy_base) + call ddz_R2R(baseBudget0(:,:,:,3), dwdz_base, wBC_bottom, wBC_top) + end subroutine + + subroutine get_boundary_conditions_stencil() + implicit none + + wBC_bottom = -1 + wBC_top = -1 + + !! Bottom wall + call message(0,"Bottom Wall Boundary Condition is:") + select case (botWall) + case(1) + call message(1,"No-Slip Wall") + ! NOTE: no-slip wall requires both w = 0 and dwdz = 0. Therefore, w + ! is an even extension, which also satisfies w = 0. + uBC_bottom = 0 + vBC_bottom = 0 + wBC_bottom = 1 + case(2) + call message(1,"Slip Wall") + uBC_bottom = 1 + vBC_bottom = 1 + case(3) + call message(1,"Wall Model") + uBC_bottom = 0 + vBC_bottom = 0 + case default + call gracefulExit("Invalid choice for BOTTOM WALL BCs",423) + end select + + !! Top wall + call message(0,"Top Wall Boundary Condition is:") + select case (TopWall) + case(1) + call message(1,"No-Slip Wall") + ! NOTE: no-slip wall requires both w = 0 and dwdz = 0. Therefore, w + ! is an even extension, which also satisfies w = 0. + uBC_top = 0 + vBC_top = 0 + wBC_top = 1 + case(2) + call message(1,"Slip Wall") + uBC_top = 1 + vBC_top = 1 + case(3) + call message(1,"Wall Model") + uBC_top = 0 + vBC_top = 0 + case default + call gracefulExit("Invalid choice for TOP WALL BCs",13) + end select + + end subroutine + + subroutine readBudgets(key, stamp) + implicit none + character(*), intent(in) :: key, stamp + integer :: idx, budgetid + character(len=clen) :: pattern, filename + logical :: exists + real(rkind), dimension(:,:,:,:), pointer :: budget + + do budgetid=0,3 + select case(budgetid) + case(0) + budget => budget0 + case(1) + budget => budget1 + case(2) + budget => budget2 + case(3) + budget => budget3 + end select + + if((budgetid == 3) .and. (budgettype /= 4)) cycle ! budget3 is only relevant for TKE budgets + + do idx = 1, size(budget, 4) + pattern = getPattern(RID, budgetid, idx, key=key, stamp=stamp) + filename = trim(inputdir)//'/'//trim(pattern) + inquire(file=trim(filename), exist=exists) + if(exists)then + call message(1, 'Reading '//trim(filename)) + call decomp_2d_read_one(1, budget(:,:,:,idx), trim(filename), gpC) + else + call message(1, 'Not found: '//trim(filename)//' ... skipping') + cycle + end if + end do + end do + + call message(1, 'Reading base flow budget 0') + do idx = 1,9 + pattern = getPattern(BRID, 0, idx, key=key, stamp=stamp, isBase=.True.) + filename = trim(inputdir)//'/'//trim(pattern) + inquire(file=trim(filename), exist=exists) + if(exists)then + call message(1, 'Reading '//trim(filename)) + call decomp_2d_read_one(1, baseBudget0(:,:,:,idx), trim(filename), gpC) + else + call message(1, 'Not found: '//trim(filename)//' ... skipping') + cycle + end if + end do + + end subroutine + + function getPattern(rid, budgetid, termid, key, stamp, isBase) + implicit none + character(len=clen) :: getPattern + integer, intent(in) :: rid, budgetid, termid + character(len=1) :: cbdgtid + character(len=2) :: ctermid, crid + character(len=*), optional :: key, stamp + logical, optional :: isBase + + write(crid, '(I2.2)') rid + write(cbdgtid, '(I1)') budgetid + write(ctermid, '(I2.2)') termid + + getPattern = 'Run'//trim(crid)//'_comp_deficit_budget'//cbdgtid//'_term'//ctermid + if(present(isBase))then + if(isBase)then + getPattern = 'Run'//trim(crid)//'_budget'//cbdgtid//'_term'//ctermid + end if + end if + + if (present(key))then + getPattern = trim(getPattern)//'_t'//trim(key) + else + getPattern = trim(getPattern)//'_t*' + end if + + if (present(stamp))then + getPattern = trim(getPattern)//'_n'//trim(stamp) + else + getPattern = trim(getPattern)//'_n~' + end if + + getPattern = trim(getPattern)//'.s3D' + end function + + ! Small helpers using ISO_C_BINDING to getpid() + function getpid() result(pid) + use iso_c_binding, only: c_int + implicit none + integer :: pid + interface + function c_getpid() bind(C, name="getpid") result(c_pid) + import :: c_int + integer(c_int) :: c_pid + end function c_getpid + end interface + pid = int(c_getpid(), kind(pid)) + end function getpid + + pure function to_string(i) result(str) + integer, intent(in) :: i + character(len=32) :: str + write(str, '(I0)') i + end function to_string + + ! String utility functions + logical pure function starts_with(s, pre) result(ok) + character(*), intent(in) :: s, pre + integer :: lp + lp = len_trim(pre) + if (lp == 0) then + ok = .true. + else + ok = (len_trim(s) >= lp) .and. (s(1:lp) == pre(1:lp)) + end if + end function starts_with + + logical pure function ends_with(s, suf) result(ok) + character(*), intent(in) :: s, suf + integer :: ls, ts + ls = len_trim(suf); ts = len_trim(s) + if (ls == 0) then + ok = .true. + else + ok = (ts >= ls) .and. (s(ts-ls+1:ts) == suf(1:ls)) + end if + end function ends_with + + ! Check if VAL is in LIST + logical pure function in_list(list, n, val) result(found) + character(len=*), intent(in) :: list(:) + integer, intent(in) :: n + character(len=*), intent(in) :: val + integer :: i + found = .false. + do i = 1, n + if (list(i) == val) then + found = .true.; return + end if + end do + end function in_list + + subroutine get_keys_stamps() + implicit none + character(len=:), allocatable :: keys(:), stamps(:) + character(len=clen) :: pattern + integer :: k + + pattern = getPattern(rid, 0, 1) + call message(0, 'Extracting time stamps with a pattern: '//trim(pattern)) + + call list_matching_keys_budget(trim(inputdir), trim(pattern), keys, stamps) + call sort_keys_and_stamps_numeric(keys, stamps, sorted_keys, sorted_stamps) + + call message(0, 'Found time stamps are: ') + do k=1, size(sorted_keys) + if(TimeWithinRange(trim(sorted_keys(k)), startIDX, endIDX))then + call message(1, 'Time: '//trim(sorted_keys(k))//', # Frames: '//trim(sorted_stamps(k))//' (within range)') + else + call message(1, 'Time: '//trim(sorted_keys(k))//', # Frames: '//trim(sorted_stamps(k))//' (out of range)') + end if + end do + call message(0, ' ') + end subroutine + + subroutine sort_keys_and_stamps_numeric(keys, stamps, sorted_keys, sorted_stamps) + !! Sort KEYS (time stamps) by their integer value (ascending), + !! and apply the same ordering to STAMPS. + !! + !! Input: + !! keys(:) - character time stamps, e.g. "000900", "001050" + !! stamps(:) - corresponding "~" stamps, e.g. "123456", "654321" + !! + !! Output (allocatable): + !! sorted_keys(:), sorted_stamps(:) - reordered copies + !! + character(len=*), intent(in) :: keys(:) + character(len=*), intent(in) :: stamps(:) + character(len=:), allocatable, intent(out) :: sorted_keys(:) + character(len=:), allocatable, intent(out) :: sorted_stamps(:) + + integer :: n, i, j, ios, val + integer, allocatable :: vals(:), idx(:) + integer :: maxlen_k, maxlen_s + character(len=:), allocatable :: s + + ! Basic checks + n = size(keys) + if (n == 0 .or. size(stamps) /= n) then + allocate(character(len=1) :: sorted_keys(0)) + allocate(character(len=1) :: sorted_stamps(0)) + return + end if + + allocate(vals(n), idx(n)) + + ! Parse integers from KEYS; non-numeric => sent to the end + do i = 1, n + s = trim(keys(i)) + read(s, *, iostat=ios) val + if (ios == 0) then + vals(i) = val + else + vals(i) = huge(1) ! put non-numeric keys after numeric ones + end if + idx(i) = i + end do + + ! Simple O(n^2) indirect sort of idx by vals + do i = 1, n-1 + do j = i+1, n + if (vals(idx(j)) < vals(idx(i))) then + call swap(idx(i), idx(j)) ! your existing swap(int,int) + end if + end do + end do + + ! Decide output lengths + maxlen_k = 0 + maxlen_s = 0 + do i = 1, n + maxlen_k = max(maxlen_k, len_trim(keys(i))) + maxlen_s = max(maxlen_s, len_trim(stamps(i))) + end do + if (maxlen_k <= 0) maxlen_k = 1 + if (maxlen_s <= 0) maxlen_s = 1 + + ! Allocate outputs with trimmed lengths + allocate(character(len=maxlen_k) :: sorted_keys(n)) + allocate(character(len=maxlen_s) :: sorted_stamps(n)) + + ! Fill outputs according to permutation idx + do i = 1, n + sorted_keys(i) = adjustl(keys(idx(i))(1:maxlen_k)) + sorted_stamps(i) = adjustl(stamps(idx(i))(1:maxlen_s)) + end do + + deallocate(vals, idx) + + end subroutine sort_keys_and_stamps_numeric + + pure subroutine swap(a, b) + integer, intent(inout) :: a, b + integer :: t + t = a; a = b; b = t + end subroutine swap + + ! Split pattern with one '*' into prefix and suffix + subroutine split_one_star(pattern, prefix, suffix, ok) + character(*), intent(in) :: pattern + character(len=:), allocatable, intent(out) :: prefix, suffix + logical, intent(out) :: ok + integer :: p, q, n + n = len_trim(pattern) + p = index(pattern(:n), '*') + if (p == 0) then + ok = .false.; prefix = ''; suffix = ''; return + end if + q = index(pattern(p+1:n), '*') + if (q /= 0) then + ok = .false.; prefix = ''; suffix = ''; return + end if + prefix = pattern(:p-1) + suffix = pattern(p+1:n) + ok = .true. + end subroutine split_one_star + + subroutine list_matching_keys_budget(dir, pattern, keys, stamps) + ! To handle files like: + ! Run06_budget0_term13_t*_n~.s3D + ! + ! where: + ! * -> time stamp (returned in KEYS) + ! ~ -> 6-digit stamp (returned in STAMPS) + ! + ! Example filenames: + ! Run06_budget0_term13_t000900_n123456.s3D + ! Run06_budget0_term13_t001050_n654321.s3D + ! + ! Result: + ! keys = ["000900","001050",...] + ! stamps = ["123456","654321",...] + ! + character(*), intent(in) :: dir + character(*), intent(in) :: pattern + character(len=:), allocatable, intent(out) :: keys(:) + character(len=:), allocatable, intent(out) :: stamps(:) + + character(len=:), allocatable :: pre, suf + character(len=:), allocatable :: d_esc, p_glob, tmpfile, cmd + character(len=4096) :: line + integer :: istat, u, nlines, maxlen_k, maxlen_s, klen + integer :: ts, lp, pos_n, extpos + logical :: ok, ex + + ! Default empty result + allocate(keys(0), mold=' ') + allocate(stamps(0), mold=' ') + + ! Split pattern around the single '*' to get prefix PRE (up to 't') + call split_one_star(pattern, pre, suf, ok) + if (.not. ok) then + ! either no '*' or more than one '*' + return + end if + + ! Escape directory name + d_esc = escape_single_quotes(trim(dir)) + + ! Build a glob pattern for 'find': + ! original: Run06_budget0_term13_t*_n~.s3D + ! glob: Run06_budget0_term13_t*_n*.s3D + ! + ! i.e. replace '~' with '*' so we ignore the 6-digit stamp in the shell. + block + integer :: i, L + character(len=:), allocatable :: tmp + L = len_trim(pattern) + allocate(character(len=L) :: tmp) + tmp = pattern + do i = 1, L + if (tmp(i:i) == '~') tmp(i:i) = '*' + end do + p_glob = escape_single_quotes(trim(tmp)) + end block + + tmpfile = '/tmp/fortran_glob_'//to_string(getpid())//'_keys.txt' + + cmd = "find '"//d_esc//"' -maxdepth 1 -type f -name '"//p_glob// & + "' -printf '%f\n' > '"//tmpfile//"' 2>/dev/null" + call execute_command_line(cmd, exitstat=istat) + if (istat /= 0) return + + inquire(file=tmpfile, exist=ex); if (.not. ex) return + + ! Count matches first + nlines = 0 + open(newunit=u, file=tmpfile, status='old', action='read', iostat=istat) + if (istat /= 0) return + do + read(u,'(A)', iostat=istat) line + if (istat /= 0) exit + nlines = nlines + 1 + end do + close(u) + + if (nlines == 0) then + call execute_command_line("rm -f '"//tmpfile//"'", exitstat=istat) + return + end if + + ! Temp store (over-allocated), we'll dedupe then shrink + if (allocated(keys)) deallocate(keys) + if (allocated(stamps)) deallocate(stamps) + allocate(character(len=clen) :: keys(nlines)) + allocate(character(len=clen) :: stamps(nlines)) + klen = 0 + maxlen_k = 0 + maxlen_s = 0 + + open(newunit=u, file=tmpfile, status='old', action='read', iostat=istat) + if (istat /= 0) then + deallocate(keys); allocate(keys(0), mold=' ') + deallocate(stamps); allocate(stamps(0), mold=' ') + call execute_command_line("rm -f '"//tmpfile//"'", exitstat=istat) + return + end if + + lp = len_trim(pre) + + do + read(u,'(A)', iostat=istat) line + if (istat /= 0) exit + ts = len_trim(line) + if (ts <= 0) cycle + + ! Must start with PRE (e.g. "Run06_budget0_term13_t") + if (.not. starts_with(line(:ts), pre)) cycle + + ! Find the "_n" that comes after the timestamp + pos_n = index(line(:ts), '_n') + if (pos_n <= 0) cycle ! no "_n" -> not our file + + ! Check extension ".s3D" + if (ts < 4) cycle + extpos = ts - 3 ! position of '.' in ".s3D" + if (line(extpos:ts) /= '.s3D') cycle + + ! Extract timestamp between PRE and "_n" + if (pos_n <= lp+1) cycle ! nothing between prefix and "_n" + ! time stamp (*) + block + character(len=clen) :: tstamp, sstamp + integer :: lt, ls + + tstamp = line(lp+1 : pos_n-1) + + ! Extract the 6-digit stamp (~) between "n" and ".s3D" + ! line: "..._n123456.s3D" + ! pos_n: index of "_" + ! 'n' is pos_n+1, stamp starts at pos_n+2, ends at extpos-1 + if (extpos <= pos_n+2) cycle + sstamp = line(pos_n+2 : extpos-1) + + ! Deduplicate based on time stamp; if same time stamp appears twice + ! we'll ignore duplicates (assuming 1-to-1 as you said). + if (.not. in_list(keys, klen, trim(tstamp))) then + klen = klen + 1 + keys(klen) = trim(tstamp) + stamps(klen) = trim(sstamp) + lt = len_trim(tstamp) + ls = len_trim(sstamp) + maxlen_k = max(maxlen_k, lt) + maxlen_s = max(maxlen_s, ls) + end if + end block + end do + + close(u) + call execute_command_line("rm -f '"//tmpfile//"'", exitstat=istat) + + ! Resize KEYS and STAMPS to exactly klen and appropriate lengths + if (klen == 0) then + deallocate(keys); allocate(keys(0), mold=' ') + deallocate(stamps); allocate(stamps(0), mold=' ') + else + block + character(len=:), allocatable :: tmpk(:), tmps(:) + integer :: j + + allocate(character(len=maxlen_k) :: tmpk(klen)) + allocate(character(len=maxlen_s) :: tmps(klen)) + + do j = 1, klen + tmpk(j) = adjustl(keys(j)(:maxlen_k)) + tmps(j) = adjustl(stamps(j)(:maxlen_s)) + end do + + call move_alloc(tmpk, keys) + call move_alloc(tmps, stamps) + end block + end if + end subroutine list_matching_keys_budget + + pure function escape_single_quotes(s) result(t) + character(*), intent(in) :: s + character(len=:), allocatable :: t + integer :: i, n, extra, pos + n = len_trim(s) + extra = 0 + do i = 1, n + if (s(i:i) == "'") extra = extra + 3 ! "'" -> '\'' (3 extra chars) + end do + t = repeat(' ', n + extra) + pos = 1 + do i = 1, n + if (s(i:i) == "'") then + t(pos:pos) = "'"; pos = pos + 1 + t(pos:pos) = "\"; pos = pos + 1 + t(pos:pos) = "'"; pos = pos + 1 + t(pos:pos) = "'"; pos = pos + 1 + else + t(pos:pos) = s(i:i); pos = pos + 1 + end if + end do + if (pos <= len(t)) t = t(:pos-1) + end function escape_single_quotes + + subroutine ddx_R2R(f, dfdx) + real(rkind), dimension(:,:,:), intent(in) :: f + real(rkind), dimension(:,:,:), intent(out) :: dfdx + + call spectC%fft(f, cbuffyC) + call spectC%mtimes_ik1_ip(cbuffyC) + call spectC%dealias(cbuffyC) + call spectC%ifft(cbuffyC, dfdx) + end subroutine + + subroutine ddy_R2R(f, dfdy) + real(rkind), dimension(:,:,:), intent(in) :: f + real(rkind), dimension(:,:,:), intent(out) :: dfdy + + call spectC%fft(f, cbuffyC) + call spectC%mtimes_ik2_ip(cbuffyC) + call spectC%dealias(cbuffyC) + call spectC%ifft(cbuffyC, dfdy) + end subroutine + + subroutine ddz_R2R(f, dfdz, n1, n2) + real(rkind), dimension(:,:,:), intent(in) :: f + real(rkind), dimension(:,:,:), intent(out) :: dfdz + integer, intent(in) :: n1, n2 + + call spectC%fft(f, cbuffyC) + call transpose_y_to_z(cbuffyC, cbuffzC(:,:,:,1), sp_gpC) + call Pade6opZ%ddz_C2C(cbuffzC(:,:,:,1), cbuffzC(:,:,:,2), n1, n2) + call transpose_z_to_y(cbuffzC(:,:,:,2), cbuffyC, sp_gpC) + call spectC%dealias(cbuffyC) + call spectC%ifft(cbuffyC, dfdz) + end subroutine + + subroutine initializeEverything() + implicit none + integer :: ix1, iy1, iz1 + integer :: ixn, iyn, izn + integer :: i,j,k + + ! Allocate memory + call message(0,'Allocating memory ...') + allocate(mesh(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 3)) + allocate(duidxj(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 9)) + allocate(duidxj_base(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 9)) + allocate(Budget0(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 20)) + allocate(Budget1(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 15)) + allocate(Budget2(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 15)) + if(budgettype == 4) allocate( Budget3(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 19)) + allocate(baseBudget0(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 9)) + + ! Allocate Buffers + allocate(rbuffxC(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 3)) + allocate(cbuffyC(sp_gpC%ysz(1),sp_gpC%ysz(2),sp_gpC%ysz(3))) + allocate(cbuffzC(sp_gpC%zsz(1),sp_gpC%zsz(2),sp_gpC%zsz(3),2)) + + ! Create Mesh + ix1 = gpC%xst(1); iy1 = gpC%xst(2); iz1 = gpC%xst(3) + ixn = gpC%xen(1); iyn = gpC%xen(2); izn = gpC%xen(3) + do k=1,size(mesh,3) + do j=1,size(mesh,2) + do i=1,size(mesh,1) + mesh(i,j,k,1) = real( ix1 + i - 1, rkind ) * dx + mesh(i,j,k,2) = real( iy1 + j - 1, rkind ) * dy + mesh(i,j,k,3) = real( iz1 + k - 1, rkind ) * dz + dz/two + end do + end do + end do + mesh(:,:,:,1) = mesh(:,:,:,1) - dx; mesh(:,:,:,2) = mesh(:,:,:,2) - dy; mesh(:,:,:,3) = mesh(:,:,:,3) - dz + call message(0,'All memory allocated.') + + ! Initialize Padeder + call Pade6opz%init(gpC, sp_gpC, gpE, sp_gpE, dz, NumericalSchemeVert,PeriodicInZ,spectC) + call message(0,'Pade operations initialized') + + ! BCs for ddz + call get_boundary_conditions_stencil() + call message(0,'Identified boundary condition stenciles') + + ! Intersect the box with the mesh + if(do_box_averaging)then + call intersectBoxAndMesh() + call message(0,'Control volume box intersected with the mesh') + end if + + ! Allocate holder of x-profiles + select case (budgettype) + case(1) + num_profiles = 24 + case(2) + num_profiles = 24 + case(3) + num_profiles = 24 + case(4) + num_profiles = 31 + end select + allocate(profiles(nx_box, num_profiles)) + + ! Associate pointer + dudx => duidxj(:,:,:,1) + dudy => duidxj(:,:,:,2) + dudz => duidxj(:,:,:,3) + dvdx => duidxj(:,:,:,4) + dvdy => duidxj(:,:,:,5) + dvdz => duidxj(:,:,:,6) + dwdx => duidxj(:,:,:,7) + dwdy => duidxj(:,:,:,8) + dwdz => duidxj(:,:,:,9) + + dudx_base => duidxj_base(:,:,:,1) + dudy_base => duidxj_base(:,:,:,2) + dudz_base => duidxj_base(:,:,:,3) + dvdx_base => duidxj_base(:,:,:,4) + dvdy_base => duidxj_base(:,:,:,5) + dvdz_base => duidxj_base(:,:,:,6) + dwdx_base => duidxj_base(:,:,:,7) + dwdy_base => duidxj_base(:,:,:,8) + dwdz_base => duidxj_base(:,:,:,9) + + call resetEverything() + end subroutine + + subroutine release_memory() + implicit none + + deallocate(mesh, duidxj, duidxj_base, Budget0, Budget1, Budget2, baseBudget0) + if(allocated(Budget3)) deallocate(Budget3) + if(allocated(rbuffxC)) deallocate(rbuffxC) + if(allocated(cbuffyC)) deallocate(cbuffyC) + if(allocated(cbuffzC)) deallocate(cbuffzC) + if(allocated(profiles)) deallocate(profiles) + if(allocated(xstations)) deallocate(xstations) + + nullify(dudx, dudy, dudz, dvdx, dvdy, dvdz, dwdx, dwdy, dwdz) + nullify(dudx_base, dudy_base, dudz_base, dvdx_base, dvdy_base, dvdz_base, dwdx_base, dwdy_base, dwdz_base) + + call spectC%destroy() + call spectE%destroy() + call Pade6opZ%destroy() + call decomp_info_finalize(gpC) + call decomp_info_finalize(gpE) + call decomp_2d_finalize() + end subroutine + +end module constructDeficitBudgets_mod + +program constructDeficitBudgets + use constructDeficitBudgets_mod + + implicit none + integer :: ioUnit, ierr, k + logical :: periodicbcs(3) + character(len=clen) :: inputfile, ers + + namelist /INPUT/ inputdir, outputdir, nx, ny, nz, Lx, Ly, Lz, prow, pcol, RID, & + BRID, budgettype, writeDependentVariables, startIDX, endIDX, tag, & + do_box_averaging + namelist /NUMERICS/ NumericalSchemeVert + namelist /BCs/ PeriodicInZ, botWall, topWall, botBC_temp + namelist /BOX/ x1, x2, y1, y2, z1, z2 + + ! Do MPI stuff + call MPI_Init(ierr) + call GETARG(1,inputfile) + + ! Do file IO - input file + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', status='old', action='read') + read(unit=ioUnit, NML=INPUT, IOSTAT=ierr) + if (ierr/=0)then + write(ers,'(I)')ierr + call gracefulExit("Reading failed for INPUT with error "//trim(ers), 101) + end if + read(unit=ioUnit, NML=NUMERICS, IOSTAT=ierr) + if (ierr/=0)then + write(ers,'(I)')ierr + call gracefulExit("Reading failed for NUMERICS with error "//trim(ers), 102) + end if + read(unit=ioUnit, NML=BCs, IOSTAT=ierr) + if (ierr/=0)then + write(ers,'(I)')ierr + call gracefulExit("Reading failed for BCs with error "//trim(ers), 103) + end if + read(unit=ioUnit, NML=BOX, IOSTAT=ierr) + if (ierr/=0)then + write(ers,'(I)')ierr + call gracefulExit("Reading failed for BOX with error "//trim(ers), 104) + end if + close(ioUnit) + + periodicbcs(1) = .true.; periodicbcs(2) = .true.; periodicbcs(3) = .false. + call decomp_2d_init(nx, ny, nz, prow, pcol, periodicbcs) + call get_decomp_info(gpC) + call decomp_info_init(nx, ny, nz + 1, gpE) + + ! Initialize spectral + dx = Lx/real(nx,rkind); dy = Ly/real(ny,rkind); dz = Lz/real(nz,rkind) + call spectC%init("x",nx,ny,nz, dx, dy,dz,"FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + call spectE%init("x",nx,ny,nz + 1,dx,dy,dz,"FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + sp_gpC => spectC%spectdecomp + sp_gpE => spectE%spectdecomp + + call initializeEverything() + + ! Get file list and sort by time + call get_keys_stamps() + + ! Loop through time frames + do k = 1, size(sorted_keys) + call tic() + + if(.not. TimeWithinRange(trim(sorted_keys(k)), startIDX, endIDX)) cycle + + call message(0, 'Time Index: '//trim(sorted_keys(k))//', # Frames: '//trim(sorted_stamps(k))) + + ! Read Budgets + call readBudgets(trim(sorted_keys(k)), trim(sorted_stamps(k))) + + ! Compute gradients + call compute_duidxj() + + ! Compute Budgets + call compute_budgets(trim(sorted_keys(k)), trim(sorted_stamps(k))) + + ! Export profiles + if((nrank == 0) .and. do_box_averaging)then + call export_csv(trim(sorted_keys(k)), trim(sorted_stamps(k))) + end if + + call resetEverything() + call message(0, ' ') + call MPI_Barrier(MPI_COMM_WORLD, ierr) + call toc() + end do + + call release_memory() + call MPI_FINALIZE(ierr) + +end program constructDeficitBudgets \ No newline at end of file diff --git a/problems/postprocessing_igrid/ConstructDeficitBudgets_files/input_budgets.dat b/problems/postprocessing_igrid/ConstructDeficitBudgets_files/input_budgets.dat new file mode 100644 index 00000000..9dc0e5cf --- /dev/null +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets_files/input_budgets.dat @@ -0,0 +1,35 @@ +&INPUT +inputdir = "/anvil/scratch/x-kali/PadeOpsSims/NREL5MW-8x5-56x20x8/LR10/test_budgets_Kirby_case/new_budgets" +outputdir = "/anvil/scratch/x-kali/PadeOpsSims/NREL5MW-8x5-56x20x8/LR10/test_budgets_Kirby_case/new_budgets" +nx = 384 +ny = 256 +nz = 256 +Lx = 3.84000000e+01 +Ly = 1.28000000e+01 +Lz = 1.28000000e+01 +prow = 0 +pcol = 0 +RID = 7 +BRID = 6 ! Base run index (precursor) +startIDX = 100 +endIDX = 200 +tag = 'box1' +! BudgetType = 5 ! 1: x-Momentum, 2: y-Momentum, 3: z-Momentum, 4: MKE, 5: TKE +/ +&NUMERICS +NumericalSchemeVert = 1 +/ +&BCs +botWall = 3 +topWall = 2 +botBC_temp = 1 +PeriodicInZ = .false. +/ +&BOX +x1 = 25.0 +x2 = 35.0 +y1 = 2.2832 +y2 = 10.2832 +z1 = 0.0 +z2 = 3.0 +/ \ No newline at end of file diff --git a/problems/postprocessing_igrid/Derivatives.F90 b/problems/postprocessing_igrid/Derivatives.F90 new file mode 100644 index 00000000..502f8b78 --- /dev/null +++ b/problems/postprocessing_igrid/Derivatives.F90 @@ -0,0 +1,356 @@ +module derivatives_mod + use mpi + use exits, only: message, gracefulExit + use constants, only: one, two, zero, half + use kind_parameters,only: rkind, clen + use PadeDerOps, only: Pade6stagg + use spectralMod, only: spectral + use decomp_2d + use decomp_2d_io + implicit none + + integer :: myrank, nprocs + character(len=clen) :: inputdir, outputdir, filename, mapfile='' + character(len=1) :: derivative_type + integer :: nx, ny, nz, prow=0, pcol=0 + real(rkind) :: Lx, Ly, Lz + logical :: is_staggered = .false. + integer :: bottom_BC=0, top_BC=0, NumericalSchemeVert=1 + + type(decomp_info), target :: gpC, gpE + type(spectral), target :: spectC, spectE + type(Pade6stagg) :: Pade6opZ + + ! real buffers (X-pencil physical fields) + real(rkind), allocatable, target :: rbuffxC(:,:,:,:), rbuffxE(:,:,:,:) + + ! complex buffers (spectral work arrays) - MUST match spect%spectdecomp + complex(rkind), allocatable :: cbuffyC(:,:,:), cbuffyE(:,:,:), cbuffzE(:,:,:) + complex(rkind), allocatable, target :: cbuffzC(:,:,:,:) + + abstract interface + subroutine deriv_xy_iface(f, df) + import rkind + real(rkind), intent(in) :: f(:,:,:) + real(rkind), intent(out) :: df(:,:,:) + end subroutine deriv_xy_iface + end interface + procedure(deriv_xy_iface), pointer :: ddx_ptr => null(), ddy_ptr => null() + +contains + + subroutine assert_no_unit_thickness(gp, label) + type(decomp_info), intent(in) :: gp + character(len=*), intent(in) :: label + + if ( gp%xsz(1)==1 .or. gp%xsz(2)==1 .or. gp%xsz(3)==1 .or. & + gp%ysz(1)==1 .or. gp%ysz(2)==1 .or. gp%ysz(3)==1 .or. & + gp%zsz(1)==1 .or. gp%zsz(2)==1 .or. gp%zsz(3)==1 ) then + call message(0, "Warning: unit-thickness pencil detected in "//trim(label), 9100) + end if + end subroutine assert_no_unit_thickness + + !----------------------------- + ! X-derivatives (spectral) + !----------------------------- + subroutine ddx_Cell(f, dfdx) + real(rkind), intent(in) :: f(:,:,:) + real(rkind), intent(out) :: dfdx(:,:,:) + + call spectC%fft(f, cbuffyC) + call spectC%mtimes_ik1_ip(cbuffyC) + call spectC%dealias(cbuffyC) + call spectC%ifft(cbuffyC, dfdx) + end subroutine ddx_Cell + + subroutine ddx_Edge(f, dfdx) + real(rkind), intent(in) :: f(:,:,:) + real(rkind), intent(out) :: dfdx(:,:,:) + + call spectE%fft(f, cbuffyE) + call spectE%mtimes_ik1_ip(cbuffyE) + call spectE%dealias(cbuffyE) + call spectE%ifft(cbuffyE, dfdx) + end subroutine ddx_Edge + + !----------------------------- + ! Y-derivatives (spectral) + !----------------------------- + subroutine ddy_Cell(f, dfdy) + real(rkind), intent(in) :: f(:,:,:) + real(rkind), intent(out) :: dfdy(:,:,:) + + call spectC%fft(f, cbuffyC) + call spectC%mtimes_ik2_ip(cbuffyC) + call spectC%dealias(cbuffyC) + call spectC%ifft(cbuffyC, dfdy) + end subroutine ddy_Cell + + subroutine ddy_Edge(f, dfdy) + real(rkind), intent(in) :: f(:,:,:) + real(rkind), intent(out) :: dfdy(:,:,:) + + call spectE%fft(f, cbuffyE) + call spectE%mtimes_ik2_ip(cbuffyE) + call spectE%dealias(cbuffyE) + call spectE%ifft(cbuffyE, dfdy) + end subroutine ddy_Edge + + !----------------------------- + ! Z-derivatives + !----------------------------- + subroutine ddz_Cell(f, dfdz, n1, n2) + real(rkind), intent(in) :: f(:,:,:) + real(rkind), intent(out) :: dfdz(:,:,:) + integer, intent(in) :: n1, n2 + + call spectC%fft(f, cbuffyC) + call transpose_y_to_z(cbuffyC, cbuffzC(:,:,:,1), spectC%spectdecomp) + call Pade6opZ%ddz_C2C(cbuffzC(:,:,:,1), cbuffzC(:,:,:,2), n1, n2) + call transpose_z_to_y(cbuffzC(:,:,:,2), cbuffyC, spectC%spectdecomp) + call spectC%dealias(cbuffyC) + call spectC%ifft(cbuffyC, dfdz) + end subroutine ddz_Cell + + subroutine ddz_Edge(f, dfdz, n1, n2, n3, n4) + real(rkind), intent(in) :: f(:,:,:) + real(rkind), intent(out) :: dfdz(:,:,:) + integer, intent(in) :: n1, n2, n3, n4 + + call spectE%fft(f, cbuffyE) + call transpose_y_to_z(cbuffyE, cbuffzE, spectE%spectdecomp) + call Pade6opZ%ddz_E2C(cbuffzE, cbuffzC(:,:,:,1), n1, n2) + call Pade6opZ%interpz_C2E(cbuffzC(:,:,:,1), cbuffzE, n3, n4) + call transpose_z_to_y(cbuffzE, cbuffyE, spectE%spectdecomp) + call spectE%ifft(cbuffyE, dfdz) + end subroutine ddz_Edge + + subroutine read_derivative_file_list(filepath, filenames, deriv_axes, nitems) + implicit none + + character(len=*), intent(in) :: filepath + character(len=1024), allocatable, intent(out) :: filenames(:) + character(len=1), allocatable, intent(out) :: deriv_axes(:) + integer, intent(out) :: nitems + + integer :: unit, ios, nlines, i, comma_pos + character(len=1024) :: line + character(len=1024) :: name_part + character(len=1024) :: axis_part + + nitems = 0 + nlines = 0 + + ! ------------------------------------------------------------ + ! First pass: count valid nonempty lines + ! ------------------------------------------------------------ + open(newunit=unit, file=trim(filepath), status='old', action='read', iostat=ios) + if (ios /= 0) call gracefulExit("read_derivative_file_list: could not open input file.", 1001) + + do + read(unit, '(A)', iostat=ios) line + if (ios /= 0) exit + + if (len_trim(line) == 0) cycle + + comma_pos = index(line, ',') + if (comma_pos <= 1) call gracefulExit("read_derivative_file_list: malformed line; missing comma.", 1002) + + nlines = nlines + 1 + end do + + close(unit) + + nitems = nlines + + allocate(filenames(nitems)) + allocate(deriv_axes(nitems)) + + if (nitems == 0) return + + ! ------------------------------------------------------------ + ! Second pass: read and parse lines + ! ------------------------------------------------------------ + open(newunit=unit, file=trim(filepath), status='old', action='read', iostat=ios) + if (ios /= 0) call gracefulExit("read_derivative_file_list: could not open input file.", 1003) + + i = 0 + + do + read(unit, '(A)', iostat=ios) line + if (ios /= 0) exit + + if (len_trim(line) == 0) cycle + + comma_pos = index(line, ',') + if (comma_pos <= 1) call gracefulExit("read_derivative_file_list: malformed line; missing comma.", 1004) + + name_part = adjustl(line(:comma_pos-1)) + axis_part = adjustl(line(comma_pos+1:)) + + if (len_trim(axis_part) < 1) call gracefulExit("read_derivative_file_list: missing derivative axis.", 1005) + + if (.not. any(axis_part(1:1) == ['x', 'y', 'z'])) then + call gracefulExit("read_derivative_file_list: derivative axis must be x, y, or z.", 1006) + end if + + i = i + 1 + filenames(i) = trim(name_part) + deriv_axes(i) = axis_part(1:1) + end do + + close(unit) + + end subroutine read_derivative_file_list + +end module derivatives_mod + + +program derivatives + use derivatives_mod + implicit none + + integer :: ierr, ioUnit + real(rkind) :: dx, dy, dz + character(len=clen) :: tmpname, outfile, inputfile + character(len=3) :: tag + logical :: exists + real(rkind), pointer :: buffer(:,:,:), deriv(:,:,:) + type(decomp_info), pointer :: gp => null() + logical :: mapmode = .false. + character(len=1024), allocatable :: files(:) + character(len=1), allocatable :: deriv_axes(:) + integer :: nitems, i + character(len=1024) :: current_file + logical :: need_new_read + + namelist /INPUT/ inputdir, outputdir, nx, ny, nz, Lx, Ly, Lz, prow, pcol, filename, derivative_type, & + mapfile, is_staggered, bottom_BC, top_BC, NumericalSchemeVert + + call MPI_Init(ierr) + call MPI_Comm_rank(MPI_COMM_WORLD, myrank, ierr) + call MPI_Comm_size(MPI_COMM_WORLD, nprocs, ierr) + call GETARG(1, inputfile) + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=INPUT) + close(ioUnit) + + if (mod(nx,2) /= 0) call gracefulExit("nx must be even.", 101) + if (mod(ny,2) /= 0) call gracefulExit("ny must be even.", 102) + + dx = Lx/real(nx,rkind); dy = Ly/real(ny,rkind); dz = Lz/real(nz,rkind) + + call decomp_2d_init(nx, ny, nz, prow, pcol) + call decomp_info_init(nx, ny, nz, gpC) + call decomp_info_init(nx, ny, nz+1, gpE) + + call assert_no_unit_thickness(gpC, "gpC") + call assert_no_unit_thickness(gpE, "gpE") + + call spectC%init("x", nx, ny, nz, dx,dy,dz, "FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + call spectE%init("x", nx, ny, nz+1, dx,dy,dz, "FOUR",'2/3rd', dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + + call Pade6opZ%init(gpC, spectC%spectdecomp, gpE, spectE%spectdecomp, dz, NumericalSchemeVert, .false., spectC) + + ! Real buffers (physical, X-pencil) + allocate(rbuffxC(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3), 2)) + allocate(rbuffxE(gpE%xsz(1), gpE%xsz(2), gpE%xsz(3), 2)) + + ! Complex buffers MUST be sized from the spectral decomposition + allocate(cbuffyC( spectC%spectdecomp%ysz(1), spectC%spectdecomp%ysz(2), spectC%spectdecomp%ysz(3) )) + allocate(cbuffyE( spectE%spectdecomp%ysz(1), spectE%spectdecomp%ysz(2), spectE%spectdecomp%ysz(3) )) + allocate(cbuffzC( spectC%spectdecomp%zsz(1), spectC%spectdecomp%zsz(2), spectC%spectdecomp%zsz(3), 2 )) + allocate(cbuffzE( spectE%spectdecomp%zsz(1), spectE%spectdecomp%zsz(2), spectE%spectdecomp%zsz(3) )) + + ! Set pointers for which grid we’re operating on + if (is_staggered) then + buffer => rbuffxE(:,:,:,1) + deriv => rbuffxE(:,:,:,2) + gp => gpE + ddx_ptr => ddx_Edge + ddy_ptr => ddy_Edge + else + buffer => rbuffxC(:,:,:,1) + deriv => rbuffxC(:,:,:,2) + gp => gpC + ddx_ptr => ddx_Cell + ddy_ptr => ddy_Cell + end if + + ! Mode of reading inputs + mapmode = len_trim(mapfile) > 0 + if (mapmode) then + call message(1, 'Using map file: '//trim(mapfile)) + call read_derivative_file_list(trim(mapfile), files, deriv_axes, nitems) + else + call message(1, 'Using standard input file: '//trim(filename)) + nitems = 1 + allocate(files(1)) + allocate(deriv_axes(1)) + files(1) = trim(filename) + deriv_axes(1) = derivative_type + end if + + ! Read input + ! The map file should be grouped by filename to avoid rereading fields. + ! Consecutive entries with the same filename reuse the already loaded buffer. + + current_file = '' + do i = 1, nitems + + need_new_read = trim(files(i)) /= trim(current_file) + + if (need_new_read) then + current_file = trim(files(i)) + tmpname = trim(inputdir)//"/"//trim(current_file) + + inquire(file=trim(tmpname), exist=exists) + if (.not. exists) then + call message(1, 'Not found: '//trim(tmpname)//' ... exiting') + call gracefulExit("Input file not found.", 2001) + end if + + call message(1, 'Reading '//trim(tmpname)) + call decomp_2d_read_one(1, buffer, trim(tmpname), gp) + end if + + select case (deriv_axes(i)) + case ("x") + call ddx_ptr(buffer, deriv) + tag = "ddx" + + case ("y") + call ddy_ptr(buffer, deriv) + tag = "ddy" + + case ("z") + if (is_staggered) then + call ddz_Edge(buffer, deriv, bottom_BC, top_BC, 0, 0) + else + call ddz_Cell(buffer, deriv, bottom_BC, top_BC) + end if + tag = "ddz" + + case default + call gracefulExit("Invalid derivative axis. Must be 'x', 'y', or 'z'.", 103) + end select + + outfile = trim(outputdir)//"/"//trim(tag)//"_"//trim(files(i)) + call message(1, 'Writing '//trim(outfile)) + call decomp_2d_write_one(1, deriv, trim(outfile), gp) + + end do + + ! Cleanup + deallocate(rbuffxC, rbuffxE, cbuffyC, cbuffyE, cbuffzC, cbuffzE) + call spectC%destroy() + call spectE%destroy() + call Pade6opZ%destroy() + call decomp_info_finalize(gpC) + call decomp_info_finalize(gpE) + call decomp_2d_finalize() + call MPI_Finalize(ierr) + +end program derivatives diff --git a/problems/postprocessing_igrid/Derivatives_files/input_derivatives.dat b/problems/postprocessing_igrid/Derivatives_files/input_derivatives.dat new file mode 100644 index 00000000..f8e86cfc --- /dev/null +++ b/problems/postprocessing_igrid/Derivatives_files/input_derivatives.dat @@ -0,0 +1,18 @@ +&INPUT +inputdir = "null" ! Directory for any input files +outputdir = "null" ! Directory for all output files +nx = 100 ! Number of points in X +ny = 100 ! Number of points in Y +nz = 100 ! Number of points in Z +Lx = 1000 ! Length in X +Ly = 1000 ! Length in Y +Lz = 1000 ! Length in Z +prow = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +pcol = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +filename = 'null' ! Name of file holding the field to be differentiated +derivative_type = 'x' ! +NumericalSchemeVert = 1 +is_staggered = .false. ! Is the field stored in edges (e.g., the w field) +bottom_BC = 1 ! <-1:odd, 0, 1:even> Type of parity at the bottom BC +top_BC = 1 ! <-1:odd, 0, 1:even> Type of parity at the top BC +/ \ No newline at end of file diff --git a/problems/turbines/neutral_pbl_concurrent.F90 b/problems/turbines/neutral_pbl_concurrent.F90 index 39b499da..a12cc32e 100644 --- a/problems/turbines/neutral_pbl_concurrent.F90 +++ b/problems/turbines/neutral_pbl_concurrent.F90 @@ -154,6 +154,7 @@ program neutral_pbl_concurrent call budg_tavg%destroy() !<-- release memory taken by the budget class call pre_budg_tavg%destroy() + if (do_deficit_budgets) call budg_tavg_deficit%destroy() call precursor%finalize_io() call primary%finalize_io() diff --git a/problems/turbines/pre_conc_compact_budgets.F90 b/problems/turbines/pre_conc_compact_budgets.F90 new file mode 100644 index 00000000..1ee991e4 --- /dev/null +++ b/problems/turbines/pre_conc_compact_budgets.F90 @@ -0,0 +1,139 @@ +! Concurrent-precursor problem for inhomogeneous Dirichlet +! boundary conditions in the stable PBL with wind turbines. + +#include "pre_conc_compact_budgets_files/initialize.F90" +#include "pre_conc_compact_budgets_files/temporalHook.F90" + +program pre_conc_compactbudgets + use mpi + use kind_parameters, only: clen, rkind + use IncompressibleGrid, only: igrid + use temporalhook, only: doTemporalStuff + use timer, only: tic, toc + use budgets_time_avg_mod, only: budgets_time_avg + use budgets_time_avg_deficit_compact_mod, only: budgets_time_avg_deficit_compact + use exits, only: message, gracefulExit + + implicit none + + type(igrid), allocatable, target :: primary, precursor + character(len=clen) :: inputfile, primary_inputfile, precursor_inputfile + integer :: ierr, ioUnit + type(budgets_time_avg) :: pre_budg_tavg + type(budgets_time_avg_deficit_compact) :: budg_tavg_deficit_compact + real(rkind) :: dt1, dt2, dt + logical :: synchronize_RK_fringe = .true., do_deficit_budgets = .false. + + namelist /concurrent/ primary_inputfile, precursor_inputfile, synchronize_RK_fringe, do_deficit_budgets + + call MPI_Init(ierr) !<-- Begin MPI + call GETARG(1,inputfile) !<-- Get the location of the input file + + allocate(precursor) !<-- Allocate precursor + allocate(primary) !<-- Allocate primary + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=concurrent) + close(ioUnit) + + call compute_xdim_udim(primary_inputFile) !<-- Reads the \PHYSICS\ namelist to compute (xdim, udim) from (Ro, Fr) + + ! INITIALIZE PRIMARY SIMULATION + call primary%init(primary_inputFile, .true.) + call primary%start_io(.false.) ! do not dump IO fields on init (avoid overwriting turbine data) + call primary%printDivergence() + + ! INITIALIZE PRECURSOR SIMULATION + call precursor%init(precursor_inputFile, .false.) + precursor%Am_I_Primary = .false. + call precursor%start_io(.true.) + + if (primary%usefringe) then + call primary%fringe_x%associateFringeTargets(precursor%u, precursor%v, precursor%w, precursor%T) + call primary%fringe_x%associateFringeTarget_scalar(precursor%T) + end if + + if (primary%useControl .AND. primary%dummy_controller)then + if(.NOT. precursor%useControl)then + call gracefulExit("Primary has a dummy controller, but precursor does not have a controller at all. Exiting.", 44) + elseif(precursor%dummy_controller) then + call gracefulExit("Both Primary and Precursor have dummy controllers. Exiting.", 44) + else + if(.NOT. allocated(precursor%angCont_yaw))then + call gracefulExit("Precursor does not have an active controller, and Primary has a dummy controller. Exiting.", 44) + end if + ! Point to the precursor's controller + primary%angCont_yaw_dummy => precursor%angCont_yaw + call message(0, 'Dummy controller points to main controller.') + end if + end if + + call pre_budg_tavg%init(precursor_inputfile, precursor) !<-- Budget class initialization + if (do_deficit_budgets) then !<-- Budget class initialization for the deficit + call budg_tavg_deficit_compact%init(pre_budg_tavg, primary_inputfile, primary) + end if + + if (primary%useWindTurbines) then + call primary%WindTurbineArr%link_reference_domain_for_control(primary%u, primary%v, primary%rbuffyC, primary%rbuffzC, primary%gpC) + end if + + call message("==========================================================") + call message(0, "All memory allocated! Now running the simulation.") + call tic() + do while (primary%tsim < primary%tstop) + dt1 = primary%get_dt(recompute=.true.) + dt2 = precursor%get_dt(recompute=.true.) + dt = min(dt1, dt2) + + if (synchronize_RK_fringe) then + primary%dt = dt + precursor%dt = dt + ! Stage 1 + call primary%advance_SSP_RK45_Stage_1() + call precursor%advance_SSP_RK45_Stage_1() + ! Stage 2 + call primary%advance_SSP_RK45_Stage_2() + call precursor%advance_SSP_RK45_Stage_2() + ! Stage 3 + call primary%advance_SSP_RK45_Stage_3() + call precursor%advance_SSP_RK45_Stage_3() + ! Stage 4 + call primary%advance_SSP_RK45_Stage_4() + call precursor%advance_SSP_RK45_Stage_4() + ! Stage 5 + call primary%advance_SSP_RK45_Stage_5() + call precursor%advance_SSP_RK45_Stage_5() + ! Call wrap up + call primary%wrapup_timestep() + call precursor%wrapup_timestep() + else + call primary%timeAdvance(dt) + call precursor%timeAdvance(dt) + end if + + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + call pre_budg_tavg%doBudgets() + if (do_deficit_budgets) call budg_tavg_deficit_compact%doBudgets() + + call doTemporalStuff(primary, 1) + call doTemporalStuff(precursor,2) + + end do + + ! Here include an option to expand the last written frame of budgets + ! // + + call pre_budg_tavg%destroy() + if (do_deficit_budgets) call budg_tavg_deficit_compact%destroy() + + call precursor%finalize_io() + call primary%finalize_io() + + call precursor%destroy() + call primary%destroy() + + deallocate(precursor, primary) + + call MPI_Finalize(ierr) + +end program \ No newline at end of file diff --git a/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 new file mode 100644 index 00000000..ca3396a7 --- /dev/null +++ b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 @@ -0,0 +1,352 @@ +module pre_conc_compact_budgets_parameters + + ! TAKE CARE OF TIME NON-DIMENSIONALIZATION IN THIS MODULE + + use exits, only: message + use kind_parameters, only: rkind + use constants, only: zero, kappa, pi + implicit none + integer :: seedu = 321341 + integer :: seedv = 423424 + integer :: seedw = 131344 + real(rkind) :: randomScaleFact = 0.002_rkind ! 0.2% of the mean value + integer :: nxg, nyg, nzg + + real(rkind) :: xdim = 400._rkind, udim =8._rkind ! default values, overwritten in compute_xdim_udim + real(rkind) :: timeDim = zero + real(rkind), parameter :: g = 9.81_rkind, omega = 0.0000729_rkind ! dimensionalizing values g (gravity) and omega (rotation rate) +end module + +subroutine compute_xdim_udim(inputfile) + use kind_parameters, only: rkind, clen + use pre_conc_compact_budgets_parameters, only: xdim, udim, timeDim, g, omega, message + character(len=*), intent(in) :: inputfile + character(len=:), allocatable :: buffer + character(len=clen) :: line + real(rkind) :: Ro, Fr + integer :: iunit + + namelist /PHYSICS/Ro, Fr ! ignore all other variables + + ! All this work is just so we don't need to read ALL of the &PHYSICS namelist... + ! What we are doing here is finding JUST the variables "Fr" and "Ro" and making a + ! new internal namelist to parse + buffer = "&PHYSICS" // new_line('a') + open(unit=10, file=trim(inputfile), form='formatted') + do + read(10,'(A)', iostat=iunit) line + if (iunit /= 0) exit + ! find lines beginning with "Fr " or "Ro ": + if (index(adjustl(line), "Fr ") == 1 .or. index(adjustl(line), "Ro ") == 1) then + ! strip comments: + if (index(line, "!") > 0) line = line(:index(line, "!")-1) + buffer = buffer // trim(adjustl(line)) // new_line('a') + end if + end do + buffer = buffer // "/" // new_line('a') + close(10) + + read(buffer, NML=PHYSICS) + + xdim = g * (Fr / Ro / omega)**2 + udim = g * Fr**2 / omega / Ro + timeDim = xdim/udim + + ! For some reason, the following lines print once per processor, so I've just commented them out: + ! if (nrank == 0) then + ! call message(0, "Computed the following dimensional values from the Rossby and Froude numbers:") + ! call message(1, " xdim", xdim) + ! call message(1, " udim", udim) + ! call message(1, " timeDim", timeDim) + ! end if +end subroutine + +subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) + use kind_parameters, only: rkind + use constants, only: zero, one, two, half + use gridtools, only: alloc_buffs + use random, only: gaussian_random + use decomp_2d + use reductions, only: p_maxval + use pre_conc_compact_budgets_parameters + implicit none + type(decomp_info), intent(in) :: decompC + type(decomp_info), intent(in) :: decompE + character(len=*), intent(in) :: inputfile + real(rkind), dimension(:,:,:,:), intent(in), target :: mesh + real(rkind), dimension(:,:,:,:), intent(inout), target :: fieldsC + real(rkind), dimension(:,:,:,:), intent(inout), target :: fieldsE + integer :: ioUnit + real(rkind), dimension(:,:,:), pointer :: u, v, w, wC, T, x, y, z + real(rkind), dimension(:,:,:), allocatable :: ybuffC, ybuffE, zbuffC, zbuffE + integer :: nz, nzE, k + real(rkind) :: sig, hpert=zero, hpert_ + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, dTsurf_dt = zero, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero + real(rkind), dimension(:,:,:), allocatable :: randArr, Tpurt, eta + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ! NOTE: Although `xdim` is computed, z_Tref and dTdz are still w.r.t. non-dim length scale for consistency with `neutral_pbl` + ! only temperature and time are dimensional inputs in this namelist + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + !!!!!!!!!!!!!!!!!!!!! DON'T CHANGE THE POINTERS / ALLOCATIONS !!!!!!!!!!!!!!!!!!!!!! + u => fieldsC(:,:,:,1); v => fieldsC(:,:,:,2); wC => fieldsC(:,:,:,3) + w => fieldsE(:,:,:,1); T => fieldsC(:,:,:,7) + z => mesh(:,:,:,3); y => mesh(:,:,:,2); x => mesh(:,:,:,1) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + u = one + v = zero + wC = zero + + allocate(Tpurt(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) + T = Tsurf0 + where (z >= inv_height .and. z < inv_height + inv_thickness) + T = Tsurf0 + inv_strength * (z - inv_height) / inv_thickness + elsewhere (z >= inv_height + inv_thickness) + T = Tsurf0 + inv_strength + lapse_rate * (z - inv_height - inv_thickness) + end where + + ! Add random numbers + allocate(randArr(size(T,1),size(T,2),size(T,3))) + call gaussian_random(randArr,zero,one,seedu + 10*nrank) + !randArr = cos(4.d0*2.d0*pi*x)*sin(4.d0*2.d0*pi*y) + do k = 1,size(u,3) + sig = 0.08 + Tpurt(:,:,k) = sig*randArr(:,:,k) + end do + deallocate(randArr) + + if(hpert>zero)then + hpert_ = hpert + else + hpert_ = 50.d0/xdim + end if + call message(1,"Perturbing temperature up to ", hpert_) + + where (z > hpert_) + Tpurt = zero + end where + T = T + Tpurt + + deallocate(Tpurt) + + !!!!!!!!!!!!!!!!!!!!! DON'T CHANGE ANYTHING UNDER THIS !!!!!!!!!!!!!!!!!!!!!! + ! Interpolate wC to w + allocate(ybuffC(decompC%ysz(1),decompC%ysz(2), decompC%ysz(3))) + allocate(ybuffE(decompE%ysz(1),decompE%ysz(2), decompE%ysz(3))) + allocate(zbuffC(decompC%zsz(1),decompC%zsz(2), decompC%zsz(3))) + allocate(zbuffE(decompE%zsz(1),decompE%zsz(2), decompE%zsz(3))) + nz = decompC%zsz(3) + nzE = nz + 1 + call transpose_x_to_y(wC,ybuffC,decompC) + call transpose_y_to_z(ybuffC,zbuffC,decompC) + zbuffE = zero + zbuffE(:,:,2:nzE-1) = half*(zbuffC(:,:,1:nz-1) + zbuffC(:,:,2:nz)) + call transpose_z_to_y(zbuffE,ybuffE,decompE) + call transpose_y_to_x(ybuffE,w,decompE) + ! Deallocate local memory + deallocate(ybuffC,ybuffE,zbuffC, zbuffE) + nullify(u,v,w,x,y,z) + call message(0,"Velocity Field Initialized") + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +end subroutine + +subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) + use kind_parameters, only: rkind + use constants, only: one, zero + implicit none + + character(len=*), intent(in) :: inputfile + real(rkind), intent(out) :: wTh_surf + integer :: ioUnit + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, dTsurf_dt = zero, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero, hpert=zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + ! Do nothing since temperature BC is dirichlet +end subroutine + +subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) + use kind_parameters, only: rkind + use pre_conc_compact_budgets_parameters + use constants, only: one, zero + implicit none + real(rkind), intent(out) :: Tsurf, dTsurf_dt + character(len=*), intent(in) :: inputfile + integer :: ioUnit + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero, hpert=zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + dTsurf_dt = dTsurf_dt / 3600.d0 + + ! Normalize + dTsurf_dt = dTsurf_dt * timeDim + + Tsurf = Tsurf0 +end subroutine + +subroutine set_planes_io(xplanes, yplanes, zplanes) + implicit none + integer, dimension(:), allocatable, intent(inout) :: xplanes + integer, dimension(:), allocatable, intent(inout) :: yplanes + integer, dimension(:), allocatable, intent(inout) :: zplanes + integer, parameter :: nxplanes = 1, nyplanes = 1, nzplanes = 1 + + allocate(xplanes(nxplanes), yplanes(nyplanes), zplanes(nzplanes)) + + xplanes = [64] + yplanes = [64] + zplanes = [256] + +end subroutine + +subroutine hook_probes(inputfile, probe_locs) + use kind_parameters, only: rkind + real(rkind), dimension(:,:), allocatable, intent(inout) :: probe_locs + character(len=*), intent(in) :: inputfile + integer, parameter :: nprobes = 2 + + ! IMPORTANT : Convention is to allocate probe_locs(3,nprobes) + ! Example: If you have at least 3 probes: + ! probe_locs(1,3) : x -location of the third probe + ! probe_locs(2,3) : y -location of the third probe + ! probe_locs(3,3) : z -location of the third probe + + + ! Add probes here if needed + ! Example code: The following allocates 2 probes at (0.1,0.1,0.1) and + ! (0.2,0.2,0.2) + allocate(probe_locs(3,nprobes)) + probe_locs(1,1) = 0.1d0; probe_locs(2,1) = 0.1d0; probe_locs(3,1) = 0.1d0; + probe_locs(1,2) = 0.2d0; probe_locs(2,2) = 0.2d0; probe_locs(3,2) = 0.2d0; + +end subroutine + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!! THE SUBROUTINES UNDER THIS DON'T TYPICALLY NEED TO BE CHANGED !!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) + use pre_conc_compact_budgets_parameters + use kind_parameters, only: rkind + use constants, only: zero, one, two + use decomp_2d, only: decomp_info + implicit none + + type(decomp_info), intent(in) :: decomp + real(rkind), intent(inout) :: dx,dy,dz + real(rkind), dimension(:,:,:,:), intent(inout) :: mesh + integer :: i,j,k, ioUnit + character(len=*), intent(in) :: inputfile + integer :: ix1, ixn, iy1, iyn, iz1, izn + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, dTsurf_dt = zero, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero, hpert=zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + !Lx = two*pi; Ly = two*pi; Lz = one + + nxg = decomp%xsz(1); nyg = decomp%ysz(2); nzg = decomp%zsz(3) + + ! If base decomposition is in Y + ix1 = decomp%xst(1); iy1 = decomp%xst(2); iz1 = decomp%xst(3) + ixn = decomp%xen(1); iyn = decomp%xen(2); izn = decomp%xen(3) + + associate( x => mesh(:,:,:,1), y => mesh(:,:,:,2), z => mesh(:,:,:,3) ) + + dx = Lx/real(nxg,rkind) + dy = Ly/real(nyg,rkind) + dz = Lz/real(nzg,rkind) + + do k=1,size(mesh,3) + do j=1,size(mesh,2) + do i=1,size(mesh,1) + x(i,j,k) = real( ix1 + i - 1, rkind ) * dx + y(i,j,k) = real( iy1 + j - 1, rkind ) * dy + z(i,j,k) = real( iz1 + k - 1, rkind ) * dz + dz/two + end do + end do + end do + + ! Shift everything to the origin + x = x - dx + y = y - dy + z = z - dz + + end associate + +end subroutine + +subroutine set_Reference_Temperature(inputfile, Thetaref) + use kind_parameters, only: rkind + use constants, only: one, zero + implicit none + character(len=*), intent(in) :: inputfile + real(rkind), intent(out) :: Thetaref + integer :: ioUnit + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, dTsurf_dt = zero, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero, hpert=zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate, hpert + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + Thetaref = Tref + ! This will set the value of Tref. + +end subroutine + +subroutine set_KS_planes_io(planesCoarseGrid, planesFineGrid) + integer, dimension(:), allocatable, intent(inout) :: planesFineGrid + integer, dimension(:), allocatable, intent(inout) :: planesCoarseGrid + + allocate(planesCoarseGrid(1), planesFineGrid(1)) + planesCoarseGrid = [8] + planesFineGrid = [16] + +end subroutine + +subroutine initScalar(decompC, inpDirectory, mesh, scalar_id, scalarField) + use kind_parameters, only: rkind + use decomp_2d, only: decomp_info + type(decomp_info), intent(in) :: decompC + character(len=*), intent(in) :: inpDirectory + real(rkind), dimension(:,:,:,:), intent(in) :: mesh + integer, intent(in) :: scalar_id + real(rkind), dimension(:,:,:), intent(out) :: scalarField + + scalarField = 0.d0 +end subroutine + +subroutine setScalar_source(decompC, inpDirectory, mesh, scalar_id, scalarSource) + use kind_parameters, only: rkind + use decomp_2d, only: decomp_info + type(decomp_info), intent(in) :: decompC + character(len=*), intent(in) :: inpDirectory + real(rkind), dimension(:,:,:,:), intent(in) :: mesh + integer, intent(in) :: scalar_id + real(rkind), dimension(:,:,:), intent(out) :: scalarSource + + scalarSource = 0.d0 +end subroutine \ No newline at end of file diff --git a/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 b/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 new file mode 100644 index 00000000..784529eb --- /dev/null +++ b/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 @@ -0,0 +1,103 @@ +module temporalHook + use kind_parameters, only: rkind + use IncompressibleGrid, only: igrid + use reductions, only: P_MAXVAL, p_minval + use exits, only: message, message_min_max, GracefulExit + use constants, only: half + use timer, only: tic, toc + use mpi + use decomp_2d + use reductions, only: p_sum + + implicit none + + integer :: i, j, nt_print2screen = 1 + real(rkind) :: maxDiv, DomMaxDiv, angle + integer :: ierr + +contains + + subroutine doTemporalStuff(gp, simid) + class(igrid), intent(inout) :: gp + integer, intent(in) :: simid + real(rkind) :: global_min, global_max, maxu + + if (mod(gp%step,nt_print2screen) == 0) then + maxDiv = maxval(gp%divergence) + DomMaxDiv = p_maxval(maxDiv) + select case (simid) + case (1) + call message(0,"Primary Simulation Info:") + case (2) + call message(0,"Concurrent Simulation Info:") + end select + call message(0,"Time",gp%tsim) + call message(1,"TIDX:",gp%step) + call message(1,"MaxDiv:",DomMaxDiv) + call message(1,"u_star:",gp%sgsmodel%get_ustar()) + call message(1,"Inv. Ob. Len:",gp%sgsmodel%get_InvObLength()) + call message(1,"Surface Flux (K*nd velocity):",gp%wTh_surf) + + global_min = p_minval(minval(gp%u)) + global_max = p_maxval(maxval(gp%u)) + maxu = global_max + call message_min_max(1,"Bounds for u:", global_min, global_max) + + global_min = p_minval(minval(gp%v)) + global_max = p_maxval(maxval(gp%v)) + call message_min_max(1,"Bounds for v:", global_min, global_max) + + global_min = p_minval(minval(gp%w)) + global_max = p_maxval(maxval(gp%w)) + call message_min_max(1,"Bounds for w:", global_min, global_max) + + if ((simid == 1) .and. (gp%useWindTurbines)) then + call message(0,"Wind direction hub height", gp%WindTurbineArr%windAngle) + end if + + ! add controller print statements, if the controller is used + if (gp%useControl) then + call message(1, "Current angle controller Phi:", gp%angCont_yaw%getPhi()) + call message(1, "Frame angle:" , gp%frameAngle) + call message(1, "Current wind angle:", gp%angCont_yaw%getPhiHub()) + end if + + if (gp%useCFL) then + call message(1,"Current dt:",gp%dt) + end if + call message(0,"------------------------------------------") + if (simid == 1) then + if (allocated(gp%scalars)) then + global_min = p_minval(minval(gp%scalars(1)%F)) + global_max = p_maxval(maxval(gp%scalars(1)%F)) + call message_min_max(1,"Bounds for SCALAR 1:", global_min, global_max) + + global_min = p_minval(minval(gp%scalars(2)%F)) + global_max = p_maxval(maxval(gp%scalars(2)%F)) + call message_min_max(1,"Bounds for SCALAR 2:", global_min, global_max) + + global_min = p_minval(minval(gp%scalars(3)%F)) + global_max = p_maxval(maxval(gp%scalars(3)%F)) + call message_min_max(1,"Bounds for SCALAR 3:", global_min, global_max) + end if + + if (maxu>4.) then + call message(1, "this step has blown up", gp%tsim) + call gp%dumpFullField(gp%u,"uVel") + call gp%dumpFullField(gp%v,"vVel") + call gp%dumpFullField(gp%wC,"wVel") + call gp%dumpFullField(gp%T, "potT") + call gp%dumpFullField(gp%T, "prss") + call GracefulExit("u-velocity has blown up",1) + end if + elseif (simid == 2) then + call toc() + call tic() + end if + end if + + end subroutine + + + +end module diff --git a/problems/turbines/stable_pbl_concurrent.F90 b/problems/turbines/stable_pbl_concurrent.F90 new file mode 100644 index 00000000..e95d515f --- /dev/null +++ b/problems/turbines/stable_pbl_concurrent.F90 @@ -0,0 +1,138 @@ +! Concurrent-precursor problem for inhomogeneous Dirichlet +! boundary conditions in the stable PBL with wind turbines. + +#include "stable_pbl_concurrent_files/initialize.F90" +#include "stable_pbl_concurrent_files/temporalHook.F90" + +program stable_pbl_concurrent + use mpi + use kind_parameters, only: clen, rkind + use IncompressibleGrid, only: igrid + use temporalhook, only: doTemporalStuff + use timer, only: tic, toc + use budgets_time_avg_mod, only: budgets_time_avg + use budgets_time_avg_deficit_mod, only: budgets_time_avg_deficit + use exits, only: message, gracefulExit + + implicit none + + type(igrid), allocatable, target :: primary, precursor + character(len=clen) :: inputfile, primary_inputfile, precursor_inputfile + integer :: ierr, ioUnit + type(budgets_time_avg) :: budg_tavg, pre_budg_tavg + type(budgets_time_avg_deficit) :: budg_tavg_deficit + real(rkind) :: dt1, dt2, dt + logical :: synchronize_RK_fringe = .true., do_deficit_budgets = .false. + + namelist /concurrent/ primary_inputfile, precursor_inputfile, synchronize_RK_fringe, do_deficit_budgets + + call MPI_Init(ierr) !<-- Begin MPI + call GETARG(1,inputfile) !<-- Get the location of the input file + + allocate(precursor) !<-- Allocate precursor + allocate(primary) !<-- Allocate primary + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=concurrent) + close(ioUnit) + + call compute_xdim_udim(primary_inputFile) !<-- Reads the \PHYSICS\ namelist to compute (xdim, udim) from (Ro, Fr) + + ! INITIALIZE PRIMARY SIMULATION + call primary%init(primary_inputFile, .true.) + call primary%start_io(.false.) ! do not dump IO fields on init (avoid overwriting turbine data) + call primary%printDivergence() + + ! INITIALIZE PRECURSOR SIMULATION + call precursor%init(precursor_inputFile, .false.) + precursor%Am_I_Primary = .false. + call precursor%start_io(.true.) + + if (primary%usefringe) then + call primary%fringe_x%associateFringeTargets(precursor%u, precursor%v, precursor%w, precursor%T) + call primary%fringe_x%associateFringeTarget_scalar(precursor%T) + end if + + if (primary%useControl .AND. primary%dummy_controller)then + if(.NOT. precursor%useControl)then + call gracefulExit("Primary has a dummy controller, but precursor does not have a controller at all. Exiting.", 44) + elseif(precursor%dummy_controller) then + call gracefulExit("Both Primary and Precursor have dummy controllers. Exiting.", 44) + else + if(.NOT. allocated(precursor%angCont_yaw))then + call gracefulExit("Precursor does not have an active controller, and Primary has a dummy controller. Exiting.", 44) + end if + ! Point to the precursor's controller + primary%angCont_yaw_dummy => precursor%angCont_yaw + call message(0, 'Dummy controller points to main controller.') + end if + end if + + call budg_tavg%init(primary_inputfile, primary) !<-- Budget class initialization + call pre_budg_tavg%init(precursor_inputfile, precursor) !<-- Budget class initialization + if (do_deficit_budgets) then !<-- Budget class initialization for the deficit + call budg_tavg_deficit%init(pre_budg_tavg, primary_inputfile, budg_tavg) + end if + + if (primary%useWindTurbines) then + call primary%WindTurbineArr%link_reference_domain_for_control(primary%u, primary%v, primary%rbuffyC, primary%rbuffzC, primary%gpC) + end if + + call message("==========================================================") + call message(0, "All memory allocated! Now running the simulation.") + call tic() + do while (primary%tsim < primary%tstop) + dt1 = primary%get_dt(recompute=.true.) + dt2 = precursor%get_dt(recompute=.true.) + dt = min(dt1, dt2) + + if (synchronize_RK_fringe) then + primary%dt = dt + precursor%dt = dt + ! Stage 1 + call primary%advance_SSP_RK45_Stage_1() + call precursor%advance_SSP_RK45_Stage_1() + ! Stage 2 + call primary%advance_SSP_RK45_Stage_2() + call precursor%advance_SSP_RK45_Stage_2() + ! Stage 3 + call primary%advance_SSP_RK45_Stage_3() + call precursor%advance_SSP_RK45_Stage_3() + ! Stage 4 + call primary%advance_SSP_RK45_Stage_4() + call precursor%advance_SSP_RK45_Stage_4() + ! Stage 5 + call primary%advance_SSP_RK45_Stage_5() + call precursor%advance_SSP_RK45_Stage_5() + ! Call wrap up + call primary%wrapup_timestep() + call precursor%wrapup_timestep() + else + call primary%timeAdvance(dt) + call precursor%timeAdvance(dt) + end if + + call budg_tavg%doBudgets() + call pre_budg_tavg%doBudgets() + if (do_deficit_budgets) call budg_tavg_deficit%doBudgets() + + call doTemporalStuff(primary, 1) + call doTemporalStuff(precursor,2) + + end do + + call budg_tavg%destroy() !<-- release memory taken by the budget classes + call pre_budg_tavg%destroy() + if (do_deficit_budgets) call budg_tavg_deficit%destroy() + + call precursor%finalize_io() + call primary%finalize_io() + + call precursor%destroy() + call primary%destroy() + + deallocate(precursor, primary) + + call MPI_Finalize(ierr) + +end program \ No newline at end of file diff --git a/problems/turbines/stable_pbl_concurrent_files/initialize.F90 b/problems/turbines/stable_pbl_concurrent_files/initialize.F90 new file mode 100644 index 00000000..98353c93 --- /dev/null +++ b/problems/turbines/stable_pbl_concurrent_files/initialize.F90 @@ -0,0 +1,347 @@ +module stable_pbl_parameters + + ! TAKE CARE OF TIME NON-DIMENSIONALIZATION IN THIS MODULE + + use exits, only: message + use kind_parameters, only: rkind + use constants, only: zero, kappa, pi + implicit none + integer :: seedu = 321341 + integer :: seedv = 423424 + integer :: seedw = 131344 + real(rkind) :: randomScaleFact = 0.002_rkind ! 0.2% of the mean value + integer :: nxg, nyg, nzg + + real(rkind) :: xdim = 400._rkind, udim =8._rkind ! default values, overwritten in compute_xdim_udim + real(rkind) :: timeDim = zero + real(rkind), parameter :: g = 9.81_rkind, omega = 0.0000729_rkind ! dimensionalizing values g (gravity) and omega (rotation rate) +end module + +subroutine compute_xdim_udim(inputfile) + use kind_parameters, only: rkind, clen + use stable_pbl_parameters, only: xdim, udim, timeDim, g, omega, message + character(len=*), intent(in) :: inputfile + character(len=:), allocatable :: buffer + character(len=clen) :: line + real(rkind) :: Ro, Fr + integer :: iunit + + namelist /PHYSICS/Ro, Fr ! ignore all other variables + + ! All this work is just so we don't need to read ALL of the &PHYSICS namelist... + ! What we are doing here is finding JUST the variables "Fr" and "Ro" and making a + ! new internal namelist to parse + buffer = "&PHYSICS" // new_line('a') + open(unit=10, file=trim(inputfile), form='formatted') + do + read(10,'(A)', iostat=iunit) line + if (iunit /= 0) exit + ! find lines beginning with "Fr " or "Ro ": + if (index(adjustl(line), "Fr ") == 1 .or. index(adjustl(line), "Ro ") == 1) then + ! strip comments: + if (index(line, "!") > 0) line = line(:index(line, "!")-1) + buffer = buffer // trim(adjustl(line)) // new_line('a') + end if + end do + buffer = buffer // "/" // new_line('a') + close(10) + + read(buffer, NML=PHYSICS) + + xdim = g * (Fr / Ro / omega)**2 + udim = g * Fr**2 / omega / Ro + timeDim = xdim/udim + + ! For some reason, the following lines print once per processor, so I've just commented them out: + ! if (nrank == 0) then + ! call message(0, "Computed the following dimensional values from the Rossby and Froude numbers:") + ! call message(1, " xdim", xdim) + ! call message(1, " udim", udim) + ! call message(1, " timeDim", timeDim) + ! end if +end subroutine + +subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) + use kind_parameters, only: rkind + use constants, only: zero, one, two, half + use gridtools, only: alloc_buffs + use random, only: gaussian_random + use decomp_2d + use reductions, only: p_maxval + use stable_pbl_parameters, only: xdim, seedu, message + implicit none + type(decomp_info), intent(in) :: decompC + type(decomp_info), intent(in) :: decompE + character(len=*), intent(in) :: inputfile + real(rkind), dimension(:,:,:,:), intent(in), target :: mesh + real(rkind), dimension(:,:,:,:), intent(inout), target :: fieldsC + real(rkind), dimension(:,:,:,:), intent(inout), target :: fieldsE + integer :: ioUnit + real(rkind), dimension(:,:,:), pointer :: u, v, w, wC, T, x, y, z + real(rkind), dimension(:,:,:), allocatable :: ybuffC, ybuffE, zbuffC, zbuffE, ztmp + integer :: nz, nzE, k + real(rkind) :: sig + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z_Tref = zero, T_inv = zero, dTdz = zero + real(rkind), dimension(:,:,:), allocatable :: randArr, Tpurt, eta + + ! NOTE: Although `xdim` is computed, z_Tref and dTdz are still w.r.t. non-dim length scale for consistency with `neutral_pbl` + ! only temperature and time are dimensional inputs in this namelist + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z_Tref, T_inv, dTdz + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + !!!!!!!!!!!!!!!!!!!!! DON'T CHANGE THE POINTERS / ALLOCATIONS !!!!!!!!!!!!!!!!!!!!!! + u => fieldsC(:,:,:,1); v => fieldsC(:,:,:,2); wC => fieldsC(:,:,:,3) + w => fieldsE(:,:,:,1); T => fieldsC(:,:,:,7) + z => mesh(:,:,:,3); y => mesh(:,:,:,2); x => mesh(:,:,:,1) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + u = one + v = zero + wC = zero + + allocate(ztmp(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) + allocate(Tpurt(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) + ztmp = z*xDim + T = dTdz*(z - z_Tref) + Tsurf0 + T_inv + where(z < z_Tref) + T = Tsurf0 + end where + + ! Add random numbers + allocate(randArr(size(T,1),size(T,2),size(T,3))) + call gaussian_random(randArr,zero,one,seedu + 10*nrank) + !randArr = cos(4.d0*2.d0*pi*x)*sin(4.d0*2.d0*pi*y) + do k = 1,size(u,3) + sig = 0.08 + Tpurt(:,:,k) = sig*randArr(:,:,k) + end do + deallocate(randArr) + + where (ztmp > 50.d0) + Tpurt = zero + end where + T = T + Tpurt + + deallocate(ztmp, Tpurt) + + !!!!!!!!!!!!!!!!!!!!! DON'T CHANGE ANYTHING UNDER THIS !!!!!!!!!!!!!!!!!!!!!! + ! Interpolate wC to w + allocate(ybuffC(decompC%ysz(1),decompC%ysz(2), decompC%ysz(3))) + allocate(ybuffE(decompE%ysz(1),decompE%ysz(2), decompE%ysz(3))) + allocate(zbuffC(decompC%zsz(1),decompC%zsz(2), decompC%zsz(3))) + allocate(zbuffE(decompE%zsz(1),decompE%zsz(2), decompE%zsz(3))) + nz = decompC%zsz(3) + nzE = nz + 1 + call transpose_x_to_y(wC,ybuffC,decompC) + call transpose_y_to_z(ybuffC,zbuffC,decompC) + zbuffE = zero + zbuffE(:,:,2:nzE-1) = half*(zbuffC(:,:,1:nz-1) + zbuffC(:,:,2:nz)) + call transpose_z_to_y(zbuffE,ybuffE,decompE) + call transpose_y_to_x(ybuffE,w,decompE) + ! Deallocate local memory + deallocate(ybuffC,ybuffE,zbuffC, zbuffE) + nullify(u,v,w,x,y,z) + call message(0,"Velocity Field Initialized") + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +end subroutine + +subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) + use kind_parameters, only: rkind + use constants, only: one, zero + implicit none + + character(len=*), intent(in) :: inputfile + real(rkind), intent(out) :: wTh_surf + integer :: ioUnit + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt, z_Tref, T_inv, dTdz + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z_Tref, T_inv, dTdz + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + ! Do nothing since temperature BC is dirichlet +end subroutine + +subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) + use kind_parameters, only: rkind + use stable_pbl_parameters, only: timeDim + use constants, only: one, zero + implicit none + real(rkind), intent(out) :: Tsurf, dTsurf_dt + character(len=*), intent(in) :: inputfile + integer :: ioUnit + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, z_Tref, T_inv, dTdz + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z_Tref, T_inv, dTdz + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + dTsurf_dt = dTsurf_dt / 3600.d0 + + ! Normalize + dTsurf_dt = dTsurf_dt * timeDim + + Tsurf = Tsurf0 +end subroutine + +subroutine set_planes_io(xplanes, yplanes, zplanes) + implicit none + integer, dimension(:), allocatable, intent(inout) :: xplanes + integer, dimension(:), allocatable, intent(inout) :: yplanes + integer, dimension(:), allocatable, intent(inout) :: zplanes + integer, parameter :: nxplanes = 1, nyplanes = 1, nzplanes = 1 + + allocate(xplanes(nxplanes), yplanes(nyplanes), zplanes(nzplanes)) + + xplanes = [64] + yplanes = [64] + zplanes = [256] + +end subroutine + +subroutine hook_probes(inputfile, probe_locs) + use kind_parameters, only: rkind + real(rkind), dimension(:,:), allocatable, intent(inout) :: probe_locs + character(len=*), intent(in) :: inputfile + integer, parameter :: nprobes = 2 + + ! IMPORTANT : Convention is to allocate probe_locs(3,nprobes) + ! Example: If you have at least 3 probes: + ! probe_locs(1,3) : x -location of the third probe + ! probe_locs(2,3) : y -location of the third probe + ! probe_locs(3,3) : z -location of the third probe + + + ! Add probes here if needed + ! Example code: The following allocates 2 probes at (0.1,0.1,0.1) and + ! (0.2,0.2,0.2) + allocate(probe_locs(3,nprobes)) + probe_locs(1,1) = 0.1d0; probe_locs(2,1) = 0.1d0; probe_locs(3,1) = 0.1d0; + probe_locs(1,2) = 0.2d0; probe_locs(2,2) = 0.2d0; probe_locs(3,2) = 0.2d0; + +end subroutine + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!! THE SUBROUTINES UNDER THIS DON'T TYPICALLY NEED TO BE CHANGED !!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) + use stable_pbl_parameters, only: nxg, nyg, nzg + use kind_parameters, only: rkind + use constants, only: zero, one, two + use decomp_2d, only: decomp_info + implicit none + + type(decomp_info), intent(in) :: decomp + real(rkind), intent(inout) :: dx,dy,dz + real(rkind), dimension(:,:,:,:), intent(inout) :: mesh + integer :: i,j,k, ioUnit + character(len=*), intent(in) :: inputfile + integer :: ix1, ixn, iy1, iyn, iz1, izn + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z_Tref, T_inv, dTdz + !real(rkind) :: beta, sigma, phi_ref + !integer :: z_ref + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z_Tref, T_inv, dTdz + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + !Lx = two*pi; Ly = two*pi; Lz = one + + nxg = decomp%xsz(1); nyg = decomp%ysz(2); nzg = decomp%zsz(3) + + ! If base decomposition is in Y + ix1 = decomp%xst(1); iy1 = decomp%xst(2); iz1 = decomp%xst(3) + ixn = decomp%xen(1); iyn = decomp%xen(2); izn = decomp%xen(3) + + associate( x => mesh(:,:,:,1), y => mesh(:,:,:,2), z => mesh(:,:,:,3) ) + + dx = Lx/real(nxg,rkind) + dy = Ly/real(nyg,rkind) + dz = Lz/real(nzg,rkind) + + do k=1,size(mesh,3) + do j=1,size(mesh,2) + do i=1,size(mesh,1) + x(i,j,k) = real( ix1 + i - 1, rkind ) * dx + y(i,j,k) = real( iy1 + j - 1, rkind ) * dy + z(i,j,k) = real( iz1 + k - 1, rkind ) * dz + dz/two + end do + end do + end do + + ! Shift everything to the origin + x = x - dx + y = y - dy + z = z - dz + + end associate + +end subroutine + +subroutine set_Reference_Temperature(inputfile, Thetaref) + use kind_parameters, only: rkind + use constants, only: one, zero + implicit none + character(len=*), intent(in) :: inputfile + real(rkind), intent(out) :: Thetaref + integer :: ioUnit + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z_Tref, T_inv, dTdz + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z_Tref, T_inv, dTdz + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=PROBLEM_INPUT) + close(ioUnit) + + Thetaref = Tref + ! This will set the value of Tref. + +end subroutine + +subroutine set_KS_planes_io(planesCoarseGrid, planesFineGrid) + integer, dimension(:), allocatable, intent(inout) :: planesFineGrid + integer, dimension(:), allocatable, intent(inout) :: planesCoarseGrid + + allocate(planesCoarseGrid(1), planesFineGrid(1)) + planesCoarseGrid = [8] + planesFineGrid = [16] + +end subroutine + +subroutine initScalar(decompC, inpDirectory, mesh, scalar_id, scalarField) + use kind_parameters, only: rkind + use decomp_2d, only: decomp_info + type(decomp_info), intent(in) :: decompC + character(len=*), intent(in) :: inpDirectory + real(rkind), dimension(:,:,:,:), intent(in) :: mesh + integer, intent(in) :: scalar_id + real(rkind), dimension(:,:,:), intent(out) :: scalarField + + scalarField = 0.d0 +end subroutine + +subroutine setScalar_source(decompC, inpDirectory, mesh, scalar_id, scalarSource) + use kind_parameters, only: rkind + use decomp_2d, only: decomp_info + type(decomp_info), intent(in) :: decompC + character(len=*), intent(in) :: inpDirectory + real(rkind), dimension(:,:,:,:), intent(in) :: mesh + integer, intent(in) :: scalar_id + real(rkind), dimension(:,:,:), intent(out) :: scalarSource + + scalarSource = 0.d0 +end subroutine \ No newline at end of file diff --git a/problems/turbines/stable_pbl_concurrent_files/inputs/input_main.dat b/problems/turbines/stable_pbl_concurrent_files/inputs/input_main.dat new file mode 100644 index 00000000..b7d839c7 --- /dev/null +++ b/problems/turbines/stable_pbl_concurrent_files/inputs/input_main.dat @@ -0,0 +1,6 @@ +&CONCURRENT +primary_inputfile = "/scratch/08445/tg877441/test_sbl_concurrent/input_primary.dat" +precursor_inputfile = "/scratch/08445/tg877441/test_sbl_concurrent/input_precursor.dat" +synchronize_RK_fringe = .true. ! Synchronize time-stepping? +do_deficit_budgets = .true. ! turns on time-averaged deficit budgets (namelist in PRIMARY inputfile) +/ \ No newline at end of file diff --git a/problems/turbines/stable_pbl_concurrent_files/inputs/input_precursor.dat b/problems/turbines/stable_pbl_concurrent_files/inputs/input_precursor.dat new file mode 100644 index 00000000..a0d70c16 --- /dev/null +++ b/problems/turbines/stable_pbl_concurrent_files/inputs/input_precursor.dat @@ -0,0 +1,151 @@ +&INPUT +inputdir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Directory for any input files +outputdir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Directory for all output files +nx = 384 ! Number of points in X +ny = 256 ! Number of points in Y +nz = 256 ! Number of points in Z +tstop = 9441.734d0 ! Physical time to stop the simulation +CFL = 1.0D0 ! CFL criterion for calculating the time step (Set to negative to disable) +dt = 0.001D0 ! Fixed time step value (only used if CFL is set to negative) +prow = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +pcol = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +useRestartFile = .True. ! Set to false if it's a fresh simulation +restartFile_TID = 4624 ! TimeID of the restart file being used +restartFile_RID = 2 ! RunID of the restart file being used +/ +/ +&NUMERICS +AdvectionTerm = 1 ! 0: Rotational Form, 1: Skew-Symmetric Form (use this for Compact Scheme) +ComputeStokesPressure = .TRUE. ! This would be FALSE only is very special circumstances. +NumericalSchemeVert = 1 ! 0: Second order FD, 1: Sixth order Compact Difference (CD06) +useDealiasFilterVert = .FALSE. ! Dealiasing filter used in vertical direction +t_DivergenceCheck = 100 ! Check divergence every $ timesteps. Reproject if needed. +TimeSteppingScheme = 2 ! 0: Adams-Bashforth, 1: TVD-RK3 (use this) +useExhaustiveFFT = .TRUE. +/ +/ +&IO +RunID = 4 ! Run Label (All output files will be tagged with this nubber) +t_restartDump = 1000 ! Restart File Dumping Frequency (# of timesteps) +t_dataDump = 1000 ! Data dumping frequency (# of timesteps) +ioType = 0 ! 0: Fortran Binaries, 1: .vtk files +dumpPlanes = .FALSE. ! Dump plane visualations. Select planes in initialize.F90 +t_planeDump = 100 ! Plane dumping frequency (# of timesteps) +t_start_planeDump = 3500 ! When do you want to start dumping planes? +t_stop_planeDump = 5000 ! When do you want to stop dumping planes? +/ +/ +&STATS +tid_StatsDump = 1000 ! Dumping Frequency for Statistics file (# of time steps) +tid_compStats = 100 ! Frequency of Computing Statistics +tSimStartStats = 550.d0 ! Simulation time for starting stats calculations +normStatsByUstar = .FALSE. ! Normalize Statistics by ustar at each instant +computeSpectra = .FALSE. ! Compute and time average x - spectra on the run +timeAvgFullFields = .FALSE. ! Time average and store fields on the run +/ +/ +&OS_INTERACTIONS +useSystemInteractions = .TRUE. ! Do you wish to interact with the program while its running +tSystemInteractions = 10 ! Check for interactions commands after these many time steps +controlDir = "null" ! Check in this directory for command files (NULL = Check in output directory) +/ +/ +&PHYSICS +isInviscid = .TRUE. ! Is this an inviscid simulation? +useCoriolis = .TRUE. ! Activate the coriolis term? +useExtraForcing = .FALSE. ! Is an extra forcing term being used? (non-Geostrophic forcing only) +isStratified = .TRUE. ! Use Stratification / active scalar in momentum +Re = 1.D10 ! Reynolds Number; used when isInvisid is FALSE +Ro = 685.8711d0 ! Rossby Number used when Coriolis is ON +Pr = 0.5000D0 ! Turbulent Prandtl Number; used when +Fr = 0.2473d0 ! Froude number; used when isStratified is TRUE +useSGS = .TRUE. ! Do you want to use the SGS model? +useGeostrophicForcing = .TRUE. ! This is true if forcing is provided using the coriolis term +G_geostrophic = 1.D0 ! Geostrophic wind speed +G_alpha = 0.D0 ! Geostrophic wind angle (degrees, from +x axis) +dPfdx = 0.D0 ! Additional Acceleration in X; used if useExtraForcing is ON +dPfdy = 0.D0 ! Additional Acceleration in Y; used if useExtraForcing is ON +dPfdz = 0.D0 ! Additional Acceleration in Z; used if useExtraForcing is ON +assume_fplane = .TRUE. ! F-plane assumption for horizontal component? +latitude = 45.0000d0 ! latitude +useHITForcing = .FALSE. ! Use an extra forcing term used for HIT? +frameAngle = 0.d0 ! Frame angle (degrees) +/ +/ +&PRESSURE_CALC +fastCalcPressure = .TRUE. ! Compute and store pressure at every time step using the faster algorithm? +storePressure = .FALSE. ! Would you like to compute and store pressure? +P_dumpFreq = 100 ! How often (timesteps) do you want to dump pressure? +P_compFreq = 10 ! How often (timesteps) do you want to compute pressure? +/ +/ +&BCs +botWall = 3 ! no_slip = 1, slip = 2, wall model = 3 +topWall = 2 ! no_slip = 1, slip = 2, wall model = 3 +useSpongeLayer = .TRUE. ! Use a sponge layer at the top +zstSponge = 0.75d0 ! Height above which the sponge layer is active +SpongeTscale = 20.d0 ! e-folding time to dt ratio (somewhere between 10 - 50) +useFringe = .false. ! This is false if simulation is periodic. +botBC_Temp = 0 ! 0: Dirichlet (could be time dependent), 1: Homog. Neumann (no-flux) +useControl = .False. ! Use PI control to fix yaw angle at the height specified below +/ +/ +&CONTROL +beta = 0.03d0 ! 0.08d3,0.0278 Integrator tuning parameter (appropriate non-dimensionalized) +sigma = 3.995d0 ! 3.995d0 Time constant for filter for rotation rate +phi_ref = 0.d0 ! Desired degrees at z_ref +z_ref = 24 ! Index of desired phi_ref +alpha = 0.d0 ! Proportional gain constant +controlType = 1 ! 1: Meneveau 2014, 2: Control G_alpha +angleTrigger = 0.d0 ! Angle at z_ref where control turns on +/ +/ +&SGS_MODEL +SGSModelID = 1 ! 0: smagorinsky (w/ wall function), 1: sigma +Csgs = 0.9d0 ! Model constant (asymptotic value in case wall function is used) +WallModelType = 1 ! 1: Moeng, 2: Bou-zeid et. al. +z0 = 4.166667e-04 ! Roughness length scale (CAUTION: this assumes appropriate non-dimensionalization) +DynamicProcedureType = 0 ! 0: No dynamic procedure, 1: Planar Avg. Dynamic Proc., 2: Global Dynamic Proc. +useVerticalTfilter = .false. ! Use test filtering in vertical direction for dynamic procedure? +DynProcFreq = 5 ! Dynamic procedure used every DYNPROCFREQ timesteps. +useWallDamping = .FALSE. ! Use the Wall Damping Function +ncWall = 3.d0 ! Wall Damping Function Exponent +explicitCalcEdgeEddyViscosity = .false. ! Explicitly calculate or interpolate edge values for eddy viscosity? +/ +/ +&WINDTURBINES +useWindTurbines = .false. ! Do you want to use Wind turbines ? +/ +/ +&KSPREPROCESS +PreprocessForKS = .FALSE. ! Do you want to generate preprocessing files for KS? +/ +/ +&PROBLEM_INPUT +Lx = 32.00000000d0 ! Domain Length (appropriate dimensions/non-dimensionalized) +Ly = 13.33333333d0 ! Domain Width (appropriate dimensions/non-dimensionalized) +Lz = 6.66666667d0 ! Domain Height (appropriate dimensions/non-dimensionalized) +Tref = 300.0000d0 ! Reference Temp. +Tsurf0 = 300.0000d0 ! Surface Temp. (at tsim=0) in K (need to take care of the dimensions) +dTsurf_dt = -0.2500d0 ! Surface Temp. decrease rate in K/hr. (need to take care of the dimensions) +dTdz = 0.7200d0 ! Background potential temperature gradient in K/length (need to take care of the dimensions) +z_Tref = 0.4d0 ! Height (proper units) below which T is constant. +/ +/ +&BUDGET_TIME_AVG +do_budgets = .True. ! Perform budget calculations? +budgetType = 1 ! See type descriptions in budget_xy_avg.F90 +budgets_dir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Write in default output directory +tidx_compute = 1 ! How often should budgets be computed? +tidx_dump = 1000 ! How often should budget files be written to disk? +restart_budgets = .FALSE. ! use existing budget file to restart budget calculations? +restart_rid = 1 ! Restart budget file run index +restart_tid = 170000 ! Restart budget file time index +restart_counter = 16000 ! Restart budget file counter +tidx_budget_start = -1 ! time id to begin budget computations, set <0 to use start time +time_budget_start = 9000.d0 +/ +/ +&BUDGET_XY_AVG +do_budgets = .FALSE. ! Perform budget calculations? +/ \ No newline at end of file diff --git a/problems/turbines/stable_pbl_concurrent_files/inputs/input_primary.dat b/problems/turbines/stable_pbl_concurrent_files/inputs/input_primary.dat new file mode 100644 index 00000000..9f01b359 --- /dev/null +++ b/problems/turbines/stable_pbl_concurrent_files/inputs/input_primary.dat @@ -0,0 +1,177 @@ +&INPUT +inputdir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Directory for any input files +outputdir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Directory for all output files +nx = 384 ! Number of points in X +ny = 256 ! Number of points in Y +nz = 256 ! Number of points in Z +tstop = 9441.734d0 ! Physical time to stop the simulation +CFL = 1.0D0 ! CFL criterion for calculating the time step (Set to negative to disable) +dt = 0.001D0 ! Fixed time step value (only used if CFL is set to negative) +prow = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +pcol = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +useRestartFile = .True. ! Set to false if it's a fresh simulation +restartFile_TID = 4624 ! TimeID of the restart file being used +restartFile_RID = 2 ! RunID of the restart file being used +/ +/ +&NUMERICS +AdvectionTerm = 1 ! 0: Rotational Form, 1: Skew-Symmetric Form (use this for Compact Scheme) +ComputeStokesPressure = .TRUE. ! This would be FALSE only is very special circumstances. +NumericalSchemeVert = 1 ! 0: Second order FD, 1: Sixth order Compact Difference (CD06) +useDealiasFilterVert = .FALSE. ! Dealiasing filter used in vertical direction +t_DivergenceCheck = 100 ! Check divergence every $ timesteps. Reproject if needed. +TimeSteppingScheme = 2 ! 0: Adams-Bashforth, 1: TVD-RK3 (use this) +useExhaustiveFFT = .TRUE. +/ +/ +&IO +RunID = 5 ! Run Label (All output files will be tagged with this nubber) +t_restartDump = 1000 ! Restart File Dumping Frequency (# of timesteps) +t_dataDump = 1000 ! Data dumping frequency (# of timesteps) +ioType = 0 ! 0: Fortran Binaries, 1: .vtk files +dumpPlanes = .FALSE. ! Dump plane visualations. Select planes in initialize.F90 +t_planeDump = 100 ! Plane dumping frequency (# of timesteps) +t_start_planeDump = 3500 ! When do you want to start dumping planes? +t_stop_planeDump = 5000 ! When do you want to stop dumping planes? +/ +/ +&STATS +tid_StatsDump = 1000 ! Dumping Frequency for Statistics file (# of time steps) +tid_compStats = 100 ! Frequency of Computing Statistics +tSimStartStats = 550.d0 ! Simulation time for starting stats calculations +normStatsByUstar = .FALSE. ! Normalize Statistics by ustar at each instant +computeSpectra = .FALSE. ! Compute and time average x - spectra on the run +timeAvgFullFields = .FALSE. ! Time average and store fields on the run +/ +/ +&OS_INTERACTIONS +useSystemInteractions = .TRUE. ! Do you wish to interact with the program while its running +tSystemInteractions = 10 ! Check for interactions commands after these many time steps +controlDir = "null" ! Check in this directory for command files (NULL = Check in output directory) +/ +/ +&PHYSICS +isInviscid = .TRUE. ! Is this an inviscid simulation? +useCoriolis = .TRUE. ! Activate the coriolis term? +useExtraForcing = .FALSE. ! Is an extra forcing term being used? (non-Geostrophic forcing only) +isStratified = .TRUE. ! Use Stratification / active scalar in momentum +Re = 1.D10 ! Reynolds Number; used when isInvisid is FALSE +Ro = 685.8711d0 ! Rossby Number used when Coriolis is ON +Pr = 0.5000D0 ! Turbulent Prandtl Number; used when +Fr = 0.2473d0 ! Froude number; used when isStratified is TRUE +useSGS = .TRUE. ! Do you want to use the SGS model? +useGeostrophicForcing = .TRUE. ! This is true if forcing is provided using the coriolis term +G_geostrophic = 1.D0 ! Geostrophic wind speed +G_alpha = 0.D0 ! Geostrophic wind angle (degrees, from +x axis) +dPfdx = 0.D0 ! Additional Acceleration in X; used if useExtraForcing is ON +dPfdy = 0.D0 ! Additional Acceleration in Y; used if useExtraForcing is ON +dPfdz = 0.D0 ! Additional Acceleration in Z; used if useExtraForcing is ON +assume_fplane = .TRUE. ! F-plane assumption for horizontal component? +latitude = 45.0000d0 ! latitude +useHITForcing = .FALSE. ! Use an extra forcing term used for HIT? +frameAngle = 0.d0 ! Frame angle (degrees) +/ +/ +&PRESSURE_CALC +fastCalcPressure = .TRUE. ! Compute and store pressure at every time step using the faster algorithm? +storePressure = .FALSE. ! Would you like to compute and store pressure? +P_dumpFreq = 100 ! How often (timesteps) do you want to dump pressure? +P_compFreq = 10 ! How often (timesteps) do you want to compute pressure? +/ +/ +&BCs +botWall = 3 ! no_slip = 1, slip = 2, wall model = 3 +topWall = 2 ! no_slip = 1, slip = 2, wall model = 3 +useSpongeLayer = .TRUE. ! Use a sponge layer at the top +zstSponge = 0.75d0 ! Height above which the sponge layer is active +SpongeTscale = 20.d0 ! e-folding time to dt ratio (somewhere between 10 - 50) +useFringe = .true. ! This is false if simulation is periodic. +botBC_Temp = 0 ! 0: Dirichlet (could be time dependent), 1: Homog. Neumann (no-flux) +useControl = .False. ! Use PI control to fix yaw angle at the height specified below +/ +/ +&CONTROL +beta = 0.03d0 ! 0.08d3,0.0278 Integrator tuning parameter (appropriate non-dimensionalized) +sigma = 3.995d0 ! 3.995d0 Time constant for filter for rotation rate +phi_ref = 0.d0 ! Desired degrees at z_ref +z_ref = 24 ! Index of desired phi_ref +alpha = 0.d0 ! Proportional gain constant +controlType = 1 ! 1: Meneveau 2014, 2: Control G_alpha +angleTrigger = 0.d0 ! Angle at z_ref where control turns on +/ +/ +&FRINGE +Fringe_xst = 0.75d0 +Fringe_xen = 0.97d0 +Fringe_delta_st_x = 0.1d0 +Fringe_delta_en_x = 0.05d0 +LambdaFact = 0.5d0 +/ +/ +&SGS_MODEL +SGSModelID = 1 ! 0: smagorinsky (w/ wall function), 1: sigma +Csgs = 0.9d0 ! Model constant (asymptotic value in case wall function is used) +WallModelType = 1 ! 1: Moeng, 2: Bou-zeid et. al. +z0 = 4.166667e-04 ! Roughness length scale (CAUTION: this assumes appropriate non-dimensionalization) +DynamicProcedureType = 0 ! 0: No dynamic procedure, 1: Planar Avg. Dynamic Proc., 2: Global Dynamic Proc. +useVerticalTfilter = .false. ! Use test filtering in vertical direction for dynamic procedure? +DynProcFreq = 5 ! Dynamic procedure used every DYNPROCFREQ timesteps. +useWallDamping = .FALSE. ! Use the Wall Damping Function +ncWall = 3.d0 ! Wall Damping Function Exponent +explicitCalcEdgeEddyViscosity = .false. ! Explicitly calculate or interpolate edge values for eddy viscosity? +/ +/ +&WINDTURBINES +useWindTurbines = .true. ! Do you want to use Wind turbines ? +num_turbines = 1 ! How many turbines? +ADM = .TRUE. ! Are these actuator disks? +ADM_Type = 5 +turbInfoDir = "/scratch/08445/tg877441/test_sbl_concurrent/turbines" ! Where are the turbine info files located? +/ +/ +&KSPREPROCESS +PreprocessForKS = .FALSE. ! Do you want to generate preprocessing files for KS? +/ +/ +&PROBLEM_INPUT +Lx = 32.00000000d0 ! Domain Length (appropriate dimesnions/non-dimensionalized) +Ly = 13.33333333d0 ! Domain Width (appropriate dimesnions/non-dimensionalized) +Lz = 6.66666667d0 ! Domain Height (appropriate dimesnions/non-dimensionalized) +Tref = 300.0000d0 ! Reference Temp. +Tsurf0 = 300.0000d0 ! Surface Temp. (at tsim=0) in K (need to take care of the dimensions) +dTsurf_dt = -0.2500d0 ! Surface Temp. decrease rate in K/hr. (need to take care of the dimensions) +dTdz = 0.7200d0 ! Background potential temperature gradient in K/length (need to take care of the dimensions) +z_Tref = 0.4d0 ! Height (proper units) below which T is constant. +/ +/ +&BUDGET_TIME_AVG +do_budgets = .True. ! Perform budget calculations? +budgetType = 1 ! See type descriptions in budget_xy_avg.F90 +budgets_dir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Write in default output directory +tidx_compute = 1 ! How often should budgets be computed? +tidx_dump = 1000 ! How often should budget files be written to disk? +restart_budgets = .FALSE. ! use existing budget file to restart budget calculations? +restart_rid = 1 ! Restart budget file run index +restart_tid = 170000 ! Restart budget file time index +restart_counter = 16000 ! Restart budget file counter +tidx_budget_start = -1 ! time id to begin budget computations, set <0 to use start time +time_budget_start = 9000.d0 +/ +/ +&BUDGET_XY_AVG +do_budgets = .FALSE. ! Perform budget calculations? +/ +/ +&BUDGET_TIME_AVG_DEFICIT +do_budgets = .True. ! Perform budget calculations? +budgetType = 1 ! See type descriptions in budget_xy_avg.F90 +budgets_dir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Write in default output directory +tidx_compute = 1 ! How often should budgets be computed? +tidx_dump = 1000 ! How often should budget files be written to disk? +restart_budgets = .FALSE. ! use existing budget file to restart budget calculations? +restart_rid = 1 ! Restart budget file run index +restart_tid = 170000 ! Restart budget file time index +restart_counter = 16000 ! Restart budget file counter +tidx_budget_start = -1 ! time id to begin budget computations, set <0 to use start time +time_budget_start = 9000.d0 +/ \ No newline at end of file diff --git a/problems/turbines/stable_pbl_concurrent_files/inputs/input_stable.dat b/problems/turbines/stable_pbl_concurrent_files/inputs/input_stable.dat new file mode 100644 index 00000000..14d8b5ad --- /dev/null +++ b/problems/turbines/stable_pbl_concurrent_files/inputs/input_stable.dat @@ -0,0 +1,160 @@ +&INPUT +inputdir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Directory for any input files +outputdir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Directory for all output files +nx = 384 ! Number of points in X +ny = 256 ! Number of points in Y +nz = 256 ! Number of points in Z +tstop = 8500.d0 ! Physical time to stop the simulation +CFL = 1.0D0 ! CFL criterion for calculating the time step (Set to negative to disable) +dt = 0.001D0 ! Fixed time step value (only used if CFL is set to negative) +prow = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +pcol = 0 ! Number of rows in 2D processor decomposition (set 0 for auto-tuning) +useRestartFile = .False. ! Set to false if it's a fresh simulation +restartFile_TID = 0 ! TimeID of the restart file being used +restartFile_RID = 2 ! RunID of the restart file being used +/ +/ +&NUMERICS +AdvectionTerm = 1 ! 0: Rotational Form, 1: Skew-Symmetric Form (use this for Compact Scheme) +ComputeStokesPressure = .TRUE. ! This would be FALSE only is very special circumstances. +NumericalSchemeVert = 1 ! 0: Second order FD, 1: Sixth order Compact Difference (CD06) +useDealiasFilterVert = .FALSE. ! Dealiasing filter used in vertical direction +t_DivergenceCheck = 100 ! Check divergence every $ timesteps. Reproject if needed. +TimeSteppingScheme = 2 ! 0: Adams-Bashforth, 1: TVD-RK3 (use this) +useExhaustiveFFT = .TRUE. +/ +/ +&IO +RunID = 2 ! Run Label (All output files will be tagged with this nubber) +t_restartDump = 2000 ! Restart File Dumping Frequency (# of timesteps) +t_dataDump = 2000 ! Data dumping frequency (# of timesteps) +ioType = 0 ! 0: Fortran Binaries, 1: .vtk files +dumpPlanes = .FALSE. ! Dump plane visualations. Select planes in initialize.F90 +t_planeDump = 100 ! Plane dumping frequency (# of timesteps) +t_start_planeDump = 3500 ! When do you want to start dumping planes? +t_stop_planeDump = 5000 ! When do you want to stop dumping planes? +/ +/ +&STATS +tid_StatsDump = 1000 ! Dumping Frequency for Statistics file (# of time steps) +tid_compStats = 100 ! Frequency of Computing Statistics +tSimStartStats = 550.d0 ! Simulation time for starting stats calculations +normStatsByUstar = .FALSE. ! Normalize Statistics by ustar at each instant +computeSpectra = .FALSE. ! Compute and time average x - spectra on the run +timeAvgFullFields = .FALSE. ! Time average and store fields on the run +/ +/ +&OS_INTERACTIONS +useSystemInteractions = .TRUE. ! Do you wish to interact with the program while its running +tSystemInteractions = 10 ! Check for interactions commands after these many time steps +controlDir = "null" ! Check in this directory for command files (NULL = Check in output directory) +/ +/ +&PHYSICS +isInviscid = .TRUE. ! Is this an inviscid simulation? +useCoriolis = .TRUE. ! Activate the coriolis term? +useExtraForcing = .FALSE. ! Is an extra forcing term being used? (non-Geostrophic forcing only) +isStratified = .TRUE. ! Use Stratification / active scalar in momentum +Re = 1.D10 ! Reynolds Number; used when isInvisid is FALSE +Ro = 685.8711d0 ! Rossby Number used when Coriolis is ON +Pr = 0.5000D0 ! Turbulent Prandtl Number; used when +Fr = 0.2473d0 ! Froude number; used when isStratified is TRUE +useSGS = .TRUE. ! Do you want to use the SGS model? +useGeostrophicForcing = .TRUE. ! This is true if forcing is provided using the coriolis term +G_geostrophic = 1.D0 ! Geostrophic wind speed +G_alpha = 0.D0 ! Geostrophic wind angle (degrees, from +x axis) +dPfdx = 0.D0 ! Additional Acceleration in X; used if useExtraForcing is ON +dPfdy = 0.D0 ! Additional Acceleration in Y; used if useExtraForcing is ON +dPfdz = 0.D0 ! Additional Acceleration in Z; used if useExtraForcing is ON +assume_fplane = .TRUE. ! F-plane assumption for horizontal component? +latitude = 45.0000d0 ! latitude +useHITForcing = .FALSE. ! Use an extra forcing term used for HIT? +frameAngle = 0.d0 ! Frame angle (degrees) +/ +/ +&PRESSURE_CALC +fastCalcPressure = .TRUE. ! Compute and store pressure at every time step using the faster algorithm? +storePressure = .FALSE. ! Would you like to compute and store pressure? +P_dumpFreq = 100 ! How often (timesteps) do you want to dump pressure? +P_compFreq = 10 ! How often (timesteps) do you want to compute pressure? +/ +/ +&BCs +botWall = 3 ! no_slip = 1, slip = 2, wall model = 3 +topWall = 2 ! no_slip = 1, slip = 2, wall model = 3 +useSpongeLayer = .TRUE. ! Use a sponge layer at the top +zstSponge = 0.75d0 ! Height above which the sponge layer is active +SpongeTscale = 20.d0 ! e-folding time to dt ratio (somewhere between 10 - 50) +useFringe = .false. ! This is false if simulation is periodic. +botBC_Temp = 0 ! 0: Dirichlet (could be time dependent), 1: Homog. Neumann (no-flux) +useControl = .True. ! Use PI control to fix yaw angle at the height specified below +/ +/ +&CONTROL +beta = 0.03d0 ! 0.08d3,0.0278 Integrator tuning parameter (appropriate non-dimensionalized) +sigma = 3.995d0 ! 3.995d0 Time constant for filter for rotation rate +phi_ref = 0.d0 ! Desired degrees at z_ref +z_ref = 24 ! Index of desired phi_ref +alpha = 0.d0 ! Proportional gain constant +controlType = 1 ! 1: Meneveau 2014, 2: Control G_alpha +angleTrigger = 0.d0 ! Angle at z_ref where control turns on +/ +/ +&SGS_MODEL +SGSModelID = 1 ! 0: smagorinsky (w/ wall function), 1: sigma +Csgs = 0.9d0 ! Model constant (asymptotic value in case wall function is used) +WallModelType = 1 ! 1: Moeng, 2: Bou-zeid et. al. +z0 = 4.166667e-04 ! Roughness length scale (CAUTION: this assumes appropriate non-dimensionalization) +DynamicProcedureType = 0 ! 0: No dynamic procedure, 1: Planar Avg. Dynamic Proc., 2: Global Dynamic Proc. +useVerticalTfilter = .false. ! Use test filtering in vertical direction for dynamic procedure? +DynProcFreq = 5 ! Dynamic procedure used every DYNPROCFREQ timesteps. +useWallDamping = .FALSE. ! Use the Wall Damping Function +ncWall = 3.d0 ! Wall Damping Function Exponent +explicitCalcEdgeEddyViscosity = .false. ! Explicitly calculate or interpolate edge values for eddy viscosity? +/ +/ +&WINDTURBINES +useWindTurbines = .false. ! Do you want to use Wind turbines ? +/ +/ +&KSPREPROCESS +PreprocessForKS = .FALSE. ! Do you want to generate preprocessing files for KS? +/ +/ +&PROBLEM_INPUT +Lx = 32.00000000d0 ! Domain Length (appropriate dimesnions/non-dimensionalized) +Ly = 13.33333333d0 ! Domain Width (appropriate dimesnions/non-dimensionalized) +Lz = 6.66666667d0 ! Domain Height (appropriate dimesnions/non-dimensionalized) +Tref = 300.0000d0 ! Reference Temp. +Tsurf0 = 300.0000d0 ! Surface Temp. (at tsim=0) in K (need to take care of the dimensions) +dTsurf_dt = -0.2500d0 ! Surface Temp. decrease rate in K/hr. (need to take care of the dimensions) +dTdz = 0.7200d0 ! Background potential temperature gradient in K/length (need to take care of the dimensions) +/ +/ +&BUDGET_TIME_AVG +do_budgets = .True. ! Perform budget calculations? +budgetType = 1 ! See type descriptions in budget_xy_avg.F90 +budgets_dir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Write in default output directory +tidx_compute = 1 ! How often should budgets be computed? +tidx_dump = 1000 ! How often should budget files be written to disk? +restart_budgets = .FALSE. ! use existing budget file to restart budget calculations? +restart_rid = 1 ! Restart budget file run index +restart_tid = 170000 ! Restart budget file time index +restart_counter = 16000 ! Restart budget file counter +tidx_budget_start = -1 ! time id to begin budget computations, set <0 to use start time +time_budget_start = 8000.d0 +/ +/ +&BUDGET_XY_AVG +do_budgets = .False. ! Perform budget calculations? +budgetType = 3 ! See type descriptions in budget_xy_avg.F90 +budgets_dir = "/scratch/08445/tg877441/test_sbl_concurrent" ! Write in default output directory +tidx_compute = 1 ! How often should budgets be computed? +tidx_dump = 1000 ! How often should budget files be written to disk? +restart_budgets = .FALSE. ! use existing budget file to restart budget calculations? +restart_rid = 1 ! Restart budget file run index +restart_tid = 170000 ! Restart budget file time index +restart_counter = 16000 ! Restart budget file counter +tidx_budget_start = -1 ! time id to begin budget computations, set <0 to use start time +time_budget_start = 8000.d0 +/ \ No newline at end of file diff --git a/problems/turbines/stable_pbl_concurrent_files/temporalHook.F90 b/problems/turbines/stable_pbl_concurrent_files/temporalHook.F90 new file mode 100644 index 00000000..de9f0e46 --- /dev/null +++ b/problems/turbines/stable_pbl_concurrent_files/temporalHook.F90 @@ -0,0 +1,84 @@ +module temporalHook + use kind_parameters, only: rkind + use IncompressibleGrid, only: igrid + use reductions, only: P_MAXVAL, p_minval + use exits, only: message, message_min_max, GracefulExit + use constants, only: half + use timer, only: tic, toc + use mpi + use decomp_2d + use reductions, only: p_sum + + implicit none + + integer :: i, j, nt_print2screen = 1 + real(rkind) :: maxDiv, DomMaxDiv, angle + integer :: ierr + +contains + + subroutine doTemporalStuff(gp, simid) + class(igrid), intent(inout) :: gp + integer, intent(in) :: simid + + if (mod(gp%step,nt_print2screen) == 0) then + maxDiv = maxval(gp%divergence) + DomMaxDiv = p_maxval(maxDiv) + select case (simid) + case (1) + call message(0,"Primary Simulation Info:") + case (2) + call message(0,"Concurrent Simulation Info:") + end select + call message(0,"Time",gp%tsim) + call message(1,"TIDX:",gp%step) + call message(1,"MaxDiv:",DomMaxDiv) + call message(1,"u_star:",gp%sgsmodel%get_ustar()) + call message(1,"Inv. Ob. Len:",gp%sgsmodel%get_InvObLength()) + call message(1,"Surface Flux (K*nd velocity):",gp%wTh_surf) + call message_min_max(1,"Bounds for u:", p_minval(minval(gp%u)), p_maxval(maxval(gp%u))) + call message_min_max(1,"Bounds for v:", p_minval(minval(gp%v)), p_maxval(maxval(gp%v))) + call message_min_max(1,"Bounds for w:", p_minval(minval(gp%w)), p_maxval(maxval(gp%w))) + + if ((simid == 1) .and. (gp%useWindTurbines)) then + call message(0,"Wind direction hub height", gp%WindTurbineArr%windAngle) + end if + + ! add controller print statements, if the controller is used + if (gp%useControl) then + call message(1, "Current angle controller Phi:", gp%angCont_yaw%getPhi()) + call message(1, "Frame angle:" , gp%frameAngle) + call message(1, "Current wind angle:", gp%angCont_yaw%getPhiHub()) + end if + + if (gp%useCFL) then + call message(1,"Current dt:",gp%dt) + end if + call message(0,"------------------------------------------") + if (simid == 1) then + if (allocated(gp%scalars)) then + call message_min_max(1,"Bounds for SCALAR 1:", p_minval(minval(gp%scalars(1)%F)), p_maxval(maxval(gp%scalars(1)%F))) + call message_min_max(1,"Bounds for SCALAR 2:", p_minval(minval(gp%scalars(2)%F)), p_maxval(maxval(gp%scalars(2)%F))) + call message_min_max(1,"Bounds for SCALAR 3:", p_minval(minval(gp%scalars(3)%F)), p_maxval(maxval(gp%scalars(3)%F))) + end if + + if (p_maxval(maxval(gp%u))>4.) then + call message(1, "this step has blown up", gp%tsim) + call gp%dumpFullField(gp%u,"uVel") + call gp%dumpFullField(gp%v,"vVel") + call gp%dumpFullField(gp%wC,"wVel") + call gp%dumpFullField(gp%T, "potT") + call gp%dumpFullField(gp%T, "prss") + call GracefulExit("u-velocity has blown up",1) + end if + elseif (simid == 2) then + call toc() + call tic() + end if + end if + + end subroutine + + + +end module \ No newline at end of file diff --git a/setup/SetupEnv_Anvil.sh b/setup/SetupEnv_Anvil.sh new file mode 100644 index 00000000..19d5fbde --- /dev/null +++ b/setup/SetupEnv_Anvil.sh @@ -0,0 +1,18 @@ +#!/bin/bash +module purge +module load intel +module load cmake +module load mvapich2 +module load intel-mkl +module list + +export COMPILER_ID=Intel +export FC=mpiifort +export CC=mpiicc +export CXX=mpiicpc +export FFTW_PATH=/anvil/projects/x-atm170028/karim/PadeOps/dependencies/fftw-3.3.10 +export DECOMP_PATH=/anvil/projects/x-atm170028/karim/PadeOps/dependencies/2decomp_fft +export VTK_IO_PATH=/anvil/projects/x-atm170028/padeops_setup/dependencies/Lib_VTK_IO/build +export HDF5_PATH=/anvil/projects/x-atm170028/padeops_setup/dependencies/hdf5-1.8.18 +export FFTPACK_PATH=/anvil/projects/x-atm170028/padeops_setup/dependencies/fftpack +export ARCH_OPT_FLAG="-march=core-avx2" diff --git a/setup/SetupEnv_Archer.sh b/setup/SetupEnv_Archer.sh new file mode 100644 index 00000000..e8c22903 --- /dev/null +++ b/setup/SetupEnv_Archer.sh @@ -0,0 +1,47 @@ +#!/usr/bin/env bash +# Archer2 GNU + CrayPE environment for building PadeOps + +# --- Modules --- +module purge +module load PrgEnv-gnu +module load craype-x86-rome # target AMD Rome (Zen2) – replaces manual -march +module load cmake +module load cray-libsci + +# Local FFT +module load cray-fftw + +# Local hdf5 +# module load cray-hdf5-parallel + +# --- Compilers (use Cray wrappers) --- +export COMPILER_ID=GNU +export CC=cc +export CXX=CC +export FC=ftn + +# --- Project root --- +CWD='/mnt/lustre/a2fs-work3/work/e773/e773/pounds/PadeOps' + +# export FFTW_PATH="${CWD}/dependencies/fftw-3.3.10" +export FFTW_PATH=${FFTW_ROOT} + +export HDF5_PATH="${CWD}/dependencies/hdf5-1.14.3/build" +# export HDF5_PATH=${CRAY_HDF5_PARALLEL_DIR} + +export FFTPACK_PATH="${CWD}/dependencies/fftpack" +export DECOMP_PATH="${CWD}/dependencies/2decomp_fft" +export VTK_IO_PATH="${CWD}/dependencies/Lib_VTK_IO/build" + +export CMAKE_PREFIX_PATH="${HDF5_PATH}:${FFTW_PATH}:${VTK_IO_PATH}:${CMAKE_PREFIX_PATH}" + +# --- Architecture flags --- +# With craype-x86-rome + wrappers, you usually do NOT need to set -march/-mtune. +# Leave this empty, or only append safe optimisations that won't fight wrappers. +export ARCH_OPT_FLAG="" + +# Example of safe extras: +# export ARCH_OPT_FLAG="-O3 -fopenmp" # (for OpenMP) + +# --- Runtime sanity for MPI-only builds --- +export OMP_NUM_THREADS=1 diff --git a/setup/SetupEnv_Archer2.sh b/setup/SetupEnv_Archer2.sh new file mode 100644 index 00000000..1bb7b5be --- /dev/null +++ b/setup/SetupEnv_Archer2.sh @@ -0,0 +1,44 @@ +#!/usr/bin/env bash +# Archer2 GNU + CrayPE environment for building PadeOps + +# --- Modules --- +module purge +module load PrgEnv-gnu +module load craype-x86-rome # target AMD Rome (Zen2) – replaces manual -march +# module load cmake +module load cray-libsci +module load cray-fftw +module load cray-hdf5-parallel +module list + +# --- Compilers (use Cray wrappers) --- +export COMPILER_ID=GNU +export CC=cc +export CXX=CC +export FC=ftn + +# --- Project root --- +CWD='/mnt/lustre/a2fs-work3/work/e773/e773/pounds/PadeOps' + +# export FFTW_PATH="${CWD}/dependencies/fftw-3.3.10" +export FFTW_PATH=${FFTW_ROOT} + +# export HDF5_PATH="${CWD}/dependencies/hdf5-1.14.3/build" +export HDF5_PATH=${HDF5_DIR} + +export FFTPACK_PATH="${CWD}/dependencies/fftpack" +export DECOMP_PATH="${CWD}/dependencies/2decomp_fft" +# export VTK_IO_PATH="${CWD}/dependencies/Lib_VTK_IO/build" + +export CMAKE_PREFIX_PATH="${HDF5_PATH}:${FFTW_PATH}:${VTK_IO_PATH}:${CMAKE_PREFIX_PATH}" + +# --- Architecture flags --- +# With craype-x86-rome + wrappers, you usually do NOT need to set -march/-mtune. +# Leave this empty, or only append safe optimisations that won't fight wrappers. +export ARCH_OPT_FLAG="" + +# Example of safe extras if you insist: +# export ARCH_OPT_FLAG="-O3 -fopenmp" # (only if your code uses OpenMP) + +# --- Runtime sanity for MPI-only builds --- +export OMP_NUM_THREADS=1 diff --git a/setup/SetupEnv_Engaging_Intel.sh b/setup/SetupEnv_Engaging_Intel.sh index d4776750..f4869e17 100644 --- a/setup/SetupEnv_Engaging_Intel.sh +++ b/setup/SetupEnv_Engaging_Intel.sh @@ -1,17 +1,27 @@ #!/bin/bash module purge -module load git cmake -module load intel impi -module load mkl/2021.3.0 +module load StdEnv +module load community-modules +module load cmake +module load intel-hpc/2025.2.1.44 + +# Force Intel MPI wrappers to use LLVM-based Intel compilers +export I_MPI_CC=icx +export I_MPI_CXX=icpx +export I_MPI_FC=ifx +export I_MPI_F90=ifx + +CWD=$(pwd) -CWD=`pwd` export COMPILER_ID=Intel export FC=mpiifort export CC=mpiicc export CXX=mpiicpc -export FFTW_PATH=${CWD}/dependencies/fftw-3.3.5 + +export FFTW_PATH=${CWD}/dependencies/fftw-3.3.10 export DECOMP_PATH=${CWD}/dependencies/2decomp_fft export VTK_IO_PATH=${CWD}/dependencies/Lib_VTK_IO/build export HDF5_PATH=${CWD}/dependencies/hdf5-1.8.18 export FFTPACK_PATH=${CWD}/dependencies/fftpack -export ARCH_OPT_FLAG="-xHOST -O3 -march=core-avx2 -mtune=core-avx2" \ No newline at end of file + +export ARCH_OPT_FLAG="-O3 -xHost" \ No newline at end of file diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh index d5a6cf76..5141946b 100644 --- a/setup/SetupEnv_Stampede3.sh +++ b/setup/SetupEnv_Stampede3.sh @@ -1,16 +1,17 @@ #!/bin/bash - -module load cmake +module purge +module load cmake/3.31.9 module load intel impi +module load fftw3/3.3.10 CWD=`pwd` export COMPILER_ID=Intel export FC=mpiifort export CC=mpiicc export CXX=mpiicpc -export FFTW_PATH=${CWD}/dependencies/fftw-3.3.10 +export FFTW_PATH=$TACC_FFTW3_DIR export DECOMP_PATH=${CWD}/dependencies/2decomp_fft export VTK_IO_PATH=${CWD}/dependencies/Lib_VTK_IO/build export HDF5_PATH=${CWD}/dependencies/hdf5-1.14.3/build export FFTPACK_PATH=${CWD}/dependencies/fftpack -export ARCH_OPT_FLAG="-xCORE-AVX512" +export ARCH_OPT_FLAG="-xCORE-AVX512" \ No newline at end of file diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 8778d34e..e5da4f25 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -13,25 +13,31 @@ set(FFTW_LIBRARY_PATH "${FFTW_PATH}/lib") set(FFTW_INCLUDE_PATH "${FFTW_PATH}/include") # Include directories -include_directories(${MPI_INCLUDE_PATH} ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${VTK_IO_INCLUDE_PATH} ${HDF5_INCLUDE_PATH}) +include_directories(${MPI_INCLUDE_PATH} ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${HDF5_INCLUDE_PATH}) # Link directories -link_directories(${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${VTK_IO_LIBRARY_PATH} ${HDF5_LIBRARY_PATH}) +link_directories(${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${HDF5_LIBRARY_PATH}) # Create a library called PadeOps add_library(PadeOps STATIC ${utilities_source_files} ${derivatives_source_files} ${filters_source_files} ${io_source_files} ) if ( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) - target_link_libraries(PadeOps fftw3 2decomp_fft ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ${HDF5_LIBRARY_PATH}/libhdf5hl_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5_hl.a ${HDF5_LIBRARY_PATH}/libhdf5_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5.a ${MPI_LIBRARIES} -lz -ldl -lm -Wl,-rpath -Wl,${HDF5_LIBRARY_PATH}) + target_link_libraries(PadeOps fftw3 2decomp_fft ${HDF5_LIBRARY_PATH}/libhdf5hl_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5_hl.a ${HDF5_LIBRARY_PATH}/libhdf5_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5.a ${MPI_LIBRARIES} -lz -ldl -lm -Wl,-rpath -Wl,${HDF5_LIBRARY_PATH}) +elseif( CMAKE_Fortran_COMPILER_ID MATCHES "Cray" ) + target_link_libraries(PadeOps fftw3 2decomp_fft ${HDF5_LIBRARY_PATH}/libhdf5hl_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5_hl.a ${HDF5_LIBRARY_PATH}/libhdf5_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5.a ${MPI_LIBRARIES} m z dl) else() - target_link_libraries(PadeOps fftw3 2decomp_fft blas lapack ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ${HDF5_LIBRARY_PATH}/libhdf5hl_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5_hl.a ${HDF5_LIBRARY_PATH}/libhdf5_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5.a ${MPI_LIBRARIES} -lz -ldl -lm -Wl,-rpath -Wl,${HDF5_LIBRARY_PATH}) + # Replace $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a with local library if needed + target_link_libraries(PadeOps fftw3 2decomp_fft $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a ${HDF5_LIBRARY_PATH}/libhdf5hl_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5_hl.a ${HDF5_LIBRARY_PATH}/libhdf5_fortran.a ${HDF5_LIBRARY_PATH}/libhdf5.a ${MPI_LIBRARIES} -lz -ldl -lm -Wl,-rpath -Wl,${HDF5_LIBRARY_PATH}) endif() if ( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) - target_link_libraries(PadeOps fftw3 2decomp_fft ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ${MPI_LIBRARIES}) + target_link_libraries(PadeOps fftw3 2decomp_fft ${MPI_LIBRARIES}) elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - target_link_libraries(PadeOps fftw3 2decomp_fft blas lapack ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ${MPI_LIBRARIES}) + # Replace $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a with local library if needed + target_link_libraries(PadeOps fftw3 2decomp_fft $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a ${MPI_LIBRARIES}) +elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "Cray") + target_link_libraries(PadeOps fftw3 2decomp_fft $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_cray.a ${MPI_LIBRARIES}) elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU_OSX") - target_link_libraries(PadeOps fftw3 2decomp_fft blas lapack ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ${MPI_LIBRARIES}) + target_link_libraries(PadeOps fftw3 2decomp_fft blas lapack ${MPI_LIBRARIES}) endif() if (MPI_Fortran_COMPILER_FLAGS) diff --git a/src/derivatives/ffts.F90 b/src/derivatives/ffts.F90 index 15e68575..29e4466f 100644 --- a/src/derivatives/ffts.F90 +++ b/src/derivatives/ffts.F90 @@ -180,6 +180,7 @@ function init(this, n_, dir_, n2_, n3_, dx_, exhaustive) result(ierr) this%mk1dsq = -this%k1d*this%k1d this%initialized = .true. ierr = 0 + if(allocated(k_tmp))deallocate(k_tmp) end function subroutine dd1(this,f, df) diff --git a/src/incompressible/actuatorDisk_CT.F90 b/src/incompressible/actuatorDisk_CT.F90 index 264808c5..14f27ad6 100644 --- a/src/incompressible/actuatorDisk_CT.F90 +++ b/src/incompressible/actuatorDisk_CT.F90 @@ -54,9 +54,10 @@ module actuatorDisk_CTMod contains -subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG) +subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) class(actuatordisk_ct), intent(inout) :: this real(rkind), intent(in), dimension(:,:,:), target :: xG, yG, zG + real(rkind), intent(in) :: dx, dy, dz integer, intent(in) :: ActuatorDisk_ID character(len=*), intent(in) :: inputDir character(len=clen) :: tempname, fname @@ -80,9 +81,9 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG) call tic() ! link grids and read inputs - this%dx=xG(2,1,1)-xG(1,1,1) - this%dy=yG(1,2,1)-yG(1,1,1) - this%dz=zG(1,1,2)-zG(1,1,1) + this%dx=dx + this%dy=dy + this%dz=dz this%dV = this%dx*this%dy*this%dz this%xLoc = xLoc; this%yLoc = yLoc; this%zLoc = zLoc this%cT = cT; this%diam = diam; this%yaw = yaw @@ -214,14 +215,14 @@ subroutine get_R2(this, ys, zs, R2) subroutine get_R(this) class(actuatordisk_ct), intent(inout) :: this real(rkind) :: yrad, trad, xs, ys, zs, C1, xtmp, ytmp, ztmp ! rotations, in radians - real(rkind), dimension(this%npts) :: xi, yi, zi + real(rkind), dimension(int(this%npts)) :: xi, yi, zi integer :: k ! First, rotate all the points with the yaw and tilt call message(1, "Building kernel for turbine yaw:", this%yaw) yrad = this%yaw*pi/180.d0 trad = this%tilt*pi/180.d0 - do k = 1, this%npts + do k = 1, int(this%npts) xs = this%xs(k); ys = this%ys(k); zs = this%zs(k) ! apply yaw rotation, +z = positive yaw (e.g., Howland, et al. 2022) xtmp = (xs-this%xLoc)*cos(yrad) - (ys-this%yLoc)*sin(yrad) + this%xLoc @@ -239,7 +240,7 @@ subroutine get_R(this) ! TODO: can speed this up if only a subsection of the domain is used C1 = (6.d0/pi/this%delta**2)**(three/two) ! TODO: May need to zero scalarsource for dynamic yaw - do k = 1, this%npts + do k = 1, int(this%npts) this%rbuff = (this%xG-xi(k))**2 + (this%yG-yi(k))**2 + (this%zG-zi(k))**2 this%scalarsource = this%scalarsource + C1*exp(-6.d0*this%rbuff/this%delta**2) end do @@ -343,13 +344,13 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals, yaw, theta) real(rkind), dimension(this%nxLoc, this%nyLoc, this%nzLoc), intent(in) :: u, v, w real(rkind), intent(in) :: yaw, theta real(rkind) :: usp_sq, force, vface!, gamma - real(rkind), dimension(3,1) :: n=[1,0,0], tau=[0,1,0] !xn, Ft + real(rkind), dimension(3,1) :: n, tau !xn, Ft real(rkind), dimension(3,3) :: R, T ! update yaw and tilt of the turbine - if (.not. this%useDynamicYaw .and. (this%yaw - yaw*180.d0/pi)>1.d-8) then - call GracefulExit("Turbine prescribed yaw changed, but useDynamicYaw is OFF", 423) - end if + ! if (.not. this%useDynamicYaw .and. (this%yaw - yaw*180.d0/pi)>1.d-8) then + ! call GracefulExit("Turbine prescribed yaw changed, but useDynamicYaw is OFF", 423) + ! end if this%yaw = yaw*180.d0/pi this%tilt = theta*180.d0/pi ! For now, these are stored in degrees but input in radians ...? diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index cad0f736..34c42743 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -21,7 +21,7 @@ module actuatorDisk_FilteredMod integer :: xLoc_idx, ActutorDisk_T2ID, tInd = 1 real(rkind) :: yaw, tilt, ut, powerBaseline, hubDirection real(rkind) :: xLoc, yLoc, zLoc, dx, dy, dz, dV - real(rkind) :: diam, cT, pfactor, normfactor, OneBydelSq, Cp, thick, npts + real(rkind) :: diam, cT, pfactor, normfactor, OneBydelSq, Cp, thick, npts, upsample_fact real(rkind) :: uface = zero, vface = zero, wface = zero ! LES velocity, disk-averaged real(rkind) :: uturb, vturb, wturb ! turbine motion vector @@ -30,9 +30,9 @@ module actuatorDisk_FilteredMod logical :: useDynamicYaw, quickDecomp ! Grid Info - integer :: nxLoc, nyLoc, nzLoc + integer :: nxLoc, nyLoc, nzLoc real(rkind) :: delta, M ! Shapiro smearing size, corr. factor M<1 - real(rkind), dimension(:), allocatable :: xline, yline, zline + real(rkind), dimension(:), allocatable :: xline real(rkind), dimension(:,:,:), pointer :: xG, yG, zG ! Pointers to memory buffers @@ -69,18 +69,27 @@ module actuatorDisk_FilteredMod contains -subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG) +subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) class(actuatorDisk_filtered), intent(inout) :: this real(rkind), intent(in), dimension(:,:,:), target :: xG, yG, zG + real(rkind), intent(in) :: dx, dy, dz integer, intent(in) :: ActuatorDisk_ID character(len=*), intent(in) :: inputDir character(len=clen) :: tempname, fname integer :: ioUnit, ierr - real(rkind) :: xLoc=1.d0, yLoc=1.d0, zLoc=0.1d0 + real(rkind) :: xLoc=1.d0, yLoc=1.d0, zLoc=0.1d0, upsample_fact=two real(rkind) :: diam=0.08d0, cT=0.65d0, yaw=0.d0, tilt=0.d0, h !, Cp = 0.3 real(rkind) :: thickness=1.5d0, filterWidth=0.5, time2initialize=0.d0 logical :: useCorrection=.true., useDynamicYaw=.false., quickDecomp=.false., use_h=.false. - + real(rkind) :: rcutSqr + integer :: i, j, k + real(rkind) :: dxp, dyp, dzp + integer :: world_rank, is_active, nact + integer, allocatable :: actives(:) + character(len=4) :: turbindex + character(len=2048) :: active_ranks + character(len=16) :: tmp + ! Read input file for this turbine namelist /ACTUATOR_DISK/ xLoc, yLoc, zLoc, diam, cT, yaw, tilt, filterWidth, useCorrection, & useDynamicYaw, thickness, quickDecomp, use_h @@ -92,58 +101,32 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG) open(unit=ioUnit, file=trim(fname), form='FORMATTED', action="read") read(unit=ioUnit, NML=ACTUATOR_DISK) close(ioUnit) - + + call MPI_COMM_RANK(MPI_COMM_WORLD, world_rank, ierr) call message(0, "Initializing Actuator Disk (ADM Type=5) number", ActuatorDisk_ID) call tic() ! link grids and read inputs - this%dx=xG(2,1,1)-xG(1,1,1) - this%dy=yG(1,2,1)-yG(1,1,1) - this%dz=zG(1,1,2)-zG(1,1,1) + this%dx = dx + this%dy = dy + this%dz = dz this%dV = this%dx*this%dy*this%dz this%xLoc = xLoc; this%yLoc = yLoc; this%zLoc = zLoc this%cT = cT; this%diam = diam; this%yaw = yaw; this%tilt = tilt this%ut = 1.d0!; this%Cp = Cp + this%upsample_fact = upsample_fact this%uturb = zero; this%vturb = zero; this%wturb = zero this%nxLoc = size(xG,1); this%nyLoc = size(xG,2); this%nzLoc = size(xG,3) - - ! Allocate stuff - allocate(this%xLine(size(xG,1))) - allocate(this%yLine(size(xG,2))) - allocate(this%zLine(size(xG,3))) - this%xG => xG; this%yG => yG; this%zG => zG - this%xLine = xG(:,1,1); this%yLine = yG(1,:,1); this%zLine = zG(1,1,:) - - ! allocate memory buffers - allocate(this%rbuff(this%nxLoc, this%nyLoc, this%nzLoc)) - allocate(this%blanks(this%nxLoc, this%nyLoc, this%nzLoc)) - allocate(this%speed(this%nxLoc, this%nyLoc, this%nzLoc)) - allocate(this%scalarsource(this%nxLoc, this%nyLoc, this%nzLoc)) - ! copied from ADM T2 - this%Am_I_Split = .TRUE. ! TODO: Fix me later by flagging where the turbine is - if (this%Am_I_Split) then - call MPI_COMM_SPLIT(mpi_comm_world, this%color, nrank, this%mycomm, ierr) - call MPI_COMM_RANK(this%mycomm, this%myComm_nrank, ierr) - call MPI_COMM_SIZE(this%mycomm, this%myComm_nproc, ierr) - end if - - ! this ensures that only ONE turbine is keeping track of power and writing to disk - if((this%Am_I_Split .and. this%myComm_nrank==0) .or. (.not. this%Am_I_Split)) then -! write(*,*) "Only one allocated? YES/NO" - allocate(this%powerTime(1000000)) - allocate(this%uTime(1000000)) - allocate(this%vTime(1000000)) - end if ! Set thickness this%thick = thickness*this%dx if (use_h) then ! use h to dimensionalize the filterwidth - h = sqrt((this%xLine(2) - this%xLine(1))**2 + (this%yLine(2) - this%yLine(1))**2 + (this%zLine(2) - this%zLine(1))**2) + h = sqrt(this%dx**2 + this%dy**2 + this%dz**2) this%delta = filterWidth * h else ! use the turbine diameter to dimensionalize the filterwidth @@ -157,8 +140,93 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG) call message(1, "ADM: using full kernel integration") end if + ! Decide if the turbine is active on the current rank + ! If any point is within rcut from the turbine, this turbine is active on current rank + rcutSqr = (this%diam/2) + 3.0d0*this%delta + 0.5d0*max(this%dx, this%dy, this%dz) + rcutSqr = rcutSqr*rcutSqr + this%Am_I_Active = .false. + do k = 1, this%nzLoc + do j = 1, this%nyLoc + do i = 1, this%nxLoc + dxp = this%xG(i,j,k) - this%xLoc + dyp = this%yG(i,j,k) - this%yLoc + dzp = this%zG(i,j,k) - this%zLoc + if (dxp*dxp + dyp*dyp + dzp*dzp <= rcutSqr) then + this%Am_I_Active = .true. + exit + end if + end do + if (this%Am_I_Active) exit + end do + if (this%Am_I_Active) exit + end do + + ! Set the color. Now the split holds ranks that have Am_I_Active = .true. + ! Need to pass the local comm to p_sum later (was missing and was summing over MPI_COMM_WORLD instead) + if(this%Am_I_Active) then + this%color = ActuatorDisk_ID + else + this%color = MPI_UNDEFINED + this%myComm = MPI_COMM_NULL + end if + + ! Gather the indices of ranks where current turbine is active + is_active = merge(1, 0, this%Am_I_Active) + call gather_active_ranks_all(is_active, actives, nact, MPI_COMM_WORLD) + write(turbindex,'(I4.4)') ActuatorDisk_ID + active_ranks='' + if(nact>0)then + do i = 1, nact + write(tmp, '(I0)') actives(i) + active_ranks = trim(active_ranks)//trim(tmp)//'-' + end do + call message(1, 'Active ranks of turbine '//trim(turbindex)//' are '//trim(active_ranks)) + else + call message(1, 'No active ranks for turbine '//trim(turbindex)) + end if + if(allocated(actives)) deallocate(actives) + + ! If the turbine is active on a single rank, no need for MPI_COMM_SPLIT + this%Am_I_Split = nact > 1 + this%myComm = MPI_COMM_NULL + this%myComm_nrank = -1 + this%myComm_nproc = 0 + if (this%Am_I_Split) then + call MPI_COMM_SPLIT(MPI_COMM_WORLD, this%color, world_rank, this%mycomm, ierr) + if (this%color /= MPI_UNDEFINED) then + call MPI_COMM_RANK(this%mycomm, this%myComm_nrank, ierr) + call MPI_COMM_SIZE(this%mycomm, this%myComm_nproc, ierr) + end if + end if + + ! Safe guard only + if (.not. this%Am_I_Split .and. this%Am_I_Active) then + this%myComm = MPI_COMM_SELF + this%myComm_nrank = 0 + this%myComm_nproc = 1 + end if + + ! allocate memory buffers + if(this%Am_I_Active)then + if (this%quickDecomp) then + allocate(this%xLine(this%nxLoc)) + this%xLine = this%xG(:,1,1) + end if + + allocate(this%rbuff(this%nxLoc, this%nyLoc, this%nzLoc)) + allocate(this%scalarsource(this%nxLoc, this%nyLoc, this%nzLoc)) + this%scalarsource = zero + + ! this ensures that only ONE turbine is keeping track of power and writing to disk + if((this%Am_I_Split .and. this%myComm_nrank==0) .or. (.not. this%Am_I_Split)) then + allocate(this%powerTime(10000)) + allocate(this%uTime(10000)) + allocate(this%vTime(10000)) + end if + end if + ! Get (unrotated) turbine location points - call sample_on_circle(this%diam, this%yLoc, this%zLoc, this%ys, this%zs, this%dy, this%dz) + call sample_on_circle(this%diam, this%yLoc, this%zLoc, this%ys, this%zs, this%dy, this%dz, this%upsample_fact) this%npts = size(this%ys,1) call message(1, "NUMBER OF POINTS: ", this%npts) allocate(this%xs(size(this%ys))) @@ -176,7 +244,7 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG) call message(2, "Using Dynamic Yaw") else call message(2, "Using static turbine.") - call this%redraw() ! get_weights(this) + if(this%Am_I_Active) call this%get_weights() end if call message(2, "Smearing grid parameter, Delta", this%delta) @@ -185,16 +253,80 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG) call message(3, "x = ", this%xLoc) call message(3, "y = ", this%yLoc) call message(3, "z = ", this%zLoc) - call toc(mpi_comm_world, time2initialize) + if(.not. this%Am_I_Active)then + ! Deallocate + if(allocated(this%xs)) deallocate(this%xs) + if(allocated(this%ys)) deallocate(this%ys) + if(allocated(this%zs)) deallocate(this%zs) + if(allocated(this%xline)) deallocate(this%xline) + nullify(this%xG, this%yG, this%zG) + end if + call toc(MPI_COMM_WORLD, time2initialize) call message(2, "Time (seconds) to initialize", time2initialize) end subroutine +subroutine gather_active_ranks_all(is_active, active_ranks, nactive, comm) + use mpi + implicit none + integer, intent(in) :: is_active ! 0 or 1 on each rank + integer, intent(in) :: comm ! typically MPI_COMM_WORLD + integer, allocatable, intent(out) :: active_ranks(:) ! allocated on ALL ranks + integer, intent(out) :: nactive ! valid on ALL ranks + integer :: ierr, rank, nproc, i + integer, allocatable :: flags(:) + + call MPI_Comm_rank(comm, rank, ierr) + call MPI_Comm_size(comm, nproc, ierr) + allocate(flags(nproc)) + + ! Everyone gets the activity flag from everyone + call MPI_Allgather(is_active, 1, MPI_INTEGER, flags, 1, MPI_INTEGER, comm, ierr) + + ! Count and build the list (world ranks are 0-based) + nactive = 0 + do i = 1, nproc + if (flags(i) /= 0) nactive = nactive + 1 + end do + + if(nactive > 0)then + allocate(active_ranks(nactive)) + nactive = 0 + do i = 1, nproc + if (flags(i) /= 0) then + nactive = nactive + 1 + active_ranks(nactive) = i - 1 + end if + end do + end if + deallocate(flags) +end subroutine gather_active_ranks_all + subroutine destroy(this) class(actuatordisk_filtered), intent(inout) :: this + integer :: ierr + + if(allocated(this%rbuff)) deallocate(this%rbuff) + if(allocated(this%blanks)) deallocate(this%blanks) + if(allocated(this%speed)) deallocate(this%speed) + if(allocated(this%scalarSource)) deallocate(this%scalarSource) + if(allocated(this%powerTime)) deallocate(this%powerTime) + if(allocated(this%uTime)) deallocate(this%uTime) + if(allocated(this%vTime)) deallocate(this%vTime) + if(allocated(this%xs)) deallocate(this%xs) + if(allocated(this%ys)) deallocate(this%ys) + if(allocated(this%zs)) deallocate(this%zs) + if(allocated(this%xLine)) deallocate(this%xLine) + + ! Free communicator + if (this%myComm /= MPI_COMM_NULL .and. & + this%myComm /= MPI_COMM_WORLD .and. & + this%myComm /= MPI_COMM_SELF) then + call MPI_COMM_FREE(this%myComm, ierr) + this%myComm = MPI_COMM_NULL + end if - deallocate(this%rbuff, this%blanks, this%speed, this%scalarSource) nullify(this%xG, this%yG, this%zG) -end subroutine +end subroutine ! Convolution in x (streamwise) direction subroutine get_R1(this, R1) @@ -240,13 +372,16 @@ subroutine get_R(this) class(actuatordisk_filtered), intent(inout) :: this real(rkind) :: yrad, trad, xs, ys, zs, C1, xtmp, ytmp, ztmp ! rotations, in radians real(rkind), dimension(this%npts) :: xi, yi, zi - integer :: k + ! integer :: k + real(rkind) :: rcut, coef, rsq + real(rkind) :: xmin, xmax, ymin, ymax, zmin, zmax + integer :: i1, i2, j1, j2, k1, k2, i, j, k, l ! First, rotate all the points with the yaw and tilt ! call message(1, "Building kernel for turbine yaw:", this%yaw) yrad = this%yaw*pi/180.d0 trad = this%tilt*pi/180.d0 - do k = 1, this%npts + do k = 1, int(this%npts) xs = this%xs(k); ys = this%ys(k); zs = this%zs(k) ! apply yaw rotation, +z = positive yaw (e.g., Howland, et al. 2022) xtmp = (xs-this%xLoc)*cos(yrad) - (ys-this%yLoc)*sin(yrad) + this%xLoc @@ -260,13 +395,48 @@ subroutine get_R(this) end do ! now xi, yi, zi are the rotated coordinates, assemble w/Greens function - ! this may take a while... - ! TODO: can speed this up if only a subsection of the domain is used - C1 = (6.d0/pi/this%delta**2)**(three/two) - ! TODO: May need to zero scalarsource for dynamic yaw + + ! Slow implementation + ! C1 = (6.d0/pi/this%delta**2)**(three/two) + ! do k = 1, this%npts + ! this%rbuff = (this%xG-xi(k))**2 + (this%yG-yi(k))**2 + (this%zG-zi(k))**2 + ! this%scalarsource = this%scalarsource + C1*exp(-6.d0*this%rbuff/this%delta**2) + ! end do + + ! faster implementation: + rcut = 2.d0 * this%delta ! this includes >99.999% of the forcing + coef = -6.d0 / this%delta**2 + C1 = (6.d0/pi/this%delta**2)**(three/two) + do k = 1, this%npts - this%rbuff = (this%xG-xi(k))**2 + (this%yG-yi(k))**2 + (this%zG-zi(k))**2 - this%scalarsource = this%scalarsource + C1*exp(-6.d0*this%rbuff/this%delta**2) + ! bounds in physical space + xmin = xi(k) - rcut + xmax = xi(k) + rcut + ymin = yi(k) - rcut + ymax = yi(k) + rcut + zmin = zi(k) - rcut + zmax = zi(k) + rcut + + ! find index limits (assuming monotonic coordinates in each direction) + ! Using max/min to clip to local array bounds + i1 = max(1, minloc(abs(this%xG(:,1,1) - xmin), dim=1)) + i2 = min(this%nxLoc, minloc(abs(this%xG(:,1,1) - xmax), dim=1)) + j1 = max(1, minloc(abs(this%yG(1,:,1) - ymin), dim=1)) + j2 = min(this%nyLoc, minloc(abs(this%yG(1,:,1) - ymax), dim=1)) + k1 = max(1, minloc(abs(this%zG(1,1,:) - zmin), dim=1)) + k2 = min(this%nzLoc, minloc(abs(this%zG(1,1,:) - zmax), dim=1)) + + ! loop only over the small cube around the point + do l = k1, k2 + do j = j1, j2 + do i = i1, i2 + rsq = (this%xG(i,j,l) - xi(k))**2 + & + (this%yG(i,j,l) - yi(k))**2 + & + (this%zG(i,j,l) - zi(k))**2 + this%scalarsource(i,j,l) = this%scalarsource(i,j,l) + C1 * exp(coef * rsq) + end do + end do + end do end do ! scalarsource NOT necessarily normalized to integrate to 1 (yet), do this in get_weights() @@ -277,7 +447,9 @@ subroutine get_weights(this) real(rkind), dimension(this%nyLoc, this%nzLoc) :: R2 real(rkind), dimension(this%nxLoc) :: R1 real(rkind), dimension(this%nxLoc, this%nyLoc, this%nzLoc) :: R - + real(rkind) :: smax + + this%scalarsource = zero if ((abs(this%yaw) < 1e-3) .and. (abs(this%tilt) < 1e-3)) then if (this%quickDecomp) then !aligned with the x-direction, use the "quick" kernel creation @@ -300,27 +472,37 @@ subroutine get_weights(this) end if ! minimum threshold tolerance - where (this%scalarsource < 1.d-10) + if(this%Am_I_Split)then + smax = p_maxval(this%scalarsource, this%mycomm) + else + smax = MAXVAL(this%scalarsource) + end if + where (this%scalarsource < 1.d-12 * smax) this%scalarsource = 0 end where ! normalize so R integrates to 1 exactly - this%scalarsource = this%scalarsource / (p_sum(this%scalarsource)*this%dV) + if(this%Am_I_Split)then + this%scalarsource = this%scalarsource / (p_sum(this%scalarsource, this%mycomm)*this%dV) + else + this%scalarsource = this%scalarsource / (SUM(this%scalarsource)*this%dV) + end if end subroutine ! sample a circle with points spaced dx, dy apart and centered at xcen, ycen -subroutine sample_on_circle(diam, xcen, ycen, xloc, yloc, dx, dy) +subroutine sample_on_circle(diam, xcen, ycen, xloc, yloc, dx, dy, upsample_fact) use gridtools, only: linspace - real(rkind), intent(in) :: diam, xcen, ycen, dx, dy - real(rkind) :: R + real(rkind), intent(in) :: diam, xcen, ycen, dx, dy, upsample_fact + real(rkind) :: R, dxi integer, dimension(:), allocatable :: tag real(rkind), dimension(:), allocatable :: xline, yline real(rkind), dimension(:), allocatable, intent(out) :: xloc, yloc real(rkind), dimension(:), allocatable :: xtmp, ytmp, rtmp - integer :: idx, i, j, nsz, iidx, nx_per_R, ny_per_R, nx, ny, np + integer :: idx, i, nsz, iidx, nx_per_R, ny_per_R, nx, ny, np R = diam/two - nx_per_R = ceiling(R/dx); ny_per_R = ceiling(R/dy) + dxi = min(dx, dy) / upsample_fact ! upsample the resolution of the LES grid + nx_per_R = ceiling(R/dxi); ny_per_R = ceiling(R/dxi) nx = nx_per_R*2 + 1 ny = ny_per_R*2 + 1 np = nx*ny ! total number of points @@ -331,19 +513,12 @@ subroutine sample_on_circle(diam, xcen, ycen, xloc, yloc, dx, dy) ! initialize linearly-spaced arrays ! this is necessary to do independently of the grid xG, yG, zG ! because parallelization splits the grid up - xline = (/(i, i=-nx_per_R, nx_per_R)/) * dx - yline = (/(i, i=-ny_per_R, ny_per_R)/) * dy + xline = (/(i, i=-nx_per_R, nx_per_R)/) * dxi + yline = (/(i, i=-ny_per_R, ny_per_R)/) * dxi ! reshapes xline, yline: -! xtmp = reshape(spread(xline, 1, ny), [np]) -! ytmp = reshape(spread(yline, 2, nx), [np]) ! why doesn't reshape() work? - idx = 1 - do j = 1,ny - do i = 1,nx - xtmp(idx) = xline(i); ytmp(idx) = yline(j) - idx = idx + 1 - end do - end do + xtmp = reshape(spread(xline, 2, ny), [np]) ! Spread along dim 2, then flatten + ytmp = reshape(spread(yline, 1, nx), [np]) ! Spread along dim 1, then flatten rtmp = sqrt(xtmp**2 + ytmp**2) tag = 0 where (rtmp < R) @@ -363,23 +538,28 @@ subroutine sample_on_circle(diam, xcen, ycen, xloc, yloc, dx, dy) xloc = xloc + xcen; yloc = yloc + ycen deallocate(xtmp, ytmp, rtmp, tag) ! deallocate temporary variables + deallocate(xline, yline) end subroutine ! Right hand side forcing term for the ADM -subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals) +subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals, budgetCall) class(actuatordisk_filtered), intent(inout) :: this real(rkind), dimension(this%nxLoc, this%nyLoc, this%nzLoc), intent(inout) :: rhsxvals, rhsyvals, rhszvals real(rkind), dimension(this%nxLoc, this%nyLoc, this%nzLoc), intent(in) :: u, v, w + logical, intent(in), optional :: budgetCall + real(rkind) :: yaw, tilt real(rkind) :: usp_sq, force, vface - real(rkind), dimension(3,1) :: n=[1,0,0], tau=[0,1,0] !xn, Ft + real(rkind), dimension(3,1) :: n, tau !xn, Ft real(rkind), dimension(3,3) :: R, T + logical :: writeTurbineVals ! update yaw and tilt of the turbine - if (.not. this%useDynamicYaw .and. (this%yaw - yaw*180.d0/pi)>1.d-8) then - call GracefulExit("Turbine prescribed yaw changed, but useDynamicYaw is OFF", 423) - end if + ! if (.not. this%useDynamicYaw .and. (this%yaw - yaw*180.d0/pi)>1.d-8) then + ! call GracefulExit("Turbine prescribed yaw changed, but useDynamicYaw is OFF", 423) + ! end if + if (.not. this%Am_I_Active) return yaw = this%yaw * pi/180.d0 tilt = this%tilt * pi/180.d0 @@ -401,18 +581,20 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals) ! vface = p_sum(this%scalarSource*(u*tau(1,1) + v*tau(2,1) + w*tau(3,1)))*this%dV ! NEW method -- requires more p_sum but results in a vector - this%uface = p_sum(this%scalarSource * u) * this%dV - this%vface = p_sum(this%scalarSource * v) * this%dV - this%wface = p_sum(this%scalarSource * w) * this%dV + ! Need to pass the local comm to p_sum + ! Also avoid forcing the compiler to create temperorary arrays + if(this%Am_I_Split)then + this%rbuff = this%scalarSource*u; this%uface = p_sum(this%rbuff, this%mycomm) * this%dV + this%rbuff = this%scalarSource*v; this%vface = p_sum(this%rbuff, this%mycomm) * this%dV + this%rbuff = this%scalarSource*w; this%wface = p_sum(this%rbuff, this%mycomm) * this%dV + else + this%rbuff = this%scalarSource*u; this%uface = SUM(this%rbuff) * this%dV + this%rbuff = this%scalarSource*v; this%vface = SUM(this%rbuff) * this%dV + this%rbuff = this%scalarSource*w; this%wface = SUM(this%rbuff) * this%dV + end if this%ut = this%M * ((this%uface - this%uturb) * n(1,1) + (this%vface - this%vturb) * n(2,1) + (this%wface - this%wturb) * n(3,1)) vface = ((this%uface - this%uturb) * tau(1,1) + (this%vface - this%vturb) * tau(2,1) + (this%wface - this%wturb) * tau(3,1)) - ! call message(1, 'DEBUG ActuatorDisk: this%ut', this%ut) - ! TODO: May need to update yaw before calling get_weights() - ! if (this%useDynamicYaw) then - ! call this%get_weights() - ! end if - ! Mean speed at the turbine, corrected with factor M usp_sq = (this%ut)**2 force = -0.5d0*this%cT*(pi*(this%diam**2)/4.d0)*usp_sq @@ -422,12 +604,19 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals) rhszvals = rhszvals + force * n(3,1) * this%scalarSource if (allocated(this%powerTime)) then ! check allocated so only one processor writes data - ! if((this%Am_I_Split .and. this%myComm_nrank==0) .or. (.not. this%Am_I_Split)) then - if (usp_sq /= 0.d0) then - this%powerTime(this%tInd) = this%get_power() - this%uTime(this%tInd) = this%ut - this%vTime(this%tInd) = vface - this%tInd = this%tInd + 1 + ! turbine values should not write if get_RHS is being called for budget calculations + writeTurbineVals = .true. + if (present(budgetCall)) writeTurbineVals = (.not. budgetCall) + + if ((writeTurbineVals) .and. (usp_sq /= 0.d0)) then + if (this%tInd <= size(this%powerTime)) then + this%powerTime(this%tInd) = this%get_power() + this%uTime(this%tInd) = this%ut + this%vTime(this%tInd) = vface + this%tInd = this%tInd + 1 + else + call message(1, "ADM history arrays full; skipping write") + end if end if end if @@ -515,9 +704,15 @@ function get_udisk(this) result(udisk) subroutine redraw(this) class(actuatordisk_filtered), intent(inout) :: this + if (.not. this%Am_I_Active) return + ! (re)sample points, this is quick - call sample_on_circle(this%diam, this%yloc, this%zloc, this%ys, this%zs, this%dy, this%dz) + if(allocated(this%xs)) deallocate(this%xs) + if(allocated(this%ys)) deallocate(this%ys) + if(allocated(this%zs)) deallocate(this%zs) + call sample_on_circle(this%diam, this%yloc, this%zloc, this%ys, this%zs, this%dy, this%dz, this%upsample_fact) this%npts = size(this%ys, 1) + allocate(this%xs(size(this%ys))) this%xs = this%xloc ! (re)compute weights diff --git a/src/incompressible/angleContol.F90 b/src/incompressible/angleContol.F90 index 4a2a3883..72370ba4 100644 --- a/src/incompressible/angleContol.F90 +++ b/src/incompressible/angleContol.F90 @@ -9,7 +9,7 @@ module angleControl type :: angCont - private + !private !logical :: TargetsAssociated = .false. !real(rkind), dimension(:,:,:), pointer :: u_target, v_target, w_target, T_target !real(rkind), dimension(:,:,:), allocatable :: Fringe_kernel_cells, Fringe_kernel_edges @@ -21,7 +21,7 @@ module angleControl !real(rkind) :: LambdaFact integer :: z_ref, controlType !myFringeID = 1 !logical :: useTwoFringex = .false. - real(rkind) :: phi, phi_n, beta, phi_ref, sigma, wFilt, alpha, wFilt_n, angleTrigger + real(rkind) :: phi, phi_n, beta, phi_ref, sigma, wFilt, alpha, wFilt_n, angleTrigger, deltaGalpha contains procedure :: init procedure :: destroy @@ -46,7 +46,7 @@ pure function getPhiHub(this) result (val) val = this%phi_n * 180.d0 / pi end function - subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, phi_n, wFilt_n, deltaGalpha, z_hub, trigger) + subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, phi_n, wFilt_n, deltaGalpha, z_hub, trigger, dumcntl) class(angCont), intent(inout) :: this real(rkind), intent(in) :: dt real(rkind), dimension(this%gpC%xsz(1),this%gpC%xsz(2),this%gpC%xsz(3)), intent(in) :: uC, vC @@ -54,6 +54,7 @@ subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, p complex(rkind), dimension(this%sp_gpC%ysz(1),this%sp_gpC%ysz(2),this%sp_gpC%ysz(3)), intent(inout) :: urhs, vrhs complex(rkind), dimension(this%sp_gpE%ysz(1),this%sp_gpE%ysz(2),this%sp_gpE%ysz(3)), intent(inout) :: wrhs logical, intent(in) :: newTimestep + logical, intent(in) :: dumcntl integer :: nx, ny, i, j ! PID tuning parameters real(rkind) :: wControl_n, vM, uM @@ -64,6 +65,8 @@ subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, p nx = this%gpC%xsz(1) ny = this%gpC%ysz(2) + ! Only do the following if it is not a dummy controller + if (.NOT. dumcntl) then ! PID controller !this%rbuffxC(:,:,:,1) = atan2(vC, uC) !* 180.d0 / pi !call transpose_x_to_y(this%rbuffxC(:,:,:,1),this%rbuffyC(:,:,:,1),this%gpC) @@ -111,10 +114,13 @@ subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, p this%wFilt = deltaGalpha deltaGalpha = this%alpha * deltaGalpha + this%beta * (phi_n - this%phi_ref) deltaGalpha = deltaGalpha * pi / 180.d0 + this%deltaGalpha = deltaGalpha wFilt_n = 0.d0 endif - end if + end if + end if + ! Update the RHS this%rbuffxC(:,:,:,1) = 2.d0 * vC * this%wFilt_n call this%spectC%fft(this%rbuffxC(:,:,:,1), this%cbuffyC(:,:,:,1)) @@ -126,8 +132,7 @@ subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, p ! Here I added the factor of 2 to deltaGalpha !!!!!!!!!!!!!!!!!!!!!!! deltaGalpha = 2.d0 * this%wFilt_n * dt * 180.d0 / pi - - + this%deltaGalpha = deltaGalpha end subroutine @@ -139,10 +144,11 @@ subroutine destroy(this) !this%TargetsAssociated = .false. end subroutine - subroutine init(this, inputfile, spectC, spectE, gpC, gpE, rbuffxC, rbuffxE, cbuffyC, cbuffyE, rbuffyC, rbuffzC, phiRestart) + subroutine init(this, inputfile, spectC, spectE, gpC, gpE, rbuffxC, rbuffxE, cbuffyC, cbuffyE, rbuffyC, rbuffzC, phiRestart, isdumcntl) use reductions, only: p_maxval use mpi class(angCont), intent(inout) :: this + logical, intent(out) :: isdumcntl character(len=clen), intent(in) :: inputfile type(decomp_info), intent(in), target :: gpC, gpE !real(rkind), dimension(gpC%xsz(1)), intent(in) :: x @@ -155,6 +161,7 @@ subroutine init(this, inputfile, spectC, spectE, gpC, gpE, rbuffxC, rbuffxE, cbu real(rkind) :: phi_ref, beta, sigma, phi, alpha , angleTrigger integer :: controlType real(rkind), intent(in) :: phiRestart + logical :: dummy_controller= .FALSE. !real(rkind) :: Lx, Ly, LambdaFact = 2.45d0, LambdaFact2 = 2.45d0 !real(rkind) :: Fringe_yst = 1.d0, Fringe_yen = 1.d0 !real(rkind) :: Fringe_xst = 0.75d0, Fringe_xen = 1.d0 @@ -168,7 +175,7 @@ subroutine init(this, inputfile, spectC, spectE, gpC, gpE, rbuffxC, rbuffxE, cbu integer :: ioUnit = 10, i, j, k, nx, ierr, z_ref !real(rkind), dimension(:), allocatable :: x1, x2, Fringe_func, S1, S2, y1, y2 !logical :: Apply_x_fringe = .true., Apply_y_fringe = .false. - !namelist /FRINGE/ Apply_x_fringe, Apply_y_fringe, Fringe_xst, Fringe_xen, Fringe_delta_st_x, Fringe_delta_en_x, & + !namelist /FRINGEINPUT/ Apply_x_fringe, Apply_y_fringe, Fringe_xst, Fringe_xen, Fringe_delta_st_x, Fringe_delta_en_x, & ! Fringe_delta_st_y, Fringe_delta_en_y, LambdaFact, LambdaFact2, Fringe_yen, Fringe_yst, Fringe1_delta_st_x, & ! Fringe2_delta_st_x, Fringe1_delta_en_x, Fringe2_delta_en_x, Fringe1_xst, Fringe2_xst, Fringe1_xen, Fringe2_xen @@ -179,10 +186,11 @@ subroutine init(this, inputfile, spectC, spectE, gpC, gpE, rbuffxC, rbuffxE, cbu !nx = gpC%xsz(1) !real(rkind) :: Lx = 1.d0, Ly = 1.d0, Lz = 1.d0, Tref = 0.d0, Tsurf0 = 1.d0, dTsurf_dt = -0.05d0, z0init = 1.d-4, frameAngle = 0.d0 !namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, beta, sigma, phi_ref, z_ref - namelist /CONTROL/ beta, sigma, phi_ref, z_ref, alpha, controlType, angleTrigger + namelist /CONTROL/ beta, sigma, phi_ref, z_ref, alpha, controlType, angleTrigger, dummy_controller !open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', iostat=ierr) !read(unit=ioUnit, NML=CONTROL) !close(ioUnit) + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', iostat=ierr) read(unit=ioUnit, NML=CONTROL) @@ -213,7 +221,7 @@ subroutine init(this, inputfile, spectC, spectE, gpC, gpE, rbuffxC, rbuffxE, cbu this%wFilt_n = 0.d0 this%angleTrigger = angleTrigger call message(0, "Control initialized successfully.") - + isdumcntl = dummy_controller ! Return the state of the current controller (dummy?) end subroutine end module diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 3074bf3b..25fda7da 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -184,6 +184,7 @@ module budgets_time_avg_mod logical :: do_budgets logical :: forceDump logical :: splitPressureDNS + logical :: squeeze = .false. ! if ture, limits the number of dumped budgets contains procedure :: init @@ -253,7 +254,8 @@ subroutine init(this, inputfile, igrid_sim) integer :: tidx_compute = 1000000, tidx_dump = 1000000, tidx_budget_start = -100 real(rkind) :: time_budget_start = -1.0d0 logical :: do_budgets = .false. - namelist /BUDGET_TIME_AVG/ budgetType, budgets_dir, restart_budgets, restart_dir, restart_rid, restart_tid, restart_counter, tidx_dump, tidx_compute, do_budgets, tidx_budget_start, time_budget_start + logical :: squeeze = .false. + namelist /BUDGET_TIME_AVG/ budgetType, budgets_dir, restart_budgets, restart_dir, restart_rid, restart_tid, restart_counter, tidx_dump, tidx_compute, do_budgets, tidx_budget_start, time_budget_start, squeeze restart_dir = "NULL" @@ -275,6 +277,7 @@ subroutine init(this, inputfile, igrid_sim) this%isStratified = igrid_sim%isStratified this%useCoriolis = igrid_sim%useCoriolis this%forceDump = .false. + this%squeeze = squeeze this%budgets_dir = budgets_dir this%budgetType = budgetType @@ -287,51 +290,57 @@ subroutine init(this, inputfile, igrid_sim) call GracefulExit("Both tidx_budget_start and time_budget_start in budget_time_avg are positive. Turn one negative", 100) endif - if(this%do_budgets) then - !if (this%isStratified) then - ! Always assume that you are stratified - - if (this%HaveScalars) then - allocate(this%budget_0(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),31+2*this%igrid_sim%n_scalars)) - else - allocate(this%budget_0(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),31)) - end if - allocate(this%budget_2(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) + if(this%do_budgets) then + ! allocate budget 0 -> minimum needed! + if (this%HaveScalars) then + allocate(this%budget_0(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),31+2*this%igrid_sim%n_scalars)) + else + allocate(this%budget_0(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),31)) + end if + ! allocate budget 1 + if (this%budgetType > 0) then allocate(this%budget_1(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),16)) - !else - ! allocate(this%budget_0(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),25)) - ! allocate(this%budget_2(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),07)) - ! allocate(this%budget_1(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) - !end if - allocate(this%budget_3(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),08)) - allocate(this%budget_4_11(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) - allocate(this%budget_4_22(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) - allocate(this%budget_4_13(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) - allocate(this%budget_4_23(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) - allocate(this%budget_4_33(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) - + end if + ! allocate budget 2 + if (this%budgetType > 1) then + allocate(this%budget_2(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) + end if + ! allocate budget 3 + if (this%budgetType > 2) then + allocate(this%budget_3(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),08)) + end if + ! allocate budget 4 + if (this%budgetType > 3) then + allocate(this%budget_4_11(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) + allocate(this%budget_4_22(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) + allocate(this%budget_4_13(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) + allocate(this%budget_4_23(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) + allocate(this%budget_4_33(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3),10)) + end if + ! allocate additional fields needed for budget 3 and above! if (this%budgetType > 2) then - allocate(this%tke(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) - allocate(this%tke_old(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) + ! allocate(this%tke(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) + ! allocate(this%tke_old(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) - allocate(this%u_old(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) - allocate(this%v_old(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) - allocate(this%wC_old(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) + ! allocate(this%u_old(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) + ! allocate(this%v_old(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) + ! allocate(this%wC_old(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) allocate(this%dUdt(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) allocate(this%dVdt(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) allocate(this%dWdt(this%igrid_sim%gpC%xsz(1),this%igrid_sim%gpC%xsz(2),this%igrid_sim%gpC%xsz(3))) end if - - + + ! set buget output directory if not provided if ((trim(budgets_dir) .eq. "null") .or.(trim(budgets_dir) .eq. "NULL")) then this%budgets_dir = igrid_sim%outputDir end if - + ! set buget restart directory if not provided if ((trim(restart_dir) .eq. "null") .or.(trim(restart_dir) .eq. "NULL")) then restart_dir = this%budgets_dir end if + ! if restarting bugets if (restart_budgets) then call message(0, "budget_time_avg: Initializing budget restart") this%counter = restart_counter @@ -341,7 +350,7 @@ subroutine init(this, inputfile, igrid_sim) call this%resetBudget() end if - ! STEP 2: Allocate memory (massive amount of memory needed) + ! STEP 2: Allocate memory (large amount of memory needed) call igrid_sim%spectC%alloc_r2c_out(this%uc) call igrid_sim%spectC%alloc_r2c_out(this%usgs) call igrid_sim%spectC%alloc_r2c_out(this%px) @@ -370,15 +379,13 @@ subroutine init(this, inputfile, igrid_sim) call igrid_sim%spectE%alloc_r2c_out(this%wcor) call igrid_sim%spectE%alloc_r2c_out(this%wb) - ! STEP 3: Now instrument igrid + ! STEP 3: Now instrument igrid -> links pointers in the grid object to arrays created for budget call igrid_sim%instrumentForBudgets_TimeAvg(this%uc, this%vc, this%wc, this%usgs, this%vsgs, this%wsgs, & & this%px, this%py, this%pz, this%uturb, this%vturb, this%wturb, this%pxdns, this%pydns, this%pzdns, & & this%uvisc, this%vvisc, this%wvisc, this%ucor, this%vcor, this%wcor, this%wb) - ! STEP 4: For horizontally-averaged surface quantities (called - ! Scalar here), and turbine statistics - !allocate(this%inst_horz_avg(5)) ! [ustar, uw, vw, Linv, wT] + ! STEP 4: For horizontally-averaged surface quantities (called Scalar here), and turbine statistics allocate(this%runningSum_sc(5)) this%runningSum_sc = zero if(this%useWindTurbines) then @@ -387,9 +394,7 @@ subroutine init(this, inputfile, igrid_sim) this%runningSum_sc_turb = zero this%runningSum_turb = zero endif - end if - end subroutine @@ -558,6 +563,13 @@ subroutine DumpBudget0(this) ! Step 7: Dump the full budget do idx = 1,size(this%budget_0,4) + if(this%squeeze)then + if((idx <= 16) .or. (idx == 26) .or. (idx == 31))then + continue + else + cycle + end if + end if call this%dump_budget_field(this%budget_0(:,:,:,idx),idx,0) end do @@ -625,7 +637,7 @@ subroutine AssembleBudget0(this) this%budget_0(:,:,:,26) = this%budget_0(:,:,:,26) + this%igrid_sim%T call this%igrid_sim%spectE%ifft(this%wb,this%igrid_sim%rbuffxE(:,:,:,1)) call this%interp_Edge2Cell(this%igrid_sim%rbuffxE(:,:,:,1), this%igrid_sim%rbuffxC(:,:,:,1)) - this%budget_0(:,:,:,31) = this%budget_0(:,:,:,31) - this%igrid_sim%rbuffxC(:,:,:,1) + this%budget_0(:,:,:,31) = this%budget_0(:,:,:,31) + this%igrid_sim%rbuffxC(:,:,:,1) end if ! STEP 2: Get Reynolds stresses (IMPORTANT: need to correct for fluctuation before dumping) @@ -645,38 +657,40 @@ subroutine AssembleBudget0(this) this%budget_0(:,:,:,11:16) = this%budget_0(:,:,:,11:16) + this%igrid_sim%tauSGS_ij ! STEP 5: Pressure flux for TKE transport - this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) + this%igrid_sim%pressure*this%igrid_sim%u - this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) + this%igrid_sim%pressure*this%igrid_sim%v - this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) + this%igrid_sim%pressure*this%igrid_sim%wC - - ! STEP 6: Turbulent flux for TKE transport - this%igrid_sim%rbuffxC(:,:,:,1) = half*(this%igrid_sim%u * this%igrid_sim%u + & - this%igrid_sim%v * this%igrid_sim%v + & - this%igrid_sim%wC* this%igrid_sim%wC ) - this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) + this%igrid_sim%rbuffxC(:,:,:,1)*this%igrid_sim%u - this%budget_0(:,:,:,21) = this%budget_0(:,:,:,21) + this%igrid_sim%rbuffxC(:,:,:,1)*this%igrid_sim%v - this%budget_0(:,:,:,22) = this%budget_0(:,:,:,22) + this%igrid_sim%rbuffxC(:,:,:,1)*this%igrid_sim%wC - - ! STEP 7: SGS flux for TKE transport - this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%igrid_sim%tauSGS_ij(:,:,:,1)*this%igrid_sim%u - this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%igrid_sim%tauSGS_ij(:,:,:,2)*this%igrid_sim%v - this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%igrid_sim%tauSGS_ij(:,:,:,3)*this%igrid_sim%wC - - this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%igrid_sim%tauSGS_ij(:,:,:,2)*this%igrid_sim%u - this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%igrid_sim%tauSGS_ij(:,:,:,4)*this%igrid_sim%v - this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%igrid_sim%tauSGS_ij(:,:,:,5)*this%igrid_sim%wC - - this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%igrid_sim%tauSGS_ij(:,:,:,3)*this%igrid_sim%u - this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%igrid_sim%tauSGS_ij(:,:,:,5)*this%igrid_sim%v - this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%igrid_sim%tauSGS_ij(:,:,:,6)*this%igrid_sim%wC - - ! STEP 8: Potential temperature terms for stratified flow - if (this%isStratified) then - this%budget_0(:,:,:,27) = this%budget_0(:,:,:,27) + this%igrid_sim%u*this%igrid_sim%T - this%budget_0(:,:,:,28) = this%budget_0(:,:,:,28) + this%igrid_sim%v*this%igrid_sim%T - ! compute w'T' on edge cells for implicit dealiasing - this%budget_0(:,:,:,29) = this%budget_0(:,:,:,29) + this%multiply_Edges_interp_cell(this%igrid_sim%TE, this%igrid_sim%w) - this%budget_0(:,:,:,30) = this%budget_0(:,:,:,30) + this%igrid_sim%T*this%igrid_sim%T + if(.not. this%squeeze)then + this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) + this%igrid_sim%pressure*this%igrid_sim%u + this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) + this%igrid_sim%pressure*this%igrid_sim%v + this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) + this%igrid_sim%pressure*this%igrid_sim%wC + + ! STEP 6: Turbulent flux for TKE transport + this%igrid_sim%rbuffxC(:,:,:,1) = half*(this%igrid_sim%u * this%igrid_sim%u + & + this%igrid_sim%v * this%igrid_sim%v + & + this%igrid_sim%wC* this%igrid_sim%wC ) + this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) + this%igrid_sim%rbuffxC(:,:,:,1)*this%igrid_sim%u + this%budget_0(:,:,:,21) = this%budget_0(:,:,:,21) + this%igrid_sim%rbuffxC(:,:,:,1)*this%igrid_sim%v + this%budget_0(:,:,:,22) = this%budget_0(:,:,:,22) + this%igrid_sim%rbuffxC(:,:,:,1)*this%igrid_sim%wC + + ! STEP 7: SGS flux for TKE transport + this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%igrid_sim%tauSGS_ij(:,:,:,1)*this%igrid_sim%u + this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%igrid_sim%tauSGS_ij(:,:,:,2)*this%igrid_sim%v + this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%igrid_sim%tauSGS_ij(:,:,:,3)*this%igrid_sim%wC + + this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%igrid_sim%tauSGS_ij(:,:,:,2)*this%igrid_sim%u + this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%igrid_sim%tauSGS_ij(:,:,:,4)*this%igrid_sim%v + this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%igrid_sim%tauSGS_ij(:,:,:,5)*this%igrid_sim%wC + + this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%igrid_sim%tauSGS_ij(:,:,:,3)*this%igrid_sim%u + this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%igrid_sim%tauSGS_ij(:,:,:,5)*this%igrid_sim%v + this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%igrid_sim%tauSGS_ij(:,:,:,6)*this%igrid_sim%wC + + ! STEP 8: Potential temperature terms for stratified flow + if (this%isStratified) then + this%budget_0(:,:,:,27) = this%budget_0(:,:,:,27) + this%igrid_sim%u*this%igrid_sim%T + this%budget_0(:,:,:,28) = this%budget_0(:,:,:,28) + this%igrid_sim%v*this%igrid_sim%T + ! compute w'T' on edge cells for implicit dealiasing + this%budget_0(:,:,:,29) = this%budget_0(:,:,:,29) + this%multiply_Edges_interp_cell(this%igrid_sim%TE, this%igrid_sim%w) + this%budget_0(:,:,:,30) = this%budget_0(:,:,:,30) + this%igrid_sim%T*this%igrid_sim%T + end if end if !STEP 9: Scalar Means @@ -2177,31 +2191,40 @@ subroutine restartBudget(this, dir, rid, tid, cid) ! Budget 0: do idx = 1,size(this%budget_0,4) ! if (allocated(this%budget_0)) deallocate(this%budget_0) + if(this%squeeze)then + if((idx <= 16) .or. (idx == 26) .or. (idx == 31))then + continue + else + cycle + end if + end if call this%restart_budget_field(this%budget_0(:,:,:,idx), dir, rid, tid, cid, 0, idx) end do ! Step 8: Go back to summing for Budget 0 - this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%budget_0(:,:,:,13)*this%budget_0(:,:,:,1) - this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%budget_0(:,:,:,15)*this%budget_0(:,:,:,2) - this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%budget_0(:,:,:,16)*this%budget_0(:,:,:,3) - - this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%budget_0(:,:,:,12)*this%budget_0(:,:,:,1) - this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%budget_0(:,:,:,14)*this%budget_0(:,:,:,2) - this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%budget_0(:,:,:,15)*this%budget_0(:,:,:,3) - - this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%budget_0(:,:,:,11)*this%budget_0(:,:,:,1) - this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%budget_0(:,:,:,12)*this%budget_0(:,:,:,2) - this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%budget_0(:,:,:,13)*this%budget_0(:,:,:,3) - - this%igrid_sim%rbuffxC(:,:,:,1) = half*(this%budget_0(:,:,:,4) + this%budget_0(:,:,:,7) + this%budget_0(:,:,:,9)) - this%budget_0(:,:,:,22) = this%budget_0(:,:,:,22) + this%budget_0(:,:,:,3)*this%igrid_sim%rbuffxC(:,:,:,1) - this%budget_0(:,:,:,21) = this%budget_0(:,:,:,21) + this%budget_0(:,:,:,2)*this%igrid_sim%rbuffxC(:,:,:,1) - this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) + this%budget_0(:,:,:,1)*this%igrid_sim%rbuffxC(:,:,:,1) - - this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,10) - this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,10) - this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) + this%budget_0(:,:,:,1)*this%budget_0(:,:,:,10) - + if(.not. this%squeeze)then + this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%budget_0(:,:,:,13)*this%budget_0(:,:,:,1) + this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%budget_0(:,:,:,15)*this%budget_0(:,:,:,2) + this%budget_0(:,:,:,25) = this%budget_0(:,:,:,25) + this%budget_0(:,:,:,16)*this%budget_0(:,:,:,3) + + this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%budget_0(:,:,:,12)*this%budget_0(:,:,:,1) + this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%budget_0(:,:,:,14)*this%budget_0(:,:,:,2) + this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%budget_0(:,:,:,15)*this%budget_0(:,:,:,3) + + this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%budget_0(:,:,:,11)*this%budget_0(:,:,:,1) + this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%budget_0(:,:,:,12)*this%budget_0(:,:,:,2) + this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%budget_0(:,:,:,13)*this%budget_0(:,:,:,3) + + this%igrid_sim%rbuffxC(:,:,:,1) = half*(this%budget_0(:,:,:,4) + this%budget_0(:,:,:,7) + this%budget_0(:,:,:,9)) + this%budget_0(:,:,:,22) = this%budget_0(:,:,:,22) + this%budget_0(:,:,:,3)*this%igrid_sim%rbuffxC(:,:,:,1) + this%budget_0(:,:,:,21) = this%budget_0(:,:,:,21) + this%budget_0(:,:,:,2)*this%igrid_sim%rbuffxC(:,:,:,1) + this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) + this%budget_0(:,:,:,1)*this%igrid_sim%rbuffxC(:,:,:,1) + + this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,10) + this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,10) + this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) + this%budget_0(:,:,:,1)*this%budget_0(:,:,:,10) + end if + ! Step 9: Go back to from this%budget_0(:,:,:,4) = this%budget_0(:,:,:,4) + this%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) ! R11 this%budget_0(:,:,:,5) = this%budget_0(:,:,:,5) + this%budget_0(:,:,:,1)*this%budget_0(:,:,:,2) ! R12 @@ -2211,7 +2234,7 @@ subroutine restartBudget(this, dir, rid, tid, cid) this%budget_0(:,:,:,9) = this%budget_0(:,:,:,9) + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,3) ! R33 ! STEP 10a: Potential temperature terms for stratified flow - if (this%isStratified) then + if (this%isStratified .and. (.not. this%squeeze)) then this%budget_0(:,:,:,27) = this%budget_0(:,:,:,27) + this%budget_0(:,:,:,1)*this%budget_0(:,:,:,26) this%budget_0(:,:,:,28) = this%budget_0(:,:,:,28) + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,26) this%budget_0(:,:,:,29) = this%budget_0(:,:,:,29) + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,26) @@ -2461,20 +2484,40 @@ subroutine ResetBudget(this) subroutine destroy(this) class(budgets_time_avg), intent(inout) :: this - nullify(this%igrid_sim) if(this%do_budgets) then - deallocate(this%uc, this%vc, this%wc, this%usgs, this%vsgs, this%wsgs, this%px, this%py, this%pz, this%uturb) - deallocate(this%budget_0, this%budget_1) - deallocate(this%runningSum_sc) + ! deallocate(this%uc, this%vc, this%wc, this%usgs, this%vsgs, this%wsgs, this%px, this%py, this%pz, this%uturb) + deallocate(this%uc, this%usgs, this%px, this%uturb, this%vturb, this%wturb, & + this%vc, this%vsgs, this%py, & + this%wc, this%wsgs, this%pz, & + this%pxdns, this%pydns, this%pzdns, & + this%uvisc, this%vvisc, this%wvisc, & + this%ucor, this%vcor, this%wcor, this%wb) + deallocate(this%budget_0) + if (this%budgetType>0) then + deallocate(this%budget_1) + end if + if (this%budgetType>1) then + deallocate(this%budget_2) + end if + if (this%budgetType>2) then + deallocate(this%budget_3) + end if + if (this%budgetType>3) then + deallocate(this%budget_4_11) + deallocate(this%budget_4_13) + deallocate(this%budget_4_22) + deallocate(this%budget_4_23) + deallocate(this%budget_4_33) + end if + deallocate(this%runningSum_sc) if(this%useWindTurbines) then deallocate(this%runningSum_sc_turb) deallocate(this%runningSum_turb) - endif + end if end if - - end subroutine + end subroutine destroy ! ----------------------private derivative operators ------------------------ subroutine ddx_R2R(this, f, dfdx) diff --git a/src/incompressible/budget_time_avg_deficit.F90 b/src/incompressible/budget_time_avg_deficit.F90 index aadc61ea..0246cd76 100644 --- a/src/incompressible/budget_time_avg_deficit.F90 +++ b/src/incompressible/budget_time_avg_deficit.F90 @@ -302,61 +302,63 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) this%splitPressureDNS = this%prim_budget%igrid_sim%computeDNSPressure this%HaveScalars = this%prim_budget%igrid_sim%useScalars - - if((this%tidx_budget_start > 0) .and. (this%time_budget_start > 0.0d0)) then - call GracefulExit("Both tidx_budget_start and time_budget_start in budget_time_avg are positive. Turn one negative", 100) - endif - + if(this%do_budgets) then - !if (this%isStratified) then - ! Always assume that you are stratified - - if (this%HaveScalars) then - allocate(this%budget_0(this%nx,this%ny,this%nz,30+2*this%prim_budget%igrid_sim%n_scalars)) - else - allocate(this%budget_0(this%nx,this%ny,this%nz,30)) - end if - allocate(this%budget_2(this%nx,this%ny,this%nz,19)) - allocate(this%budget_1(this%nx,this%ny,this%nz,34)) - !else - ! allocate(this%budget_0(this%nx,this%ny,this%nz,25)) - ! allocate(this%budget_2(this%nx,this%ny,this%nz,07)) - ! allocate(this%budget_1(this%nx,this%ny,this%nz,10)) - !end if - allocate(this%budget_3(this%nx,this%ny,this%nz,22)) - allocate(this%budget_4_11(this%nx,this%ny,this%nz,10)) - allocate(this%budget_4_22(this%nx,this%ny,this%nz,10)) - allocate(this%budget_4_13(this%nx,this%ny,this%nz,10)) - allocate(this%budget_4_23(this%nx,this%ny,this%nz,10)) - allocate(this%budget_4_33(this%nx,this%ny,this%nz,10)) - - if ((trim(budgets_dir) .eq. "null") .or.(trim(budgets_dir) .eq. "NULL")) then - this%budgets_dir = this%prim_budget%igrid_sim%outputDir - end if + ! allocate budget 0 -> minimum needed! + if (this%HaveScalars) then + allocate(this%budget_0(this%nx,this%ny,this%nz,30+2*this%prim_budget%igrid_sim%n_scalars)) + else + allocate(this%budget_0(this%nx,this%ny,this%nz,30)) + end if + ! allocate budget 1 + if (this%budgetType > 0) then + allocate(this%budget_1(this%nx,this%ny,this%nz,34)) + end if + ! allocate budget 2 + if (this%budgetType > 1) then + allocate(this%budget_2(this%nx,this%ny,this%nz,19)) + end if + ! allocate budget 3 + if (this%budgetType > 2) then + allocate(this%budget_3(this%nx,this%ny,this%nz,22)) + end if + ! allocate budget 4 + if (this%budgetType > 3) then + allocate(this%budget_4_11(this%nx,this%ny,this%nz,10)) + allocate(this%budget_4_22(this%nx,this%ny,this%nz,10)) + allocate(this%budget_4_13(this%nx,this%ny,this%nz,10)) + allocate(this%budget_4_23(this%nx,this%ny,this%nz,10)) + allocate(this%budget_4_33(this%nx,this%ny,this%nz,10)) + end if + ! set buget output directory if not provided + if ((trim(budgets_dir) .eq. "null") .or.(trim(budgets_dir) .eq. "NULL")) then + this%budgets_dir = this%prim_budget%igrid_sim%outputDir + end if + ! set buget restart directory if not provided if ((trim(restart_dir) .eq. "null") .or.(trim(restart_dir) .eq. "NULL")) then restart_dir = this%budgets_dir end if - - if (restart_budgets) then - call message(0,"Budget deficit restart") - call this%RestartBudget(restart_dir, restart_rid, restart_tid, restart_counter) - else - call this%resetBudget() - end if - - ! ! STEP 4: For horizontally-averaged surface quantities (called Scalar here), and turbine statistics - ! allocate(this%inst_horz_avg(5)) ! [ustar, uw, vw, Linv, wT] - ! allocate(this%runningSum_sc(5)) - ! this%runningSum_sc = zero - ! if(this%useWindTurbines) then - ! allocate(this%runningSum_sc_turb(8*this%prim_budget%igrid_sim%WindTurbineArr%nTurbines)) - ! allocate(this%runningSum_turb (8*this%prim_budget%igrid_sim%WindTurbineArr%nTurbines)) - ! this%runningSum_sc_turb = zero - ! this%runningSum_turb = zero - ! endif + ! if restarting bugets + if (restart_budgets) then + call message(0,"Budget deficit restart") + call this%RestartBudget(restart_dir, restart_rid, restart_tid, restart_counter) + else + call this%resetBudget() + end if + + ! ! STEP 4: For horizontally-averaged surface quantities (called Scalar here), and turbine statistics + ! allocate(this%inst_horz_avg(5)) ! [ustar, uw, vw, Linv, wT] + ! allocate(this%runningSum_sc(5)) + ! this%runningSum_sc = zero + ! if(this%useWindTurbines) then + ! allocate(this%runningSum_sc_turb(8*this%prim_budget%igrid_sim%WindTurbineArr%nTurbines)) + ! allocate(this%runningSum_turb (8*this%prim_budget%igrid_sim%WindTurbineArr%nTurbines)) + ! this%runningSum_sc_turb = zero + ! this%runningSum_turb = zero + ! endif end if @@ -2098,10 +2100,26 @@ subroutine ResetBudget(this) subroutine destroy(this) class(budgets_time_avg_deficit), intent(inout) :: this - nullify(this%prim_budget%igrid_sim) + nullify(this%prim_budget, this%pre_budget) if(this%do_budgets) then ! deallocate(this%uc, this%vc, this%wc, this%usgs, this%vsgs, this%wsgs, this%px, this%py, this%pz, this%uturb) - deallocate(this%budget_0, this%budget_1) + deallocate(this%budget_0) + if (this%budgetType > 0) then + deallocate(this%budget_1) + end if + if (this%budgetType>1) then + deallocate(this%budget_2) + end if + if (this%budgetType>2) then + deallocate(this%budget_3) + end if + if (this%budgetType>3) then + deallocate(this%budget_4_11) + deallocate(this%budget_4_13) + deallocate(this%budget_4_22) + deallocate(this%budget_4_23) + deallocate(this%budget_4_33) + end if ! deallocate(this%runningSum_sc) ! KSH 2025-03-22: Scalars are never allocated? TODO end if if(this%useWindTurbines) then ! remove this block diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 new file mode 100644 index 00000000..22dc76b9 --- /dev/null +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -0,0 +1,1549 @@ +module budgets_time_avg_deficit_compact_mod + use kind_parameters, only: rkind, clen + use decomp_2d + use budgets_time_avg_mod, only: budgets_time_avg + use exits, only: message, GracefulExit + use constants, only: zero, half, two + use mpi + use incompressibleGrid, only : igrid, & + uBC_bottom, uBC_top, vBC_bottom, vBC_top, wBC_bottom, wBC_top, & + TBC_bottom, TBC_top, UWBC_bottom, UWBC_top, VWBC_bottom, VWBC_top, & + WTBC_bottom, WTBC_top + + implicit none + + private + public :: budgets_time_avg_deficit_compact + + ! Comments here + + type :: budgets_time_avg_deficit_compact + private + integer :: run_id, nx, ny, nz + logical :: do_budget0=.false., do_budget1=.false., do_budget2=.false., do_budget3=.false. + + type(igrid), pointer :: prim_igrid_sim + type(budgets_time_avg), pointer :: pre_budget + + complex(rkind), dimension(:,:,:), allocatable, public :: uc, vc, wc, usgs, vsgs, wsgs, px, py, pz, uturb, vturb, wturb, ucor, vcor, wcor, wb + + real(rkind), dimension(:,:,:,:), allocatable :: budget_0, budget_1, budget_2, budget_3 + integer :: size_budget_0, size_budget_1, size_budget_2, size_budget_3 + real(rkind), dimension(:,:,:,:), allocatable :: MCG + logical :: doMCG = .false. + integer :: counter + real(rkind) :: timeSum, weight + character(len=clen) :: budgets_dir + logical :: time_weighted_average=.false. + + logical :: useWindTurbines=.false., isStratified=.true., useCoriolis=.false. + integer :: tidx_dump + integer :: tidx_compute + integer :: tidx_budget_start + real(rkind) :: time_budget_start + logical :: do_budgets + logical :: forceDump + + ! Avoid allocating a new holder of delta_tauij with every call to AssembleBudget3 + real(rkind), dimension(:,:,:,:), allocatable :: delta_tauij + + contains + procedure :: init + procedure :: destroy + procedure :: ResetBudget + procedure :: RestartBudget + procedure, private :: restart_budget_field + procedure :: DoBudgets + + procedure, private :: updateBudget + procedure, private :: DumpBudget + procedure, private :: dump_budget_field + + procedure, private :: AssembleBudget0 + procedure, private :: AssembleBudget1 + procedure, private :: AssembleBudget2 + procedure, private :: AssembleBudget3 + procedure, private :: AssembleMCG + procedure, private :: restartMCG + procedure, private :: getProductOfMeans + procedure, private :: ddx_R2R + procedure, private :: ddy_R2R + procedure, private :: ddz_R2R + procedure, private :: dealias + procedure, private :: interp_Edge2Cell + end type + + contains + + subroutine init(this, pre_budget, primary_inputfile, prim_igrid_sim) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + character(len=*), intent(in) :: primary_inputfile + type(budgets_time_avg), intent(inout), target :: pre_budget + type(igrid), intent(inout), target :: prim_igrid_sim + character(len=clen) :: budgets_dir = "NULL" + character(len=clen) :: restart_dir = "NULL" + integer :: ioUnit, ierr, restart_tid = 0, restart_rid = 0, restart_counter = 0 + logical :: restart_budgets = .false. + integer :: tidx_compute = 10000, tidx_dump = 10000, tidx_budget_start = -100 + real(rkind) :: time_budget_start = -1.0d0 + logical :: use_time_weighted_average=.false. + logical :: do_budgets = .false. + logical :: do_budget0=.false., do_budget1=.false., do_budget2=.false., do_budget3=.false. + namelist /BUDGET_TIME_AVG_DEFICIT_COMPACT/ budgets_dir, restart_budgets, restart_dir, & + restart_rid, restart_tid, restart_counter, tidx_dump, tidx_compute, do_budgets, & + use_time_weighted_average, tidx_budget_start, time_budget_start, & + do_budget0, do_budget1, do_budget2, do_budget3 + + ! STEP 1: Read in inputs, link pointers and allocate budget vectors + ioUnit = 534 + open(unit=ioUnit, file=trim(primary_inputfile), form='FORMATTED', iostat=ierr) + read(unit=ioUnit, NML=BUDGET_TIME_AVG_DEFICIT_COMPACT) + close(ioUnit) + + this%pre_budget => pre_budget + this%prim_igrid_sim => prim_igrid_sim + this%run_id = this%prim_igrid_sim%runid + this%nx = this%prim_igrid_sim%gpC%xsz(1) + this%ny = this%prim_igrid_sim%gpC%xsz(2) + this%nz = this%prim_igrid_sim%gpC%xsz(3) ! centered grid x, y, z + this%do_budgets = do_budgets + this%tidx_dump = tidx_dump + this%tidx_compute = tidx_compute + this%tidx_budget_start = tidx_budget_start + this%time_budget_start = time_budget_start + !this%useWindTurbines = this%prim_igrid_sim%useWindTurbines + this%isStratified = this%prim_igrid_sim%isStratified + this%useCoriolis = this%prim_igrid_sim%useCoriolis + ! Deactivate time-weighted sum till time-averaged budgets are weighted similarily + !this%time_weighted_average = use_time_weighted_average + this%time_weighted_average = .False. + this%forceDump = .false. + this%do_budget0 = do_budget0 + this%do_budget1 = do_budget1 + this%do_budget2 = do_budget2 + this%do_budget3 = do_budget3 + + if(this%do_budget1)this%do_budget0=.true. + if(this%do_budget2)this%do_budget0=.true. + if(this%do_budget3)then + this%do_budget0=.true. + this%do_budget1=.true. + this%do_budget2=.true. + end if + if(this%do_budget2) this%doMCG = .true. + this%budgets_dir = budgets_dir + + if(this%do_budgets) then + if((this%tidx_budget_start > 0) .and. (this%time_budget_start > zero)) then + call GracefulExit("Both tidx_budget_start and time_budget_start in budget_time_avg are positive. Turn one negative", 100) + endif + + if(this%do_budget0)then + if(this%useWindTurbines)then + this%size_budget_0 = 22 + else + this%size_budget_0 = 20 + end if + allocate(this%budget_0(this%nx,this%ny,this%nz,this%size_budget_0)) + end if + + if(this%do_budget1)then + this%size_budget_1 = 15 + allocate(this%budget_1(this%nx,this%ny,this%nz,this%size_budget_1)) + end if + + if(this%do_budget2)then + this%size_budget_2 = 15 + allocate(this%budget_2(this%nx,this%ny,this%nz,this%size_budget_2)) + end if + + if(this%do_budget3)then + if(this%useWindTurbines)then + this%size_budget_3 = 21 + else + this%size_budget_3 = 19 + end if + allocate(this%budget_3(this%nx,this%ny,this%nz,this%size_budget_3)) + allocate(this%delta_tauij(this%nx,this%ny,this%nz,6)) + end if + + if(this%doMCG)allocate(this%MCG(this%nx,this%ny,this%nz,18)) + + if ((trim(budgets_dir) .eq. "null") .or.(trim(budgets_dir) .eq. "NULL")) then + this%budgets_dir = this%prim_igrid_sim%outputDir + end if + + if ((trim(restart_dir) .eq. "null") .or.(trim(restart_dir) .eq. "NULL")) then + restart_dir = this%budgets_dir + end if + + if (restart_budgets) then + call message(0,"Budget deficit restart") + call this%RestartBudget(restart_dir, restart_rid, restart_tid, restart_counter) + else + call this%resetBudget() + end if + + ! STEP 2: Allocate memory (large amount of memory needed) + + call prim_igrid_sim%spectC%alloc_r2c_out(this%uc) + call prim_igrid_sim%spectC%alloc_r2c_out(this%vc) + call prim_igrid_sim%spectE%alloc_r2c_out(this%wc) + call prim_igrid_sim%spectC%alloc_r2c_out(this%usgs) + call prim_igrid_sim%spectC%alloc_r2c_out(this%vsgs) + call prim_igrid_sim%spectE%alloc_r2c_out(this%wsgs) + call prim_igrid_sim%spectC%alloc_r2c_out(this%px) + call prim_igrid_sim%spectC%alloc_r2c_out(this%py) + call prim_igrid_sim%spectE%alloc_r2c_out(this%pz) + if(this%useWindTurbines)then + call prim_igrid_sim%spectC%alloc_r2c_out(this%uturb) + call prim_igrid_sim%spectC%alloc_r2c_out(this%vturb) + call prim_igrid_sim%spectE%alloc_r2c_out(this%wturb) + end if + call prim_igrid_sim%spectC%alloc_r2c_out(this%ucor) + call prim_igrid_sim%spectC%alloc_r2c_out(this%vcor) + call prim_igrid_sim%spectC%alloc_r2c_out(this%wcor) + call prim_igrid_sim%spectE%alloc_r2c_out(this%wb) + + ! STEP 3: Now instrument igrid -> links pointers in the grid object to arrays created for budget + if(this%useWindTurbines)then + call prim_igrid_sim%instrumentForDeficitBudgets(this%uc, this%vc, this%wc, this%usgs, this%vsgs, this%wsgs, this%px, this%py, this%pz, & + this%ucor, this%vcor, this%wcor, this%wb, this%uturb, this%vturb, this%wturb) + else + call prim_igrid_sim%instrumentForDeficitBudgets(this%uc, this%vc, this%wc, this%usgs, this%vsgs, this%wsgs, this%px, this%py, this%pz, & + this%ucor, this%vcor, this%wcor, this%wb) + end if + end if + end subroutine + + subroutine doBudgets(this, forceDump) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + logical, intent(in), optional :: forceDump + + if(present(forceDump)) then + this%forceDump = forceDump + endif + + if(this%prim_igrid_sim%tsim > this%prim_igrid_sim%tstop) then + this%forceDump = .TRUE. + endif + + if (this%do_budgets) then + if( ( (this%tidx_budget_start>0) .and. (this%prim_igrid_sim%step>this%tidx_budget_start) ) .or. & + ( (this%time_budget_start>0) .and. (this%prim_igrid_sim%tsim>this%time_budget_start) ) ) then + + if (mod(this%prim_igrid_sim%step,this%tidx_compute) .eq. 0) then + call this%updateBudget() + end if + + if ((mod(this%prim_igrid_sim%step,this%tidx_dump) .eq. 0) .or. this%forceDump) then + call this%dumpBudget() + call message(0,"Dumped a compact deficit budget file") + end if + end if + end if + + this%forceDump = .false. ! reset to default value + end subroutine + + subroutine updateBudget(this) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + + ! This step computes the pressure field of the primary and precursor simulations. + call this%prim_igrid_sim%getMomentumTerms() + call this%pre_budget%igrid_sim%getMomentumTerms() + + ! Interpolate SGS stresses to cells + call this%pre_budget%igrid_sim%sgsmodel%populate_tauij_E_to_C() + call this%prim_igrid_sim%sgsmodel%populate_tauij_E_to_C() + this%delta_tauij = this%prim_igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij + + if(this%doMCG) call this%AssembleMCG() + if(this%do_budget0) call this%AssembleBudget0() + if(this%do_budget1) call this%AssembleBudget1() + if(this%do_budget2) call this%AssembleBudget2() + if(this%do_budget3) call this%AssembleBudget3() + + this%counter = this%counter + 1 + end subroutine + + subroutine DumpBudget(this) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind) :: totalWeight + integer :: idx, budgetid, budgetsize + real(rkind), dimension(:,:,:), pointer :: buffer + real(rkind), dimension(:,:,:,:), pointer :: budget + logical :: doBudget + + totalWeight = real(this%counter,rkind) + 1.d-18 + + ! Cell x-pencil buffers + ! Buffers 1 and 2 are used locally inside getProductOfMeans + buffer => this%prim_igrid_sim%rbuffxC(:,:,:,4) + + ! Convert assembled budgets to mean instead of sum + if(this%do_budget0) this%budget_0 = this%budget_0/totalWeight + if(this%do_budget1) this%budget_1 = this%budget_1/totalWeight + if(this%do_budget2) this%budget_2 = this%budget_2/totalWeight + if(this%do_budget3) this%budget_3 = this%budget_3/totalWeight + if(this%doMCG) this%MCG = this%MCG/totalWeight + this%pre_budget%budget_0 = this%pre_budget%budget_0/totalWeight + this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight + + ! Budget 0 + if(this%do_budget0)then + budgetid = 0 + do idx = 1, this%size_budget_0 + if((idx.eq.15).or.(idx.eq.16))then + if(.not. this%useCoriolis)cycle + end if + if((idx.eq.5).or.(idx.eq.17))then + if(.not. this%isStratified)cycle + end if + call this%dump_budget_field(this%budget_0(:,:,:,idx), idx, budgetid) + end do + end if + + ! Dealias budgets 1-3 as they hold product of multiple fields + if(this%do_budget1)then + do idx = 1, this%size_budget_1 + call this%dealias(this%budget_1(:,:,:,idx)) + end do + end if + if(this%do_budget2)then + do idx = 1, this%size_budget_2 + call this%dealias(this%budget_2(:,:,:,idx)) + end do + end if + if(this%do_budget3)then + do idx = 1, this%size_budget_3 + call this%dealias(this%budget_3(:,:,:,idx)) + end do + end if + + do budgetid=1,3 + select case(budgetid) + case(1) + budget => this%budget_1 + budgetsize = this%size_budget_1 + doBudget = this%do_budget1 + case(2) + budget => this%budget_2 + budgetsize = this%size_budget_2 + doBudget = this%do_budget2 + case(3) + budget => this%budget_3 + budgetsize = this%size_budget_3 + doBudget = this%do_budget3 + end select + + if(doBudget)then + do idx = 1,budgetsize + + ! Skip Buoyancy covariance in TKE budget + if(budgetid.eq.3)then + if((idx.eq.10).or.(idx.eq.11).or.(idx.eq.12))then + if(.not. this%isStratified) cycle + end if + end if + + ! Get the product of means. buffer is dealiased inside getProductOfMeans + call this%getProductOfMeans(budgetid, idx, buffer) + + ! Remove product of means. The original budget is not impacted + buffer = budget(:,:,:,idx) - buffer + + ! Dump + call this%dump_budget_field(buffer, idx, budgetid) + end do + end if + end do + + ! Return to summing + if(this%do_budget0) this%budget_0 = this%budget_0*totalWeight + if(this%do_budget1) this%budget_1 = this%budget_1*totalWeight + if(this%do_budget2) this%budget_2 = this%budget_2*totalWeight + if(this%do_budget3) this%budget_3 = this%budget_3*totalWeight + if(this%doMCG) this%MCG = this%MCG*totalWeight + this%pre_budget%budget_0 = this%pre_budget%budget_0*totalWeight + this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight + end subroutine + + ! ---------------------- Mean Cell Gradients (MCG) ------------------------ + subroutine AssembleMCG(this) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + this%MCG(:,:,:,1:9) = this%MCG(:,:,:,1:9) + this%prim_igrid_sim%duidxjC(:,:,:,1:9) - this%pre_budget%igrid_sim%duidxjC(:,:,:,1:9) + this%MCG(:,:,:,10:18) = this%MCG(:,:,:,10:18) + this%pre_budget%igrid_sim%duidxjC(:,:,:,1:9) + end subroutine + + ! ---------------------- Budget 0 ------------------------ + subroutine AssembleBudget0(this) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind), dimension(:,:,:), pointer :: rbuffxE1, rbuffxC1, rbuffxC2 + complex(rkind), dimension(:,:,:), pointer :: cbuffyE1, cbuffyC1 + + ! Link pointers + cbuffyE1 => this%prim_igrid_sim%cbuffyE(:,:,:,1) + cbuffyC1 => this%prim_igrid_sim%cbuffyC(:,:,:,2) ! 1 is used in ddx, ddy, ddz routines + rbuffxE1 => this%prim_igrid_sim%rbuffxE(:,:,:,1) + rbuffxC1 => this%prim_igrid_sim%rbuffxC(:,:,:,1) + rbuffxC2 => this%prim_igrid_sim%rbuffxC(:,:,:,2) + + ! STEP 1: Compute mean Delta U, Delta V, and Delta W + this%budget_0(:,:,:,1) = this%budget_0(:,:,:,1) + (this%prim_igrid_sim%u - this%pre_budget%igrid_sim%u) + this%budget_0(:,:,:,2) = this%budget_0(:,:,:,2) + (this%prim_igrid_sim%v - this%pre_budget%igrid_sim%v) + this%budget_0(:,:,:,3) = this%budget_0(:,:,:,3) + (this%prim_igrid_sim%wC - this%pre_budget%igrid_sim%wC) + + ! STEP 2: Pressure + this%budget_0(:,:,:,4) = this%budget_0(:,:,:,4) + (this%prim_igrid_sim%pressure - this%pre_budget%igrid_sim%pressure) + + ! STEP 3: Potential temperature + if (this%isStratified)then + this%budget_0(:,:,:,5) = this%budget_0(:,:,:,5) + (this%prim_igrid_sim%T - this%pre_budget%igrid_sim%T) + + cbuffyE1 = this%wb - this%pre_budget%wb + call this%prim_igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, rbuffxC1, TBC_bottom, TBC_top) + this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) + rbuffxC1 + end if + + ! Step 4: SGS stresses (also viscous stress if finite reynolds number is being used) + this%budget_0(:,:,:,6:11) = this%budget_0(:,:,:,6:11) + this%delta_tauij + + ! Step 5: SGS stress gradients + ! Reverse signs of usgs, vsgs, wsgs + cbuffyC1 = this%pre_budget%usgs - this%usgs + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,12) = this%budget_0(:,:,:,12) + rbuffxC1 + + cbuffyC1 = this%pre_budget%vsgs - this%vsgs + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,13) = this%budget_0(:,:,:,13) + rbuffxC1 + + ! wsgs is odd + cbuffyE1 = this%pre_budget%wsgs - this%wsgs + call this%prim_igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, rbuffxC1, -1, -1) + this%budget_0(:,:,:,14) = this%budget_0(:,:,:,14) + rbuffxC1 + + ! Step 6: Coriolis + if(this%useCoriolis) then + ! Remove the geostrophic forcing term from exported Coriolis force + call this%pre_budget%igrid_sim%get_geostrophic_forcing(rbuffxC1, rbuffxC2) + this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) + rbuffxC1 + this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) + rbuffxC2 + + call this%prim_igrid_sim%get_geostrophic_forcing(rbuffxC1, rbuffxC2) + this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) - rbuffxC1 + this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) - rbuffxC2 + + ! Coriolis term, X + cbuffyC1 = this%ucor - this%pre_budget%ucor + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) + rbuffxC1 + + ! Coriolis term, Y + cbuffyC1 = this%vcor - this%pre_budget%vcor + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) + rbuffxC1 + end if + + ! Step 7: Pressure gradient force + ! px sign is reversed + cbuffyC1 = this%pre_budget%px - this%px + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) + rbuffxC1 + + ! py sign is reversed + cbuffyC1 = this%pre_budget%py - this%py + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) + rbuffxC1 + + ! pz sign is reversed + ! pz is odd + cbuffyE1 = this%pre_budget%pz - this%pz + call this%prim_igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, rbuffxC1, -1, -1) + this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) + rbuffxC1 + + ! Step 8: turbine forcing + if(this%useWindTurbines)then + cbuffyC1 = this%uturb - this%pre_budget%uturb + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,21) = this%budget_0(:,:,:,21) + rbuffxC1 + + cbuffyC1 = this%vturb - this%pre_budget%vturb + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,22) = this%budget_0(:,:,:,22) + rbuffxC1 + end if + + nullify(rbuffxE1, rbuffxC1, rbuffxC2, cbuffyC1, cbuffyE1) + end subroutine + + ! ---------------------- Budget 1 ------------------------ + subroutine AssembleBudget1(this) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind), dimension(:,:,:), pointer :: du, dv, dw, duE, dvE, dwE, buffer, buffE + + ! Cell x-pencil buffers + du => this%prim_igrid_sim%rbuffxC(:,:,:,1) + dv => this%prim_igrid_sim%rbuffxC(:,:,:,2) + dw => this%prim_igrid_sim%rbuffxC(:,:,:,3) + buffer => this%prim_igrid_sim%rbuffxC(:,:,:,4) + + ! Edge x-pencil buffers (only 2 are allocated in igrid.F90) + duE => this%prim_igrid_sim%rbuffxE(:,:,:,1) + dvE => this%prim_igrid_sim%rbuffxE(:,:,:,2) + dwE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,1) + buffE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,2) + + ! Perturbation fields + du = this%prim_igrid_sim%u - this%pre_budget%igrid_sim%u + dv = this%prim_igrid_sim%v - this%pre_budget%igrid_sim%v + dw = this%prim_igrid_sim%wC - this%pre_budget%igrid_sim%wC + + duE = this%prim_igrid_sim%uE - this%pre_budget%igrid_sim%uE + dvE = this%prim_igrid_sim%vE - this%pre_budget%igrid_sim%vE + dwE = this%prim_igrid_sim%w - this%pre_budget%igrid_sim%w + + ! Reynolds stresses + this%budget_1(:,:,:,1) = this%budget_1(:,:,:,1) + du * du + this%budget_1(:,:,:,2) = this%budget_1(:,:,:,2) + du * dv + buffE = duE * dwE; call this%interp_Edge2Cell(buffE, buffer, UWBC_bottom, UWBC_top) + this%budget_1(:,:,:,3) = this%budget_1(:,:,:,3) + buffer + this%budget_1(:,:,:,4) = this%budget_1(:,:,:,4) + dv * dv + buffE = dvE * dwE; call this%interp_Edge2Cell(buffE, buffer, VWBC_bottom, VWBC_top) + this%budget_1(:,:,:,5) = this%budget_1(:,:,:,5) + buffer + this%budget_1(:,:,:,6) = this%budget_1(:,:,:,6) + dw * dw + + ! Mixed Reynolds stresses + this%budget_1(:,:,:,7) = this%budget_1(:,:,:,7) + du * this%pre_budget%igrid_sim%u + this%budget_1(:,:,:,8) = this%budget_1(:,:,:,8) + du * this%pre_budget%igrid_sim%v + this%budget_1(:,:,:,9) = this%budget_1(:,:,:,9) + dv * this%pre_budget%igrid_sim%u + + buffE = duE * this%pre_budget%igrid_sim%w; ; call this%interp_Edge2Cell(buffE, buffer, UWBC_bottom, UWBC_top) + this%budget_1(:,:,:,10) = this%budget_1(:,:,:,10) + buffer + buffE = dwE * this%pre_budget%igrid_sim%uE; call this%interp_Edge2Cell(buffE, buffer, UWBC_bottom, UWBC_top) + this%budget_1(:,:,:,11) = this%budget_1(:,:,:,11) + buffer + this%budget_1(:,:,:,12) = this%budget_1(:,:,:,12) + dv * this%pre_budget%igrid_sim%v + buffE = dvE * this%pre_budget%igrid_sim%w; call this%interp_Edge2Cell(buffE, buffer, VWBC_bottom, VWBC_top) + this%budget_1(:,:,:,13) = this%budget_1(:,:,:,13) + buffer + buffE = dwE * this%pre_budget%igrid_sim%vE; call this%interp_Edge2Cell(buffE, buffer, VWBC_bottom, VWBC_top) + this%budget_1(:,:,:,14) = this%budget_1(:,:,:,14) + buffer + this%budget_1(:,:,:,15) = this%budget_1(:,:,:,15) + dw * this%pre_budget%igrid_sim%wC + + nullify(du, dv, dw, duE, dvE, dwE, buffer, buffE) + end subroutine + + ! ---------------------- Budget 2 ------------------------ + subroutine AssembleBudget2(this) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind), dimension(:,:,:), pointer :: du, dv, buffC, dw + real(rkind), dimension(:,:,:), pointer :: ubase, vbase, wbase + real(rkind), dimension(:,:,:), pointer :: dudxC_prim, dudyC_prim, dudzC_prim, dudxC_pre, dudyC_pre, dudzC_pre + real(rkind), dimension(:,:,:), pointer :: dvdxC_prim, dvdyC_prim, dvdzC_prim, dvdxC_pre, dvdyC_pre, dvdzC_pre + real(rkind), dimension(:,:,:), pointer :: dwdxC_prim, dwdyC_prim, dwdzC_prim, dwdxC_pre, dwdyC_pre, dwdzC_pre + + ! Cell x-pencil buffers + du => this%prim_igrid_sim%rbuffxC(:,:,:,1) + dv => this%prim_igrid_sim%rbuffxC(:,:,:,2) + dw => this%prim_igrid_sim%rbuffxC(:,:,:,3) + buffC => this%prim_igrid_sim%rbuffxC(:,:,:,4) + + ! Perturbation fields + du = this%prim_igrid_sim%u - this%pre_budget%igrid_sim%u + dv = this%prim_igrid_sim%v - this%pre_budget%igrid_sim%v + dw = this%prim_igrid_sim%wC - this%pre_budget%igrid_sim%wC + + ! Base-flow fields + ubase => this%pre_budget%igrid_sim%u + vbase => this%pre_budget%igrid_sim%v + wbase => this%pre_budget%igrid_sim%wC + + ! Primary simulation: + dudxC_prim => this%prim_igrid_sim%duidxjC(:,:,:,1) + dudyC_prim => this%prim_igrid_sim%duidxjC(:,:,:,2) + dudzC_prim => this%prim_igrid_sim%duidxjC(:,:,:,3) + dvdxC_prim => this%prim_igrid_sim%duidxjC(:,:,:,4) + dvdyC_prim => this%prim_igrid_sim%duidxjC(:,:,:,5) + dvdzC_prim => this%prim_igrid_sim%duidxjC(:,:,:,6) + dwdxC_prim => this%prim_igrid_sim%duidxjC(:,:,:,7) + dwdyC_prim => this%prim_igrid_sim%duidxjC(:,:,:,8) + dwdzC_prim => this%prim_igrid_sim%duidxjC(:,:,:,9) + + ! Precursor simulation: + dudxC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,1) + dudyC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,2) + dudzC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,3) + dvdxC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,4) + dvdyC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,5) + dvdzC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,6) + dwdxC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,7) + dwdyC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,8) + dwdzC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,9) + + ! delta u_j d_j(delta u) + this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + du * (dudxC_prim - dudxC_pre) + dv * (dudyC_prim - dudyC_pre) + dw * (dudzC_prim - dudzC_pre) + + ! delta u_j d_j(delta v) + this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + du * (dvdxC_prim - dvdxC_pre) + dv * (dvdyC_prim - dvdyC_pre) + dw * (dvdzC_prim - dvdzC_pre) + + ! delta u_j d_j(delta w) + this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + du * (dwdxC_prim - dwdxC_pre) + dv * (dwdyC_prim - dwdyC_pre) + dw * (dwdzC_prim - dwdzC_pre) + + ! delta u_j d_j(base u) + this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + du * dudxC_pre + dv * dudyC_pre + dw * dudzC_pre + + ! delta u_j d_j(base v) + this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + du * dvdxC_pre + dv * dvdyC_pre + dw * dvdzC_pre + + ! delta u_j d_j(base w) + this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + du * dwdxC_pre + dv * dwdyC_pre + dw * dwdzC_pre + + ! base u_j d_j(delta u) + this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + ubase * (dudxC_prim - dudxC_pre) + vbase * (dudyC_prim - dudyC_pre) + wbase * (dudzC_prim - dudzC_pre) + + ! base u_j d_j(delta v) + this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + ubase * (dvdxC_prim - dvdxC_pre) + vbase * (dvdyC_prim - dvdyC_pre) + wbase * (dvdzC_prim - dvdzC_pre) + + ! base u_j d_j(delta w) + this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + ubase * (dwdxC_prim - dwdxC_pre) + vbase * (dwdyC_prim - dwdyC_pre) + wbase * (dwdzC_prim - dwdzC_pre) + + ! base u_j d_j(base u) + this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + ubase * dudxC_pre + vbase * dudyC_pre + wbase * dudzC_pre + + ! base u_j d_j(base v) + this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + ubase * dvdxC_pre + vbase * dvdyC_pre + wbase * dvdzC_pre + + ! base u_j d_j(base w) + this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + ubase * dwdxC_pre + vbase * dwdyC_pre + wbase * dwdzC_pre + + ! base u_i d_1(delta u_i) + this%budget_2(:,:,:,13) = this%budget_2(:,:,:,13) + ubase * (dudxC_prim - dudxC_pre) + vbase * (dvdxC_prim - dvdxC_pre) + wbase * (dwdxC_prim - dwdxC_pre) + + ! base u_i d_2(delta u_i) + this%budget_2(:,:,:,14) = this%budget_2(:,:,:,14) + ubase * (dudyC_prim - dudyC_pre) + vbase * (dvdyC_prim - dvdyC_pre) + wbase * (dwdyC_prim - dwdyC_pre) + + ! base u_i d_3(delta u_i) + this%budget_2(:,:,:,15) = this%budget_2(:,:,:,15) + ubase * (dudzC_prim - dudzC_pre) + vbase * (dvdzC_prim - dvdzC_pre) + wbase * (dwdzC_prim - dwdzC_pre) + + ! Release memory + nullify(du, dv, dw, buffC) + nullify(ubase, vbase, wbase) + nullify(dudxC_prim, dudyC_prim, dudzC_prim, dudxC_pre, dudyC_pre, dudzC_pre) + nullify(dvdxC_prim, dvdyC_prim, dvdzC_prim, dvdxC_pre, dvdyC_pre, dvdzC_pre) + nullify(dwdxC_prim, dwdyC_prim, dwdzC_prim, dwdxC_pre, dwdyC_pre, dwdzC_pre) + end subroutine + + ! ---------------------- Budget 3 ------------------------ + subroutine AssembleBudget3(this) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind), dimension(:,:,:), pointer :: du, dv, dw + real(rkind), dimension(:,:,:), pointer :: ubase, vbase, wbase + real(rkind), dimension(:,:,:), pointer :: rbuffxE1, rbuffxE2, buffer + complex(rkind), dimension(:,:,:), pointer :: cbuffyE1, cbuffyC1 + real(rkind), dimension(:,:,:), pointer :: dudxC_prim, dudyC_prim, dudzC_prim, dudxC_pre, dudyC_pre, dudzC_pre + real(rkind), dimension(:,:,:), pointer :: dvdxC_prim, dvdyC_prim, dvdzC_prim, dvdxC_pre, dvdyC_pre, dvdzC_pre + real(rkind), dimension(:,:,:), pointer :: dwdxC_prim, dwdyC_prim, dwdzC_prim, dwdxC_pre, dwdyC_pre, dwdzC_pre + real(rkind), dimension(:,:,:,:), pointer :: base_tauij + + ! Cell x-pencil buffers + du => this%prim_igrid_sim%rbuffxC(:,:,:,1) + dv => this%prim_igrid_sim%rbuffxC(:,:,:,2) + dw => this%prim_igrid_sim%rbuffxC(:,:,:,3) + buffer => this%prim_igrid_sim%rbuffxC(:,:,:,4) + + ! Cell y-pencil buffer + cbuffyC1 => this%prim_igrid_sim%cbuffyC(:,:,:,2) ! 1 is used in ddx, ddy, ddz routines + + ! Edge x-pencil buffer + rbuffxE1 => this%prim_igrid_sim%rbuffxE(:,:,:,1) + rbuffxE2 => this%prim_igrid_sim%rbuffxE(:,:,:,2) + + ! Edge y-pencil buffer + cbuffyE1 => this%prim_igrid_sim%cbuffyE(:,:,:,1) + + ! Perturbation fields + du = this%prim_igrid_sim%u - this%pre_budget%igrid_sim%u + dv = this%prim_igrid_sim%v - this%pre_budget%igrid_sim%v + dw = this%prim_igrid_sim%wC - this%pre_budget%igrid_sim%wC + + ubase => this%pre_budget%igrid_sim%u + vbase => this%pre_budget%igrid_sim%v + wbase => this%pre_budget%igrid_sim%wC + + ! Primary simulation gradients: + dudxC_prim => this%prim_igrid_sim%duidxjC(:,:,:,1) + dudyC_prim => this%prim_igrid_sim%duidxjC(:,:,:,2) + dudzC_prim => this%prim_igrid_sim%duidxjC(:,:,:,3) + dvdxC_prim => this%prim_igrid_sim%duidxjC(:,:,:,4) + dvdyC_prim => this%prim_igrid_sim%duidxjC(:,:,:,5) + dvdzC_prim => this%prim_igrid_sim%duidxjC(:,:,:,6) + dwdxC_prim => this%prim_igrid_sim%duidxjC(:,:,:,7) + dwdyC_prim => this%prim_igrid_sim%duidxjC(:,:,:,8) + dwdzC_prim => this%prim_igrid_sim%duidxjC(:,:,:,9) + + ! Precursor simulation gradients: + dudxC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,1) + dudyC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,2) + dudzC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,3) + dvdxC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,4) + dvdyC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,5) + dvdzC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,6) + dwdxC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,7) + dwdyC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,8) + dwdzC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,9) + base_tauij => this%pre_budget%igrid_sim%tauSGS_ij + + ! Term 1: delta u_j' d_j(delta p') + ! Term 2: base u_j' d_j(delta p') + ! px, py, pz signs are reversed + cbuffyC1 = this%pre_budget%px - this%px + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, buffer) + this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ buffer * du + this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ buffer * ubase + + cbuffyC1 = this%pre_budget%py - this%py + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, buffer) + this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ buffer * dv + this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ buffer * vbase + + ! pz is odd + cbuffyE1 = this%pre_budget%pz - this%pz + call this%prim_igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, buffer, -1, -1) + this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ buffer * dw + this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ buffer * wbase + + ! Term 3: delta u_j' d_j(base p') + ! px, py, pz signs are reversed + call this%pre_budget%igrid_sim%spectC%ifft(this%pre_budget%px, buffer) + this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- buffer * du + + call this%pre_budget%igrid_sim%spectC%ifft(this%pre_budget%py, buffer) + this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- buffer * dv + + ! pz is odd + call this%pre_budget%igrid_sim%spectE%ifft(this%pre_budget%pz, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, buffer, -1, -1) + this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- buffer * dw + + ! Term 4: d_j(base u_i' * delta tau_ij') [SGS transport] + ! Term 6: d_j(delta u_i' * delta tau_ij') [SGS transport] + ! sign of usgs, vsgs, and wsgs are reversed. + cbuffyC1 = this%pre_budget%usgs - this%usgs + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, buffer) + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer * ubase + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer * du + + cbuffyC1 = this%pre_budget%vsgs - this%vsgs + call this%prim_igrid_sim%spectC%ifft(cbuffyC1, buffer) + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer * vbase + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer * dv + + ! wsgs is odd + cbuffyE1 = this%pre_budget%wsgs - this%wsgs + call this%prim_igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, buffer, -1, -1) + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer * wbase + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer * dw + + ! Term 5: d_j(delta u_i' base tau_ij') [SGS transport] + ! sign of usgs, vsgs, and wsgs are reversed. + call this%pre_budget%igrid_sim%spectC%ifft(this%pre_budget%usgs, buffer) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - buffer * du + + call this%pre_budget%igrid_sim%spectC%ifft(this%pre_budget%vsgs, buffer) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - buffer * dv + + ! wsgs is odd + call this%pre_budget%igrid_sim%spectE%ifft(this%pre_budget%wsgs, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, buffer, -1, -1) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - buffer * dw + + ! The remaining of B3(4) is exactly B3(7). Calculation is done once + ! Term 4: d_j(base u_i' * delta tau_ij') [SGS transport] + ! Term 7: delta tau_ij' d_j(base u_i') [SGS dissipation] + buffer = dudxC_pre*this%delta_tauij(:,:,:,1) + dudyC_pre*this%delta_tauij(:,:,:,2) + dudzC_pre*this%delta_tauij(:,:,:,3)+& + dvdxC_pre*this%delta_tauij(:,:,:,2) + dvdyC_pre*this%delta_tauij(:,:,:,4) + dvdzC_pre*this%delta_tauij(:,:,:,5)+& + dwdxC_pre*this%delta_tauij(:,:,:,3) + dwdyC_pre*this%delta_tauij(:,:,:,5) + dwdzC_pre*this%delta_tauij(:,:,:,6) + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + + ! The remaining of B3(5) is exactly B3(8). Calculation is done once + ! Term 5: d_j(delta u_i' base tau_ij') [SGS transport] + ! Term 8: base tau_ij' * d_j(delta u_i') [SGS dissipation] + buffer = (dudxC_prim-dudxC_pre)*base_tauij(:,:,:,1)+(dudyC_prim-dudyC_pre)*base_tauij(:,:,:,2)+(dudzC_prim-dudzC_pre)*base_tauij(:,:,:,3)+& + (dvdxC_prim-dvdxC_pre)*base_tauij(:,:,:,2)+(dvdyC_prim-dvdyC_pre)*base_tauij(:,:,:,4)+(dvdzC_prim-dvdzC_pre)*base_tauij(:,:,:,5)+& + (dwdxC_prim-dwdxC_pre)*base_tauij(:,:,:,3)+(dwdyC_prim-dwdyC_pre)*base_tauij(:,:,:,5)+(dwdzC_prim-dwdzC_pre)*base_tauij(:,:,:,6) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + + ! The remaining of B3(6) is exactly B3(9). Calculation is done once + ! Term 6: d_j(delta u_i' * delta tau_ij') [SGS transport] + ! Term 9: delta tau_ij' * d_j(delta u_i') [SGS dissipation] + buffer = (dudxC_prim-dudxC_pre)*this%delta_tauij(:,:,:,1)+(dudyC_prim-dudyC_pre)*this%delta_tauij(:,:,:,2)+(dudzC_prim-dudzC_pre)*this%delta_tauij(:,:,:,3)+& + (dvdxC_prim-dvdxC_pre)*this%delta_tauij(:,:,:,2)+(dvdyC_prim-dvdyC_pre)*this%delta_tauij(:,:,:,4)+(dvdzC_prim-dvdzC_pre)*this%delta_tauij(:,:,:,5)+& + (dwdxC_prim-dwdxC_pre)*this%delta_tauij(:,:,:,3)+(dwdyC_prim-dwdyC_pre)*this%delta_tauij(:,:,:,5)+(dwdzC_prim-dwdzC_pre)*this%delta_tauij(:,:,:,6) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + + ! Term 10: delta u_3' delta wb' + ! Term 11: delta u_3' base wb' + ! Term 12: base u_3' delta wb' + ! Multiply on edges + if(this%isStratified)then + cbuffyE1 = this%wb - this%pre_budget%wb + call this%prim_igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + + rbuffxE2 = rbuffxE1 * (this%prim_igrid_sim%w - this%pre_budget%igrid_sim%w) + call this%interp_Edge2Cell(rbuffxE2, buffer, WTBC_bottom, WTBC_top) + this%budget_3(:,:,:,10) = this%budget_3(:,:,:,10) + buffer + + rbuffxE2 = rbuffxE1 * this%pre_budget%igrid_sim%w + call this%interp_Edge2Cell(rbuffxE2, buffer, WTBC_bottom, WTBC_top) + this%budget_3(:,:,:,12) = this%budget_3(:,:,:,12) + buffer + + call this%pre_budget%igrid_sim%spectE%ifft(this%pre_budget%wb, rbuffxE1) + rbuffxE2 = (this%prim_igrid_sim%w - this%pre_budget%igrid_sim%w) * rbuffxE1 + call this%interp_Edge2Cell(rbuffxE2, buffer, WTBC_bottom, WTBC_top) + this%budget_3(:,:,:,11) = this%budget_3(:,:,:,11) + buffer + end if + + ! Term 13: base u_i' delta u_j' d_j(base u_i') [Turbulent transport of TKE] + ! Term 17: delta u_i' delta u_j' d_j(base u_i') [Turbulent transport of TKE] + buffer = du * dudxC_pre + dv * dudyC_pre + dw * dudzC_pre + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + ubase * buffer + this%budget_3(:,:,:,17) = this%budget_3(:,:,:,17) + du * buffer + + buffer = du * dvdxC_pre + dv * dvdyC_pre + dw * dvdzC_pre + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + vbase * buffer + this%budget_3(:,:,:,17) = this%budget_3(:,:,:,17) + dv * buffer + + buffer = du * dwdxC_pre + dv * dwdyC_pre + dw * dwdzC_pre + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + wbase * buffer + this%budget_3(:,:,:,17) = this%budget_3(:,:,:,17) + dw * buffer + + ! Term 14: base u_i' base u_j' d_j(delta u_i') [Turbulent transport of TKE] + ! Term 18: delta u_i' base u_j' d_j(delta u_i') [Turbulent transport of TKE] + buffer = ubase*(dudxC_prim-dudxC_pre) + vbase*(dudyC_prim-dudyC_pre) + wbase*(dudzC_prim-dudzC_pre) + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + ubase * buffer + this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + du * buffer + + buffer = ubase*(dvdxC_prim-dvdxC_pre) + vbase*(dvdyC_prim-dvdyC_pre) + wbase*(dvdzC_prim-dvdzC_pre) + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + vbase * buffer + this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + dv * buffer + + buffer = ubase*(dwdxC_prim-dwdxC_pre) + vbase*(dwdyC_prim-dwdyC_pre) + wbase*(dwdzC_prim-dwdzC_pre) + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + wbase * buffer + this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + dw * buffer + + ! Term 15: delta u_i' base u_j' d_j(base u_i') [Turbulent transport of TKE] + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + & + du*(ubase * dudxC_pre + vbase * dudyC_pre + wbase * dudzC_pre) + & + dv*(ubase * dvdxC_pre + vbase * dvdyC_pre + wbase * dvdzC_pre) + & + dw*(ubase * dwdxC_pre + vbase * dwdyC_pre + wbase * dwdzC_pre) + + ! Term 16: base u_i' delta u_j' d_j(delta u_i') [Turbulent transport of TKE] + ! Term 19: delta u_i' delta u_j' d_j(delta u_i') [Turbulent transport of TKE] + buffer = du*(dudxC_prim-dudxC_pre) + dv*(dudyC_prim-dudyC_pre) + dw*(dudzC_prim-dudzC_pre) + this%budget_3(:,:,:,16) = this%budget_3(:,:,:,16) + ubase * buffer + this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + du * buffer + + buffer = du*(dvdxC_prim-dvdxC_pre) + dv*(dvdyC_prim-dvdyC_pre) + dw*(dvdzC_prim-dvdzC_pre) + this%budget_3(:,:,:,16) = this%budget_3(:,:,:,16) + vbase * buffer + this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + dv * buffer + + buffer = du*(dwdxC_prim-dwdxC_pre) + dv*(dwdyC_prim-dwdyC_pre) + dw*(dwdzC_prim-dwdzC_pre) + this%budget_3(:,:,:,16) = this%budget_3(:,:,:,16) + wbase * buffer + this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + dw * buffer + + ! if (this%useWindTurbines)then + ! cbuffyC1 = this%uturb - this%pre_budget%uturb + ! call this%prim_igrid_sim%spectC%ifft(cbuffyC1, buffer) + ! this%budget_3(:,:,:,20) = this%budget_3(:,:,:,20) + du * buffer + ! this%budget_3(:,:,:,21) = this%budget_3(:,:,:,21) + ubase * buffer + + ! cbuffyC1 = this%vturb - this%pre_budget%vturb + ! call this%prim_igrid_sim%spectC%ifft(cbuffyC1, buffer) + ! this%budget_3(:,:,:,20) = this%budget_3(:,:,:,20) + dv * buffer + ! this%budget_3(:,:,:,21) = this%budget_3(:,:,:,21) + vbase * buffer + ! end if + + nullify(du, dv, dw, rbuffxE1, rbuffxE2, buffer, buffer, cbuffyE1, cbuffyC1, ubase, vbase, wbase) + nullify(dudxC_prim, dudyC_prim, dudzC_prim, dudxC_pre, dudyC_pre, dudzC_pre) + nullify(dvdxC_prim, dvdyC_prim, dvdzC_prim, dvdxC_pre, dvdyC_pre, dvdzC_pre) + nullify(dwdxC_prim, dwdyC_prim, dwdzC_prim, dwdxC_pre, dwdyC_pre, dwdzC_pre) + end subroutine + + subroutine getProductOfMeans(this, budgetid, idx, buffer) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + integer, intent(in) :: idx, budgetid + real(rkind), dimension(:,:,:), intent(out) :: buffer + real(rkind), dimension(:,:,:), pointer :: bf, bf2 + + ! Cell x-pencil buffers + bf => this%prim_igrid_sim%rbuffxC(:,:,:,1) + bf2 => this%prim_igrid_sim%rbuffxC(:,:,:,2) + buffer = 0.d0 + + if(budgetid.eq.1)then + select case(idx) + case(1) + buffer = this%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) + case(2) + buffer = this%budget_0(:,:,:,1)*this%budget_0(:,:,:,2) + case(3) + buffer = this%budget_0(:,:,:,1)*this%budget_0(:,:,:,3) + case(4) + buffer = this%budget_0(:,:,:,2)*this%budget_0(:,:,:,2) + case(5) + buffer = this%budget_0(:,:,:,2)*this%budget_0(:,:,:,3) + case(6) + buffer = this%budget_0(:,:,:,3)*this%budget_0(:,:,:,3) + case(7) + buffer = this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,1) + case(8) + buffer = this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,2) + case(9) + buffer = this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,1) + case(10) + buffer = this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,3) + case(11) + buffer = this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,1) + case(12) + buffer = this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,2) + case(13) + buffer = this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,3) + case(14) + buffer = this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,2) + case(15) + buffer = this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,3) + end select + + else if(budgetid.eq.2)then + select case(idx) + case(1) + buffer = this%budget_0(:,:,:,1)*this%MCG(:,:,:,1) + & + this%budget_0(:,:,:,2)*this%MCG(:,:,:,2) + & + this%budget_0(:,:,:,3)*this%MCG(:,:,:,3) + case(2) + buffer = this%budget_0(:,:,:,1)*this%MCG(:,:,:,4) + & + this%budget_0(:,:,:,2)*this%MCG(:,:,:,5) + & + this%budget_0(:,:,:,3)*this%MCG(:,:,:,6) + case(3) + buffer = this%budget_0(:,:,:,1)*this%MCG(:,:,:,7) + & + this%budget_0(:,:,:,2)*this%MCG(:,:,:,8) + & + this%budget_0(:,:,:,3)*this%MCG(:,:,:,9) + case(4) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,1) + & + this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,2) + & + this%pre_budget%budget_0(:,:,:,3)*this%MCG(:,:,:,3) + case(5) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,4) + & + this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,5) + & + this%pre_budget%budget_0(:,:,:,3)*this%MCG(:,:,:,6) + case(6) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,7) + & + this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,8) + & + this%pre_budget%budget_0(:,:,:,3)*this%MCG(:,:,:,9) + case(7) + buffer = this%budget_0(:,:,:,1)*this%MCG(:,:,:,10) + & + this%budget_0(:,:,:,2)*this%MCG(:,:,:,11) + & + this%budget_0(:,:,:,3)*this%MCG(:,:,:,12) + case(8) + buffer = this%budget_0(:,:,:,1)*this%MCG(:,:,:,13) + & + this%budget_0(:,:,:,2)*this%MCG(:,:,:,14) + & + this%budget_0(:,:,:,3)*this%MCG(:,:,:,15) + case(9) + buffer = this%budget_0(:,:,:,1)*this%MCG(:,:,:,16) + & + this%budget_0(:,:,:,2)*this%MCG(:,:,:,17) + & + this%budget_0(:,:,:,3)*this%MCG(:,:,:,18) + case(10) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,10) + & + this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,11) + & + this%pre_budget%budget_0(:,:,:,3)*this%MCG(:,:,:,12) + case(11) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,13) + & + this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,14) + & + this%pre_budget%budget_0(:,:,:,3)*this%MCG(:,:,:,15) + case(12) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,16) + & + this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,17) + & + this%pre_budget%budget_0(:,:,:,3)*this%MCG(:,:,:,18) + case(13) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,1) + & + this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,4) + & + this%pre_budget%budget_0(:,:,:,3)*this%MCG(:,:,:,7) + case(14) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,2) + & + this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,5) + & + this%pre_budget%budget_0(:,:,:,3)*this%MCG(:,:,:,8) + case(15) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,3) + & + this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,6) + & + this%pre_budget%budget_0(:,:,:,3)*this%MCG(:,:,:,9) + end select + + else if(budgetid.eq.3)then + select case(idx) + case(1) ! delta u_j' d_j(delta p') + buffer = this%budget_0(:,:,:,1)*this%budget_0(:,:,:,18) + & + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,19) + & + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,20) + + case(2) ! base u_j' d_j(delta p') + buffer = this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,18) + & + this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,19) + & + this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,20) + + case(3) ! delta u_j' d_j(base p') + ! px, py, pz signs are reversed in base-flow budget + buffer = - this%budget_0(:,:,:,1)*this%pre_budget%budget_1(:,:,:,2) & + - this%budget_0(:,:,:,2)*this%pre_budget%budget_1(:,:,:,6) & + - this%budget_0(:,:,:,3)*this%pre_budget%budget_1(:,:,:,9) + + case(4) ! d_j(base u_i' delta tau_ij') [SGS transport] + buffer = this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,12) + & + this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,13) + & + this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,14) + & + this%MCG(:,:,:,10) * this%budget_0(:,:,:,6) + & + this%MCG(:,:,:,11) * this%budget_0(:,:,:,7) + & + this%MCG(:,:,:,12) * this%budget_0(:,:,:,8) + & + this%MCG(:,:,:,13) * this%budget_0(:,:,:,7) + & + this%MCG(:,:,:,14) * this%budget_0(:,:,:,9) + & + this%MCG(:,:,:,15) * this%budget_0(:,:,:,10) + & + this%MCG(:,:,:,16) * this%budget_0(:,:,:,8) + & + this%MCG(:,:,:,17) * this%budget_0(:,:,:,10) + & + this%MCG(:,:,:,18) * this%budget_0(:,:,:,11) + + case(5) ! d_j(delta u_i' base tau_ij') [SGS transport] + ! The sign of ui_sgs in this%pre_budget%budget_1 is reversed + buffer = - this%budget_0(:,:,:,1)*this%pre_budget%budget_1(:,:,:,3) & + - this%budget_0(:,:,:,2)*this%pre_budget%budget_1(:,:,:,7) & + - this%budget_0(:,:,:,3)*this%pre_budget%budget_1(:,:,:,10) + & + this%MCG(:,:,:,1) * this%pre_budget%budget_0(:,:,:,11) + & + this%MCG(:,:,:,2) * this%pre_budget%budget_0(:,:,:,12) + & + this%MCG(:,:,:,3) * this%pre_budget%budget_0(:,:,:,13) + & + this%MCG(:,:,:,4) * this%pre_budget%budget_0(:,:,:,12) + & + this%MCG(:,:,:,5) * this%pre_budget%budget_0(:,:,:,14) + & + this%MCG(:,:,:,6) * this%pre_budget%budget_0(:,:,:,15) + & + this%MCG(:,:,:,7) * this%pre_budget%budget_0(:,:,:,13) + & + this%MCG(:,:,:,8) * this%pre_budget%budget_0(:,:,:,15) + & + this%MCG(:,:,:,9) * this%pre_budget%budget_0(:,:,:,16) + + case(6) ! d_j(delta u_i' * delta tau_ij') [SGS transport] + buffer = this%budget_0(:,:,:,1)*this%budget_0(:,:,:,12) + & + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,13) + & + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,14) + & + this%MCG(:,:,:,1) * this%budget_0(:,:,:,6) + & + this%MCG(:,:,:,2) * this%budget_0(:,:,:,7) + & + this%MCG(:,:,:,3) * this%budget_0(:,:,:,8) + & + this%MCG(:,:,:,4) * this%budget_0(:,:,:,7) + & + this%MCG(:,:,:,5) * this%budget_0(:,:,:,9) + & + this%MCG(:,:,:,6) * this%budget_0(:,:,:,10) + & + this%MCG(:,:,:,7) * this%budget_0(:,:,:,8) + & + this%MCG(:,:,:,8) * this%budget_0(:,:,:,10) + & + this%MCG(:,:,:,9) * this%budget_0(:,:,:,11) + + case(7) ! delta tau_ij' * d_j(base u_i') [SGS dissipation] + buffer = this%MCG(:,:,:,10) * this%budget_0(:,:,:,6) + & + this%MCG(:,:,:,11) * this%budget_0(:,:,:,7) + & + this%MCG(:,:,:,12) * this%budget_0(:,:,:,8) + & + this%MCG(:,:,:,13) * this%budget_0(:,:,:,7) + & + this%MCG(:,:,:,14) * this%budget_0(:,:,:,9) + & + this%MCG(:,:,:,15) * this%budget_0(:,:,:,10) + & + this%MCG(:,:,:,16) * this%budget_0(:,:,:,8) + & + this%MCG(:,:,:,17) * this%budget_0(:,:,:,10) + & + this%MCG(:,:,:,18) * this%budget_0(:,:,:,11) + + case(8) ! base tau_ij' * d_j(delta u_i') [SGS dissipation] + buffer = this%MCG(:,:,:,1) * this%pre_budget%budget_0(:,:,:,11) + & + this%MCG(:,:,:,2) * this%pre_budget%budget_0(:,:,:,12) + & + this%MCG(:,:,:,3) * this%pre_budget%budget_0(:,:,:,13) + & + this%MCG(:,:,:,4) * this%pre_budget%budget_0(:,:,:,12) + & + this%MCG(:,:,:,5) * this%pre_budget%budget_0(:,:,:,14) + & + this%MCG(:,:,:,6) * this%pre_budget%budget_0(:,:,:,15) + & + this%MCG(:,:,:,7) * this%pre_budget%budget_0(:,:,:,13) + & + this%MCG(:,:,:,8) * this%pre_budget%budget_0(:,:,:,15) + & + this%MCG(:,:,:,9) * this%pre_budget%budget_0(:,:,:,16) + + case(9) ! delta tau_ij' * d_j(delta u_i') [SGS dissipation] + buffer = this%MCG(:,:,:,1) * this%budget_0(:,:,:,6) + & + this%MCG(:,:,:,2) * this%budget_0(:,:,:,7) + & + this%MCG(:,:,:,3) * this%budget_0(:,:,:,8) + & + this%MCG(:,:,:,4) * this%budget_0(:,:,:,7) + & + this%MCG(:,:,:,5) * this%budget_0(:,:,:,9) + & + this%MCG(:,:,:,6) * this%budget_0(:,:,:,10) + & + this%MCG(:,:,:,7) * this%budget_0(:,:,:,8) + & + this%MCG(:,:,:,8) * this%budget_0(:,:,:,10) + & + this%MCG(:,:,:,9) * this%budget_0(:,:,:,11) + + case(10) ! delta u_3' delta wb' + buffer = this%budget_0(:,:,:,3)*this%budget_0(:,:,:,17) + + case(11) ! delta u_3' base wb' + buffer = this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,31) + + case(12) ! base u_3' delta wb' + buffer = this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,17) + + case(13) ! base u_i' delta u_j' d_j(base u_i') [Turbulent transport of TKE] + ! Differentiate mean(base u_i base u_i) numerically + ! (base u_i * base u_i) is even at the boundaries, so use a flag of 1 at bottom and top + bf = half*(this%pre_budget%budget_0(:,:,:,4) + this%pre_budget%budget_0(:,:,:,7) + this%pre_budget%budget_0(:,:,:,9)) + call this%ddx_R2R(bf, bf2); buffer = buffer + this%budget_0(:,:,:,1)*bf2 + call this%ddy_R2R(bf, bf2); buffer = buffer + this%budget_0(:,:,:,2)*bf2 + call this%ddz_R2R(bf, bf2, 1, 1); buffer = buffer + this%budget_0(:,:,:,3)*bf2 + + buffer = buffer + this%pre_budget%budget_0(:,:,:,1)*this%budget_2(:,:,:,4) + & + this%pre_budget%budget_0(:,:,:,2)*this%budget_2(:,:,:,5) + & + this%pre_budget%budget_0(:,:,:,3)*this%budget_2(:,:,:,6) + & + this%MCG(:,:,:,10) * (this%budget_1(:,:,:,7) - two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,11) * (this%budget_1(:,:,:,9) - two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,12) * (this%budget_1(:,:,:,11) - two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,13) * (this%budget_1(:,:,:,8) - two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,14) * (this%budget_1(:,:,:,12) - two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,15) * (this%budget_1(:,:,:,14) - two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,16) * (this%budget_1(:,:,:,10) - two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,17) * (this%budget_1(:,:,:,13) - two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,18) * (this%budget_1(:,:,:,15) - two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,3)) + + case(14) ! base u_i' base u_j' d_j(delta u_i') [Turbulent transport of TKE] + buffer = this%pre_budget%budget_0(:,:,:,1)*(this%budget_2(:,:,:,13) + this%budget_2(:,:,:,7)) + & + this%pre_budget%budget_0(:,:,:,2)*(this%budget_2(:,:,:,14) + this%budget_2(:,:,:,8)) + & + this%pre_budget%budget_0(:,:,:,3)*(this%budget_2(:,:,:,15) + this%budget_2(:,:,:,9)) + & + this%MCG(:,:,:,1)*(this%pre_budget%budget_0(:,:,:,4) - two*this%pre_budget%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,2)*(this%pre_budget%budget_0(:,:,:,5) - two*this%pre_budget%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,3)*(this%pre_budget%budget_0(:,:,:,6) - two*this%pre_budget%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,4)*(this%pre_budget%budget_0(:,:,:,5) - two*this%pre_budget%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,5)*(this%pre_budget%budget_0(:,:,:,7) - two*this%pre_budget%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,6)*(this%pre_budget%budget_0(:,:,:,8) - two*this%pre_budget%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,7)*(this%pre_budget%budget_0(:,:,:,6) - two*this%pre_budget%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,8)*(this%pre_budget%budget_0(:,:,:,8) - two*this%pre_budget%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,9)*(this%pre_budget%budget_0(:,:,:,9) - two*this%pre_budget%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,3)) + + case(15) ! delta u_i' base u_j' d_j(base u_i') [Turbulent transport of TKE] + bf = this%budget_1(:,:,:,7) + this%budget_1(:,:,:,12) + this%budget_1(:,:,:,15) + call this%ddx_R2R(bf, bf2); buffer = buffer + this%pre_budget%budget_0(:,:,:,1)*(bf2 - this%budget_2(:,:,:,13)) + call this%ddy_R2R(bf, bf2); buffer = buffer + this%pre_budget%budget_0(:,:,:,2)*(bf2 - this%budget_2(:,:,:,14)) + ! bf is an even function. Use a flag of 1 for ddz at both top and bottom + call this%ddz_R2R(bf, bf2, 1, 1); buffer = buffer + this%pre_budget%budget_0(:,:,:,3)*(bf2 - this%budget_2(:,:,:,15)) + + buffer = buffer + this%budget_0(:,:,:,1)*this%budget_2(:,:,:,10) + & + this%budget_0(:,:,:,2)*this%budget_2(:,:,:,11) + & + this%budget_0(:,:,:,3)*this%budget_2(:,:,:,12) + & + this%MCG(:,:,:,10) * (this%budget_1(:,:,:,7) - two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,11) * (this%budget_1(:,:,:,8) - two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,12) * (this%budget_1(:,:,:,10)- two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,13) * (this%budget_1(:,:,:,9) - two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,14) * (this%budget_1(:,:,:,12)- two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,15) * (this%budget_1(:,:,:,13)- two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,16) * (this%budget_1(:,:,:,11)- two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,17) * (this%budget_1(:,:,:,14)- two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,18) * (this%budget_1(:,:,:,15)- two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,3)) + + case(16) ! base u_i' delta u_j' d_j(delta u_i') [Turbulent transport of TKE] + buffer = this%budget_0(:,:,:,1)*this%budget_2(:,:,:,13) + & + this%budget_0(:,:,:,2)*this%budget_2(:,:,:,14) + & + this%budget_0(:,:,:,3)*this%budget_2(:,:,:,15) + & + this%pre_budget%budget_0(:,:,:,1)*this%budget_2(:,:,:,1) + & + this%pre_budget%budget_0(:,:,:,2)*this%budget_2(:,:,:,2) + & + this%pre_budget%budget_0(:,:,:,3)*this%budget_2(:,:,:,3) + & + this%MCG(:,:,:,1)*(this%budget_1(:,:,:,7) - two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,2)*(this%budget_1(:,:,:,9) - two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,3)*(this%budget_1(:,:,:,11)- two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,4)*(this%budget_1(:,:,:,8) - two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,5)*(this%budget_1(:,:,:,12)- two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,6)*(this%budget_1(:,:,:,14)- two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,7)*(this%budget_1(:,:,:,10)- two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,8)*(this%budget_1(:,:,:,13)- two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,9)*(this%budget_1(:,:,:,15)- two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,3)) + + case(17) ! delta u_i' delta u_j' d_j(base u_i') [Turbulent transport of TKE] + ! Differentiate mean(base u_i delta u_i) numerically + bf = this%budget_1(:,:,:,7) + this%budget_1(:,:,:,12) + this%budget_1(:,:,:,15) + call this%ddx_R2R(bf, bf2); buffer = buffer + this%budget_0(:,:,:,1)*(bf2 - this%budget_2(:,:,:,13) + this%budget_2(:,:,:,4)) + call this%ddy_R2R(bf, bf2); buffer = buffer + this%budget_0(:,:,:,2)*(bf2 - this%budget_2(:,:,:,14) + this%budget_2(:,:,:,5)) + ! bf is an even function. Use a flag of 1 for ddz at both top and bottom + call this%ddz_R2R(bf, bf2, 1, 1); buffer = buffer + this%budget_0(:,:,:,3)*(bf2 - this%budget_2(:,:,:,15) + this%budget_2(:,:,:,6)) + buffer = buffer + & + this%MCG(:,:,:,10)*(this%budget_1(:,:,:,1) - two*this%budget_0(:,:,:,1)*this%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,11)*(this%budget_1(:,:,:,2) - two*this%budget_0(:,:,:,1)*this%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,12)*(this%budget_1(:,:,:,3) - two*this%budget_0(:,:,:,1)*this%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,13)*(this%budget_1(:,:,:,2) - two*this%budget_0(:,:,:,2)*this%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,14)*(this%budget_1(:,:,:,4) - two*this%budget_0(:,:,:,2)*this%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,15)*(this%budget_1(:,:,:,5) - two*this%budget_0(:,:,:,2)*this%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,16)*(this%budget_1(:,:,:,3) - two*this%budget_0(:,:,:,3)*this%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,17)*(this%budget_1(:,:,:,5) - two*this%budget_0(:,:,:,3)*this%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,18)*(this%budget_1(:,:,:,6) - two*this%budget_0(:,:,:,3)*this%budget_0(:,:,:,3)) + + case(18) ! delta u_i' base u_j' d_j(delta u_i') [Turbulent transport of TKE] + ! Differentiate mean(delta u_i delta u_i) numerically + bf = half*(this%budget_1(:,:,:,1) + this%budget_1(:,:,:,4) + this%budget_1(:,:,:,6)) + call this%ddx_R2R(bf, bf2); buffer = buffer + this%pre_budget%budget_0(:,:,:,1)*bf2 + call this%ddy_R2R(bf, bf2); buffer = buffer + this%pre_budget%budget_0(:,:,:,2)*bf2 + ! bf is an even function. Use a flag of 1 for ddz at both top and bottom + call this%ddz_R2R(bf, bf2, 1, 1); buffer = buffer + this%pre_budget%budget_0(:,:,:,3)*bf2 + + buffer = buffer + this%budget_0(:,:,:,1)*this%budget_2(:,:,:,7) + & + this%budget_0(:,:,:,2)*this%budget_2(:,:,:,8) + & + this%budget_0(:,:,:,3)*this%budget_2(:,:,:,9) + & + this%MCG(:,:,:,1) * (this%budget_1(:,:,:,7) - two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,2) * (this%budget_1(:,:,:,8) - two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,3) * (this%budget_1(:,:,:,10)- two*this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,4) * (this%budget_1(:,:,:,9) - two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,5) * (this%budget_1(:,:,:,12)- two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,6) * (this%budget_1(:,:,:,13)- two*this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,7) * (this%budget_1(:,:,:,11)- two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,8) * (this%budget_1(:,:,:,14)- two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,9) * (this%budget_1(:,:,:,15)- two*this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,3)) + + case(19) ! delta u_i' delta u_j' d_j(delta u_i') [Turbulent transport of TKE] + ! Differentiate mean(delta u_i delta u_i) numerically + bf = half*(this%budget_1(:,:,:,1) + this%budget_1(:,:,:,4) + this%budget_1(:,:,:,6)) + call this%ddx_R2R(bf, bf2); buffer = buffer + this%budget_0(:,:,:,1)*bf2 + call this%ddy_R2R(bf, bf2); buffer = buffer + this%budget_0(:,:,:,2)*bf2 + ! bf is an even function. Use a flag of 1 for ddz at both top and bottom + call this%ddz_R2R(bf, bf2, 1, 1); buffer = buffer + this%budget_0(:,:,:,3)*bf2 + + buffer = buffer + this%budget_0(:,:,:,1)*this%budget_2(:,:,:,1) + & + this%budget_0(:,:,:,2)*this%budget_2(:,:,:,2) + & + this%budget_0(:,:,:,3)*this%budget_2(:,:,:,3) + & + this%MCG(:,:,:,1) * (this%budget_1(:,:,:,1) - two*this%budget_0(:,:,:,1)*this%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,2) * (this%budget_1(:,:,:,2) - two*this%budget_0(:,:,:,1)*this%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,3) * (this%budget_1(:,:,:,3) - two*this%budget_0(:,:,:,1)*this%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,4) * (this%budget_1(:,:,:,2) - two*this%budget_0(:,:,:,2)*this%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,5) * (this%budget_1(:,:,:,4) - two*this%budget_0(:,:,:,2)*this%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,6) * (this%budget_1(:,:,:,5) - two*this%budget_0(:,:,:,2)*this%budget_0(:,:,:,3)) + & + this%MCG(:,:,:,7) * (this%budget_1(:,:,:,3) - two*this%budget_0(:,:,:,3)*this%budget_0(:,:,:,1)) + & + this%MCG(:,:,:,8) * (this%budget_1(:,:,:,5) - two*this%budget_0(:,:,:,3)*this%budget_0(:,:,:,2)) + & + this%MCG(:,:,:,9) * (this%budget_1(:,:,:,6) - two*this%budget_0(:,:,:,3)*this%budget_0(:,:,:,3)) + + ! case(20) + ! buffer = this%budget_0(:,:,:,1)*this%budget_0(:,:,:,21) + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,22) + ! case(21) + ! buffer = this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,21) + this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,22) + end select + end if + + ! Dealias the product of means + call this%dealias(buffer) + + ! Nullify pointers + nullify(bf, bf2) + end subroutine + + ! ----------------------supporting subroutines ------------------------ + ! subroutine writeTimeSum(this) + ! class(budgets_time_avg_deficit_compact), intent(inout), target :: this + ! character(len=clen) :: fname, tempname + ! integer :: ios + + ! write(tempname,"(A3,I2.2,A14,I6.6,A2,I6.6,A4)") "Run",this%run_id,"_time_weight_t",this%prim_igrid_sim%step,"_n",this%counter,".txt" + ! fname = this%budgets_Dir(:len_trim(this%budgets_Dir))//"/"//trim(tempname) + ! open(unit=10, file=trim(fname), status='replace', action='write', form='formatted', iostat=ios) + ! write(10,'(ES23.15)') this%timeSum + ! close(10) + ! end subroutine + + ! subroutine readTimeSum(this, dir, rid, tid, cid) + ! class(budgets_time_avg_deficit_compact), intent(inout), target :: this + ! integer, intent(in) :: rid, cid, tid + ! character(len=clen) :: dir + ! character(len=clen) :: fname, tempname + ! integer :: ios + + ! write(tempname,"(A3,I2.2,A14,I6.6,A2,I6.6,A4)") "Run",rid,"_time_weight_t",tid,"_n",cid,".txt" + ! fname = trim(dir)//"/"//trim(tempname) + ! open(unit=10, file=trim(fname), status='old', action='read', form='formatted', iostat=ios) + ! read(10,'(ES23.15)') this%timeSum + ! close(10) + ! end subroutine + + subroutine dump_budget_field(this, field, fieldID, BudgetID) + use decomp_2d_io + class(budgets_time_avg_deficit_compact), intent(inout) :: this + real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: field + integer, intent(in) :: fieldID, BudgetID + character(len=clen) :: fname, tempname + + write(tempname,"(A3,I2.2,A20,I1.1,A5,I2.2,A2,I6.6,A2,I6.6,A4)") "Run",this%run_id,"_comp_deficit_budget",BudgetID,"_term",fieldID,"_t",this%prim_igrid_sim%step,"_n",this%counter,".s3D" + fname = this%budgets_Dir(:len_trim(this%budgets_Dir))//"/"//trim(tempname) + + call decomp_2d_write_one(1,field,fname, this%prim_igrid_sim%gpC) + end subroutine + + subroutine restart_budget_field(this, field, dir, runID, timeID, counterID, budgetID, fieldID) + use decomp_2d_io + class(budgets_time_avg_deficit_compact), intent(inout) :: this + real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: field + integer, intent(in) :: runID, counterID, timeID, budgetID, fieldID + character(len=clen) :: fname, tempname + character(len=clen), intent(in) :: dir + + write(tempname,"(A3,I2.2,A20,I1.1,A5,I2.2,A2,I6.6,A2,I6.6,A4)") "Run",runID,"_comp_deficit_budget",budgetID,"_term",fieldID,"_t",timeID,"_n",counterID,".s3D" + fname = dir(:len_trim(dir))//"/"//trim(tempname) + call decomp_2d_read_one(1,field,fname, this%prim_igrid_sim%gpC) + end subroutine + + subroutine RestartBudget(this, dir, rid, tid, cid) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + integer, intent(in) :: rid, cid, tid + character(len=clen) :: dir + integer :: idx + real(rkind), dimension(:,:,:), pointer :: buffer + real(rkind) :: totalWeight + + ! Cell x-pencil buffers + buffer => this%prim_igrid_sim%rbuffxC(:,:,:,4) + this%counter = cid + totalWeight = real(this%counter,rkind) + 1.d-18 + + ! I assume here that this%pre_budget%budget_0 and + ! this%pre_budget%budget_1 are already restarted + ! and are in summing mode + this%pre_budget%budget_0 = this%pre_budget%budget_0/totalWeight + this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight + + ! Budget 0 + if(this%do_budget0)then + do idx = 1, this%size_budget_0 + if((idx.eq.15).or.(idx.eq.16))then + if(.not. this%useCoriolis)cycle + end if + if((idx.eq.5).or.(idx.eq.17))then + if(.not. this%isStratified)cycle + end if + + call this%restart_budget_field(this%budget_0(:,:,:,idx), dir, rid, tid, cid, 0, idx) + end do + end if + + ! Budget 1 + if(this%do_budget1)then + do idx = 1, this%size_budget_1 + call this%restart_budget_field(this%budget_1(:,:,:,idx), dir, rid, tid, cid, 1, idx) + call this%getProductOfMeans(1, idx, buffer) + this%budget_1(:,:,:,idx) = this%budget_1(:,:,:,idx) + buffer + end do + end if + + ! Budget 2 + if(this%do_budget2)then + do idx = 1, this%size_budget_2 + call this%restart_budget_field(this%budget_2(:,:,:,idx), dir, rid, tid, cid, 2, idx) + call this%getProductOfMeans(2, idx, buffer) + this%budget_2(:,:,:,idx) = this%budget_2(:,:,:,idx) + buffer + end do + end if + + ! Budget 3 + if(this%do_budget3)then + do idx = 1, this%size_budget_3 + if((idx.eq.10).or.(idx.eq.11).or.(idx.eq.12))then + if(.not. this%isStratified) cycle + end if + + call this%restart_budget_field(this%budget_3(:,:,:,idx), dir, rid, tid, cid, 3, idx) + call this%getProductOfMeans(3, idx, buffer) + this%budget_3(:,:,:,idx) = this%budget_3(:,:,:,idx) + buffer + end do + end if + + ! Return to summing + if(this%do_budget0) this%budget_0 = this%budget_0*totalWeight + if(this%do_budget1) this%budget_1 = this%budget_1*totalWeight + if(this%do_budget2) this%budget_2 = this%budget_2*totalWeight + if(this%do_budget3) this%budget_3 = this%budget_3*totalWeight + this%pre_budget%budget_0 = this%pre_budget%budget_0*totalWeight + this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight + + ! To save time and storage, MCG were not written to file. + ! We restart MCG by numerically differentiating the mean flow + ! MCG is automatically in the summing mode because we + ! differentiate budget 0 in the summing mode + if(this%doMCG) call this%restartMCG() + + nullify(buffer) + end subroutine + + subroutine restartMCG(this) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind), dimension(:,:,:), pointer :: dudx_def, dudy_def, dudz_def, dudx_pre, dudy_pre, dudz_pre + real(rkind), dimension(:,:,:), pointer :: dvdx_def, dvdy_def, dvdz_def, dvdx_pre, dvdy_pre, dvdz_pre + real(rkind), dimension(:,:,:), pointer :: dwdx_def, dwdy_def, dwdz_def, dwdx_pre, dwdy_pre, dwdz_pre + + dudx_def => this%MCG(:,:,:,1) + dudy_def => this%MCG(:,:,:,2) + dudz_def => this%MCG(:,:,:,3) + dvdx_def => this%MCG(:,:,:,4) + dvdy_def => this%MCG(:,:,:,5) + dvdz_def => this%MCG(:,:,:,6) + dwdx_def => this%MCG(:,:,:,7) + dwdy_def => this%MCG(:,:,:,8) + dwdz_def => this%MCG(:,:,:,9) + dudx_pre => this%MCG(:,:,:,10) + dudy_pre => this%MCG(:,:,:,11) + dudz_pre => this%MCG(:,:,:,12) + dvdx_pre => this%MCG(:,:,:,13) + dvdy_pre => this%MCG(:,:,:,14) + dvdz_pre => this%MCG(:,:,:,15) + dwdx_pre => this%MCG(:,:,:,16) + dwdy_pre => this%MCG(:,:,:,17) + dwdz_pre => this%MCG(:,:,:,18) + + call this%ddx_R2R(this%budget_0(:,:,:,1), dudx_def) + call this%ddy_R2R(this%budget_0(:,:,:,1), dudy_def) + call this%ddz_R2R(this%budget_0(:,:,:,1), dudz_def, uBC_bottom, uBC_top) + call this%ddx_R2R(this%budget_0(:,:,:,2), dvdx_def) + call this%ddy_R2R(this%budget_0(:,:,:,2), dvdy_def) + call this%ddz_R2R(this%budget_0(:,:,:,2), dvdz_def, vBC_bottom, vBC_top) + call this%ddx_R2R(this%budget_0(:,:,:,3), dwdx_def) + call this%ddy_R2R(this%budget_0(:,:,:,3), dwdy_def) + call this%ddz_R2R(this%budget_0(:,:,:,3), dwdz_def, wBC_bottom, wBC_top) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1), dudx_pre) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1), dudy_pre) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1), dudz_pre, uBC_bottom, uBC_top) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2), dvdx_pre) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2), dvdy_pre) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2), dvdz_pre, vBC_bottom, vBC_top) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3), dwdx_pre) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), dwdy_pre) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), dwdz_pre, wBC_bottom, wBC_top) + + nullify(dudx_def, dudy_def, dudz_def, dudx_pre, dudy_pre, dudz_pre) + nullify(dvdx_def, dvdy_def, dvdz_def, dvdx_pre, dvdy_pre, dvdz_pre) + nullify(dwdx_def, dwdy_def, dwdz_def, dwdx_pre, dwdy_pre, dwdz_pre) + end subroutine + + subroutine ResetBudget(this) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + + this%counter = 0 + this%timeSum = zero + if(allocated(this%budget_0)) this%budget_0 = zero + if(allocated(this%budget_1)) this%budget_1 = zero + if(allocated(this%budget_2)) this%budget_2 = zero + if(allocated(this%budget_3)) this%budget_3 = zero + if(allocated(this%delta_tauij)) this%delta_tauij = zero + if(allocated(this%MCG)) this%MCG = zero + end subroutine + + subroutine destroy(this) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + + nullify(this%pre_budget, this%prim_igrid_sim) + if(this%do_budgets) then + if(allocated(this%budget_0)) deallocate(this%budget_0) + if(allocated(this%budget_1)) deallocate(this%budget_1) + if(allocated(this%budget_2)) deallocate(this%budget_2) + if(allocated(this%budget_3)) deallocate(this%budget_3) + if(allocated(this%delta_tauij)) deallocate(this%delta_tauij) + if(allocated(this%MCG)) deallocate(this%MCG) + end if + if(allocated(this%uc)) deallocate(this%uc) + if(allocated(this%vc)) deallocate(this%vc) + if(allocated(this%wc)) deallocate(this%wc) + if(allocated(this%usgs)) deallocate(this%usgs) + if(allocated(this%vsgs)) deallocate(this%vsgs) + if(allocated(this%wsgs)) deallocate(this%wsgs) + if(allocated(this%px)) deallocate(this%px) + if(allocated(this%py)) deallocate(this%py) + if(allocated(this%pz)) deallocate(this%pz) + if(allocated(this%uturb)) deallocate(this%uturb) + if(allocated(this%vturb)) deallocate(this%vturb) + if(allocated(this%wturb)) deallocate(this%wturb) + if(allocated(this%ucor)) deallocate(this%ucor) + if(allocated(this%vcor)) deallocate(this%vcor) + if(allocated(this%wcor)) deallocate(this%wcor) + if(allocated(this%wb)) deallocate(this%wb) + end subroutine + + ! ----------------------private derivative operators ------------------------ + subroutine dealias(this, f) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind), dimension(this%nx,this%ny,this%nz), intent(inout) :: f + complex(rkind), dimension(:,:,:), pointer :: cbuffyC + + cbuffyC => this%prim_igrid_sim%cbuffyC(:,:,:,1) + + call this%prim_igrid_sim%spectC%fft(f, cbuffyC) + call this%prim_igrid_sim%spectC%dealias(cbuffyC) + call this%prim_igrid_sim%spectC%ifft(cbuffyC, f) + end subroutine + + subroutine ddx_R2R(this, f, dfdx) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: f + real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: dfdx + complex(rkind), dimension(:,:,:), pointer :: cbuffyC + + cbuffyC => this%prim_igrid_sim%cbuffyC(:,:,:,1) + + call this%prim_igrid_sim%spectC%fft(f, cbuffyC) + call this%prim_igrid_sim%spectC%mtimes_ik1_ip(cbuffyC) + call this%prim_igrid_sim%spectC%dealias(cbuffyC) + call this%prim_igrid_sim%spectC%ifft(cbuffyC, dfdx) + + nullify(cbuffyC) + end subroutine + + subroutine ddy_R2R(this, f, dfdy) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: f + real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: dfdy + complex(rkind), dimension(:,:,:), pointer :: cbuffyC + + cbuffyC => this%prim_igrid_sim%cbuffyC(:,:,:,1) + + call this%prim_igrid_sim%spectC%fft(f, cbuffyC) + call this%prim_igrid_sim%spectC%mtimes_ik2_ip(cbuffyC) + call this%prim_igrid_sim%spectC%dealias(cbuffyC) + call this%prim_igrid_sim%spectC%ifft(cbuffyC, dfdy) + + nullify(cbuffyC) + end subroutine + + subroutine ddz_R2R(this, f, dfdz, n1, n2) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: f + real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: dfdz + integer, intent(in) :: n1, n2 + complex(rkind), dimension(:,:,:), pointer :: cbuffyC, cbuffzC1, cbuffzC2 + + cbuffyC => this%prim_igrid_sim%cbuffyC(:,:,:,1) + cbuffzC1 => this%prim_igrid_sim%cbuffzC(:,:,:,1) + cbuffzC2 => this%prim_igrid_sim%cbuffzC(:,:,:,2) + + call this%prim_igrid_sim%spectC%fft(f, cbuffyC) + call transpose_y_to_z(cbuffyC, cbuffzC1, this%prim_igrid_sim%sp_gpC) + call this%prim_igrid_sim%Pade6opZ%ddz_C2C(cbuffzC1, cbuffzC2, n1, n2) + call transpose_z_to_y(cbuffzC2, cbuffyC, this%prim_igrid_sim%sp_gpC) + call this%prim_igrid_sim%spectC%dealias(cbuffyC) + call this%prim_igrid_sim%spectC%ifft(cbuffyC, dfdz) + + nullify(cbuffyC, cbuffzC1, cbuffzC2) + end subroutine + + subroutine interp_Edge2Cell(this, fE, fC, n1, n2) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind), dimension(this%prim_igrid_sim%gpE%xsz(1),this%prim_igrid_sim%gpE%xsz(2),this%prim_igrid_sim%gpE%xsz(3)), intent(in) :: fE + real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: fC + integer, intent(in) :: n1, n2 + real(rkind), dimension(:,:,:), pointer :: rbuffyE, rbuffzE, rbuffzC, rbuffyC + + rbuffyE => this%prim_igrid_sim%rbuffyE(:,:,:,1) + rbuffzE => this%prim_igrid_sim%rbuffzE(:,:,:,1) + rbuffzC => this%prim_igrid_sim%rbuffzC(:,:,:,2) + rbuffyC => this%prim_igrid_sim%rbuffyC(:,:,:,1) + + call transpose_x_to_y(fE, rbuffyE, this%prim_igrid_sim%gpE) + call transpose_y_to_z(rbuffyE, rbuffzE, this%prim_igrid_sim%gpE) + call this%prim_igrid_sim%Pade6opZ%interpz_E2C(rbuffzE, rbuffzC, n1, n2) + call transpose_z_to_y(rbuffzC, rbuffyC, this%prim_igrid_sim%gpC) + call transpose_y_to_x(rbuffyC, fC, this%prim_igrid_sim%gpC) + + nullify(rbuffyE, rbuffzE, rbuffzC, rbuffyC) + end subroutine +end module diff --git a/src/incompressible/budget_xy_avg.F90 b/src/incompressible/budget_xy_avg.F90 index 6ec8c19b..a5cd9c89 100644 --- a/src/incompressible/budget_xy_avg.F90 +++ b/src/incompressible/budget_xy_avg.F90 @@ -202,24 +202,32 @@ subroutine init(this, inputfile, igrid_sim) this%budgetType = budgetType this%avgFact = 1.d0/(real(igrid_sim%nx,rkind)*real(igrid_sim%ny,rkind)) - if((this%tidx_budget_start > 0) .and. (this%time_budget_start > 0.0d0)) then - call GracefulExit("Both tidx_budget_start and time_budget_start in budget_xy_avg are positive. Turn one negative", 100) - endif - if(this%do_budgets) then - allocate(this%Budget_0s(this%nz,21)) - allocate(this%Budget_0(this%nz,21)) + ! allocate budget 0 -> minimum needed! + allocate(this%Budget_0s(this%nz,21)) + allocate(this%Budget_0(this%nz,21)) + ! allocate budget 1 + if (this%budgetType > 0) then allocate(this%Budget_1(this%nz,14)) allocate(this%Budget_1s(this%nz,14)) + end if + ! allocate budget 2 + if (this%budgetType > 1) then allocate(this%Budget_2(this%nz,7)) + end if + ! allocate budget 3 + if (this%budgetType > 2) then allocate(this%Budget_3(this%nz,8)) allocate(this%Budget_3s(this%nz,8)) - + end if + ! allocate budget 4 + if (this%budgetType > 3) then allocate(this%Budget_4s(this%nz,9)) allocate(this%Budget_4_13(this%nz,9)) allocate(this%Budget_4_23(this%nz,9)) allocate(this%Budget_4_33(this%nz,9)) allocate(this%Budget_4_11(this%nz,9)) + end if if ((trim(budgets_dir) .eq. "null") .or.(trim(budgets_dir) .eq. "NULL")) then this%budgets_dir = igrid_sim%outputDir @@ -363,7 +371,24 @@ subroutine destroy(this) deallocate(this%uc, this%vc, this%wc, this%usgs, this%vsgs, this%wsgs, & & this%uvisc, this%vvisc, this%wvisc, this%px, this%py, this%pz, this%wb, this%ucor, & & this%vcor, this%wcor, this%uturb) - deallocate(this%budget_0, this%budget_1) + deallocate(this%budget_0) + if (this%budgetType>0) then + deallocate(this%budget_1) + end if + if (this%budgetType>1) then + deallocate(this%budget_2) + end if + if (this%budgetType>2) then + deallocate(this%budget_3) + end if + if (this%budgetType>3) then + deallocate(this%budget_4_11) + deallocate(this%budget_4_13) + deallocate(this%budget_4_22) + deallocate(this%budget_4_23) + deallocate(this%budget_4_33) + end if + deallocate(this%mean_qty) if(this%do_spectra) then deallocate(this%xspectra_mean) diff --git a/src/incompressible/fringeADmethod.F90 b/src/incompressible/fringeADmethod.F90 new file mode 100644 index 00000000..b7e9812b --- /dev/null +++ b/src/incompressible/fringeADmethod.F90 @@ -0,0 +1,110 @@ +module fringeADMethod + use kind_parameters, only: rkind, clen + use decomp_2d + use exits, only: message + use constants, only: zero, one, half, two + implicit none + private + public :: fringeAD + + type :: fringeAD + real(rkind), dimension(:,:,:), allocatable :: Fringe_kernel + contains + procedure :: init + procedure :: destroy + procedure :: S_fringe + end type fringeAD + + contains + + subroutine destroy(this) + class(fringeAD), intent(inout) :: this + if(allocated(this%Fringe_kernel))deallocate(this%Fringe_kernel) + end subroutine + + subroutine init(this, inputfile, nx, ny, nz, x, z, Lx, dz) + class(fringeAD), intent(inout) :: this + character(*), intent(in) :: inputfile + integer, intent(in) :: nx, ny, nz + real(rkind), intent(in) :: x(nx), z(nz), dz, Lx + integer :: k, ioUnit, ierr + real(rkind) :: xi_st(nx), xi_en(nx), S1(nx), S2(nx), Fringe_func(nx) + real(rkind) :: FringeAD_st = 0.875_rkind, FringeAD_en = one, FringeAD_delta_st=0.05_rkind, FringeAD_delta_en=0.075_rkind + real(rkind) :: FringeAD_H = 10._rkind, FringeAD_deltaH=4._rkind + logical :: use_tanh = .true. + real(rkind) :: FringeAD_deltaH_ + real(rkind) :: xper(nx), fringe_len, delta_st_, delta_en_, sigma + + namelist /FRINGEAD/ FringeAD_st, FringeAD_en, FringeAD_delta_st, FringeAD_delta_en, FringeAD_H, FringeAD_deltaH, use_tanh + + if(allocated(this%Fringe_kernel))deallocate(this%Fringe_kernel) + allocate(this%Fringe_kernel(nx, ny, nz)) + + ioUnit = 1019 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', iostat=ierr) + read(unit=ioUnit, NML=FRINGEAD) + close(ioUnit) + + ! Scale up to Lx + ! Note that FringeAD_H is already in proper units + FringeAD_st = FringeAD_st * Lx + FringeAD_en = FringeAD_en * Lx + delta_st_ = max(FringeAD_delta_st, 0.005_rkind) * Lx + delta_en_ = max(FringeAD_delta_en, 0.005_rkind) * Lx + + ! Periodic coordinate measured from fringe start, wrapped into [0,Lx) + xper = modulo(x - FringeAD_st, Lx) + + ! Periodic forward length of the fringe region from start to end + fringe_len = modulo(FringeAD_en - FringeAD_st, Lx) + + xi_st = xper / delta_st_ + xi_en = (xper - fringe_len) / delta_en_ + one + + ! FringeAD_deltaH is specified in units of vertical grid spacing. + ! Enforce a minimum smooth transition width of 2*dz. + FringeAD_deltaH_ = max(two, FringeAD_deltaH) * abs(dz) + + call this%S_fringe(xi_st, S1) + call this%S_fringe(xi_en, S2) + Fringe_func = one - (S1 - S2) + + do k = 1,nz + if(use_tanh)then + if (z(k) <= FringeAD_H) then + sigma = zero + else + sigma = tanh((z(k) - FringeAD_H) / FringeAD_deltaH_) + sigma = sigma*sigma ! tanh squared + end if + this%Fringe_kernel(:,:,k) = spread((one - sigma) + sigma*Fringe_func, dim=2, ncopies=ny) + else + if(z(k) < FringeAD_H)then + this%Fringe_kernel(:,:,k) = one + else + this%Fringe_kernel(:,:,k) = spread(Fringe_func, dim=2, ncopies=ny) + end if + end if + end do + end subroutine + + subroutine S_fringe(this, x, output) + class(fringeAD), intent(inout) :: this + real(rkind), dimension(:), intent(in) :: x + real(rkind), dimension(:), intent(out) :: output + integer :: i + real(rkind) :: exparg + + do i = 1,size(x) + if (x(i) .le. zero) then + output(i) = zero + else if (x(i) .ge. one) then + output(i) = one + else + exparg = one/(x(i) - one + 1.0D-32) + one/(x(i) + 1.0D-32) + exparg = min(exparg,708.0d0) ! overflows if exparg > 709. need a better fix for this + output(i) = one/(one + exp(exparg)) + end if + end do + end subroutine +end module fringeADMethod diff --git a/src/incompressible/fringemethod.F90 b/src/incompressible/fringemethod.F90 index d1880183..6e1423d7 100644 --- a/src/incompressible/fringemethod.F90 +++ b/src/incompressible/fringemethod.F90 @@ -232,6 +232,8 @@ subroutine init(this, inputfile, dx, x, dy, y, spectC, spectE, gpC, gpE, rbuffxC real(rkind) :: Fringe2_xst = 0.75d0, Fringe2_xen = 1.d0 real(rkind) :: xshift = zero, yshift = zero + real(rkind) :: small, big + integer :: ioUnit = 10, i, j, k, nx, ierr real(rkind), dimension(:), allocatable :: x1, x2, Fringe_func, S1, S2, y1, y2 logical :: Apply_x_fringe = .true., Apply_y_fringe = .false., do_shifts = .false. @@ -335,8 +337,13 @@ subroutine init(this, inputfile, dx, x, dy, y, spectC, spectE, gpC, gpE, rbuffxC deallocate(x1, x2, S1, S2, Fringe_func) end if - call message_min_max(1,"Bounds for Fringe_funcC:", p_minval(minval(this%Fringe_kernel_cells)), p_maxval(maxval(this%Fringe_kernel_cells))) - call message_min_max(1,"Bounds for Fringe_funcE:", p_minval(minval(this%Fringe_kernel_edges)), p_maxval(maxval(this%Fringe_kernel_edges))) + small = p_minval(minval(this%Fringe_kernel_cells)) + big = p_maxval(maxval(this%Fringe_kernel_cells)) + call message_min_max(1,"Bounds for Fringe_funcC:", small, big) + + small = p_minval(minval(this%Fringe_kernel_edges)) + big = p_maxval(maxval(this%Fringe_kernel_edges)) + call message_min_max(1,"Bounds for Fringe_funcE:", small, big) if (Apply_y_fringe) then Fringe_yst = Fringe_yst*Ly @@ -373,9 +380,13 @@ subroutine init(this, inputfile, dx, x, dy, y, spectC, spectE, gpC, gpE, rbuffxC end do deallocate(y1, y2, S1, S2, Fringe_func) - call message_min_max(1,"Bounds for Fringe_funcC:", p_minval(minval(this%Fringe_kernel_cells)), p_maxval(maxval(this%Fringe_kernel_cells))) + small = p_minval(minval(this%Fringe_kernel_cells)) + big = p_maxval(maxval(this%Fringe_kernel_cells)) + call message_min_max(1,"Bounds for Fringe_funcC:", small, big) - call message_min_max(1,"Bounds for Fringe_funcE:", p_minval(minval(this%Fringe_kernel_edges)), p_maxval(maxval(this%Fringe_kernel_edges))) + small = p_minval(minval(this%Fringe_kernel_edges)) + big = p_maxval(maxval(this%Fringe_kernel_edges)) + call message_min_max(1,"Bounds for Fringe_funcE:", small, big) end if diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index f07ce9ec..ccd37bcc 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -21,6 +21,7 @@ module IncompressibleGrid use kspreprocessing, only: ksprep use PadeDerOps, only: Pade6Stagg use Fringemethod, only: fringe + use fringeADMethod, only: fringeAD use angleControl, only: angCont use forcingmod, only: HIT_shell_forcing use scalar_igridMod, only: scalar_igrid @@ -29,10 +30,13 @@ module IncompressibleGrid implicit none - external :: MPI_BCAST, MPI_RECV, MPI_SEND, MPI_REDUCE + external :: MPI_BCAST, MPI_RECV, MPI_SEND, MPI_REDUCE, MPI_GATHER private - public :: igrid, wBC_bottom, wBC_top + public :: igrid + public :: uBC_bottom, uBC_top, vBC_bottom, vBC_top, wBC_bottom, wBC_top, & + TBC_bottom, TBC_top, UWBC_bottom, UWBC_top, VWBC_bottom, VWBC_top, & + WTBC_bottom, WTBC_top complex(rkind), parameter :: zeroC = zero + imi*zero @@ -265,9 +269,15 @@ module IncompressibleGrid logical :: useFringe = .false., usedoublefringex = .false. type(fringe), allocatable, public :: fringe_x, fringe_x1, fringe_x2 + ! Advection damping fringe + logical :: useFringeAD = .false. + type(fringeAD), allocatable, public :: fringe_ad + ! Control logical :: useControl = .false. type(angCont), allocatable, public :: angCont_yaw + type(angCont), pointer :: angCont_yaw_dummy => NULL() + logical :: dummy_controller = .false. real(rkind) :: angleHubHeight, totalAngle, wFilt, restartPhi, deltaGalpha, angleTrigger integer :: zHubIndex = 16 @@ -375,6 +385,7 @@ module IncompressibleGrid procedure :: instrumentForBudgets procedure :: instrumentForBudgets_timeAvg procedure :: instrumentForBudgets_volAvg + procedure :: instrumentForDeficitBudgets procedure :: getMomentumTerms procedure :: set_budget_rhs_to_zero procedure, private :: advance_SSP_RK45_all_stages @@ -419,6 +430,7 @@ subroutine init(this,inputfile, initialize2decomp) logical :: normStatsByUstar=.false., ComputeStokesPressure = .true., UseDealiasFilterVert = .false., ComputeRapidSlowPressure = .false. real(rkind) :: tmpmn, Lz = 1.d0, latitude = 90._rkind, KSFilFact = 4.d0, dealiasFact = 2.d0/3.d0, frameAngle = 0.d0, BulkRichardson = 0.d0, HITForceTimeScale = 10.d0 logical :: ADM = .false., storePressure = .false., useSystemInteractions = .true., useFringe = .false., useHITForcing = .false., useControl = .false., useHITRealSpaceLinearForcing = .false. + logical :: useFringeAD = .false. integer :: tSystemInteractions = 100, ierr, KSinitType = 0, nKSvertFilt = 1, ADM_Type = 1 logical :: computeSpectra = .false., timeAvgFullFields = .false., fastCalcPressure = .true., usedoublefringex = .false. logical :: assume_fplane = .true., periodicbcs(3), useProbes = .false., KSdoZfilter = .true., computeVorticity = .false. @@ -436,6 +448,8 @@ subroutine init(this,inputfile, initialize2decomp) character(len=clen) :: MeanFilesDir, powerDumpDir logical :: WriteTurbineForce = .false., useforcedStratification = .false., useDynamicYaw = .FALSE., useDynamicTurbine = .FALSE. integer :: buoyancyDirection = 3, yawUpdateInterval = 100000, dealiasType = 0 + real(rkind), allocatable :: ztmp(:) + real(rkind) :: Lx real(rkind), dimension(:,:,:), allocatable, target :: tmpzE, tmpzC, tmpyE, tmpyC namelist /INPUT/ nx, ny, nz, tstop, dt, CFL, nsteps, inputdir, outputdir, prow, pcol, & @@ -446,7 +460,7 @@ subroutine init(this,inputfile, initialize2decomp) namelist /STATS/tid_StatsDump,tid_compStats,tSimStartStats,normStatsByUstar,computeSpectra,timeAvgFullFields, computeVorticity namelist /PHYSICS/isInviscid,useCoriolis,useExtraForcing,isStratified,useMoisture,Re,Ro,Pr,Fr, Ra, useSGS, PrandtlFluid, BulkRichardson, BuoyancyTermType,useforcedStratification,& useGeostrophicForcing, G_geostrophic, G_alpha, dpFdx,dpFdy,dpFdz,assume_fplane,latitude,useHITForcing, useScalars, frameAngle, buoyancyDirection, useHITRealSpaceLinearForcing, HITForceTimeScale, useConstantG - namelist /BCs/ PeriodicInZ, topWall, botWall, useSpongeLayer, zstSponge, SpongeTScale, sponge_type, botBC_Temp, topBC_Temp, useTopAndBottomSymmetricSponge, useFringe, usedoublefringex, useControl + namelist /BCs/ PeriodicInZ, topWall, botWall, useSpongeLayer, zstSponge, SpongeTScale, sponge_type, botBC_Temp, topBC_Temp, useTopAndBottomSymmetricSponge, useFringe, usedoublefringex, useControl, useFringeAD namelist /WINDTURBINES/ useWindTurbines, num_turbines, ADM, turbInfoDir, ADM_Type, powerDumpDir, useDynamicYaw, & yawUpdateInterval, inputDirDyaw, useDynamicTurbine namelist /NUMERICS/ AdvectionTerm, ComputeStokesPressure, NumericalSchemeVert, & @@ -492,7 +506,7 @@ subroutine init(this,inputfile, initialize2decomp) this%P_dumpFreq = P_dumpFreq; this%P_compFreq = P_compFreq; this%timeAvgFullFields = timeAvgFullFields this%computeSpectra = computeSpectra; this%botBC_Temp = botBC_Temp; this%isInviscid = isInviscid this%assume_fplane = assume_fplane; this%useProbes = useProbes; this%PrandtlFluid = PrandtlFLuid - this%KSinitType = KSinitType; this%KSFilFact = KSFilFact;this%useFringe = useFringe; this%useControl = useControl + this%KSinitType = KSinitType; this%KSFilFact = KSFilFact;this%useFringe = useFringe; this%useControl = useControl; this%useFringeAD = useFringeAD this%nsteps = nsteps; this%PeriodicinZ = periodicInZ; this%usedoublefringex = usedoublefringex this%useHITForcing = useHITForcing; this%BuoyancyTermType = BuoyancyTermType; this%CviscDT = CviscDT this%frameAngle = frameAngle; this%computeVorticity = computeVorticity @@ -523,6 +537,7 @@ subroutine init(this,inputfile, initialize2decomp) this%zHubIndex = zHubIndex; this%angleTrigger = angleTrigger this%computeTurbinePressure = computeTurbinePressure; this%turbPr = Pr this%restartPhi = 0.d0 + this%dummy_controller = .false. this%Ra = Ra if (useWindturbines) this%WriteTurbineForce = WriteTurbineForce @@ -542,6 +557,12 @@ subroutine init(this,inputfile, initialize2decomp) call decomp_info_init(nx, ny, nz, this%gpC) end if + ! if (any(this%gpC%xsz == 1) .or. any(this%gpC%ysz == 1) .or. any(this%gpC%zsz == 1))then + ! if(this%useWindTurbines)then + ! call gracefulExit("Pencil thickness = 1 detected in gpC. Wind turbine module may fail.", 901) + ! end if + ! end if + call decomp_info_init(nx,ny,nz+1,this%gpE) if (this%useSystemInteractions) then @@ -675,7 +696,11 @@ subroutine init(this,inputfile, initialize2decomp) !allocate(this%cbuffxC(this%sp_gpC%xsz(1),this%sp_gpC%xsz(2),this%sp_gpC%xsz(3),2)) allocate(this%cbuffyC(this%sp_gpC%ysz(1),this%sp_gpC%ysz(2),this%sp_gpC%ysz(3),2)) - allocate(this%cbuffyE(this%sp_gpE%ysz(1),this%sp_gpE%ysz(2),this%sp_gpE%ysz(3),2)) + if(this%useFringeAD)then + allocate(this%cbuffyE(this%sp_gpE%ysz(1),this%sp_gpE%ysz(2),this%sp_gpE%ysz(3),3)) + else + allocate(this%cbuffyE(this%sp_gpE%ysz(1),this%sp_gpE%ysz(2),this%sp_gpE%ysz(3),2)) + end if allocate(this%cbuffzC(this%sp_gpC%zsz(1),this%sp_gpC%zsz(2),this%sp_gpC%zsz(3),3)) allocate(this%cbuffzE(this%sp_gpE%zsz(1),this%sp_gpE%zsz(2),this%sp_gpE%zsz(3),2)) @@ -1170,6 +1195,22 @@ subroutine init(this,inputfile, initialize2decomp) ! END DO_SHIFTS end if end if + + ! STEP 17.1: Set advection damping fringe + if(this%useFringeAD)then + allocate(this%fringe_ad) + + ! Collect z coordinates of edges + allocate(ztmp(this%gpE%xsz(3))) + ztmp(:) = this%mesh(1,1,:,3) - half * this%dz + ztmp(this%gpE%xsz(3)) = ztmp(this%gpE%xsz(3) - 1) + this%dz + + ! domain length (x-pencil decomposition is implicit) + Lx = this%gpC%xsz(1) * abs(this%mesh(2,1,1,1) - this%mesh(1,1,1,1)) + + call this%fringe_ad%init(trim(inputfile), this%gpE%xsz(1), this%gpE%xsz(2), this%gpE%xsz(3), this%mesh(:,1,1,1), ztmp, Lx, this%dz) + deallocate(ztmp) + end if ! STEP 18: Set HIT Forcing if (this%useHITForcing) then @@ -1280,10 +1321,7 @@ subroutine init(this,inputfile, initialize2decomp) end if end if - ! STEP 24: Compute pressure - if ((this%storePressure) .or. (this%fastCalcPressure)) then - call this%ComputePressure() - end if + ! STEP 25: Schedule time dumps this%vizDump_Schedule = vizDump_Schedule @@ -1313,13 +1351,19 @@ subroutine init(this,inputfile, initialize2decomp) allocate(this%angCont_yaw) call this%angCont_yaw%init(inputfile, this%spectC, this%spectE, this%gpC, this%gpE, & this%rbuffxC, this%rbuffxE, this%cbuffyC, this%cbuffyE, & - this%rbuffyC, this%rbuffzC, this%restartPhi) + this%rbuffyC, this%rbuffzC, this%restartPhi, this%dummy_controller) + call message(0, "Wind-angle controller successfully initialized.") end if this%angleHubHeight = 1.d0 this%totalAngle = 0.d0 this%wFilt = 0.d0 this%deltaGalpha = 0.d0 + ! STEP 24: Compute pressure + if ((this%storePressure) .or. (this%fastCalcPressure)) then + call this%ComputePressure() + end if + ! STEP 28: Compute the timestep call this%compute_deltaT() this%dtOld = this%dt diff --git a/src/incompressible/igrid_files/budgets_stuff.F90 b/src/incompressible/igrid_files/budgets_stuff.F90 index 4f80ce22..8c9a8410 100644 --- a/src/incompressible/igrid_files/budgets_stuff.F90 +++ b/src/incompressible/igrid_files/budgets_stuff.F90 @@ -61,6 +61,80 @@ subroutine instrumentForBudgets(this, uc, vc, wc, usgs, vsgs, wsgs, uvisc, vvisc end subroutine +subroutine instrumentForDeficitBudgets(this, uc, vc, wc, usgs, vsgs, wsgs, px, py, pz, ucor, vcor, wcor, wb, uturb, vturb, wturb) + class(igrid), intent(inout) :: this + complex(rkind), dimension(:,:,:), intent(in), target :: uc, vc, wc, usgs, vsgs, wsgs, px, py, pz + complex(rkind), dimension(:,:,:), intent(in), target :: ucor, vcor, wcor, wb + complex(rkind), dimension(:,:,:), intent(in), optional, target :: uturb, vturb, wturb + + this%ucon => uc + this%vcon => vc + this%wcon => wc + + this%usgs => usgs + this%vsgs => vsgs + this%wsgs => wsgs + + this%px => px + this%py => py + this%pz => pz + + this%uvisc => null() + this%vvisc => null() + this%wvisc => null() + + this%ucor => ucor + this%vcor => vcor + this%wcor => wcor + + this%wb => wb + + this%pxdns => null() + this%pydns => null() + this%pzdns => null() + + if(present(uturb))then + this%uturb => uturb + else + this%uturb => null() + end if + + if(present(vturb))then + this%vturb => vturb + else + this%vturb => null() + end if + + if(present(wturb))then + this%wturb => wturb + else + this%wturb => null() + end if + + this%HITforcing_x => null() + this%HITforcing_y => null() + this%HITforcing_z => null() + + ! Safeguards + this%StoreForBudgets = .true. + if (.not. this%fastCalcPressure) then + call GracefulExit("Cannot perform budget calculations if IGRID is initialized with FASTCALCPRESSURE=.false.", 324) + end if + + if (.not. useSkewSymm) then + call message("WARNING: Advection term should be evaluated in the skew-symmetric form in order to perform budget calculations.") + end if + + if (this%useControl) then + call message("WARNING: Budget calculations ignore the frame angle controller effects.", 324) + end if + + call message(1,"Before set_budget_rhs in instrumentForBudgets_timeAvg") + call this%set_budget_rhs_to_zero() + + call message(0, "Deficit budget calculations instrumented within igrid!") +end subroutine + subroutine instrumentForBudgets_TimeAvg(this, uc, vc, wc, usgs, vsgs, wsgs, px, py, pz, uturb, vturb, wturb, pxdns, pydns, pzdns, uvisc, vvisc, wvisc, ucor, vcor, wcor, wb) class(igrid), intent(inout) :: this complex(rkind), dimension(:,:,:), intent(in), target :: uc, vc, wc, usgs, vsgs, wsgs, px, py, pz, uturb, vturb, wturb diff --git a/src/incompressible/igrid_files/io_stuff.F90 b/src/incompressible/igrid_files/io_stuff.F90 index ce4149af..1b083757 100644 --- a/src/incompressible/igrid_files/io_stuff.F90 +++ b/src/incompressible/igrid_files/io_stuff.F90 @@ -671,107 +671,202 @@ subroutine dump_visualization_files(this) end if end subroutine - subroutine start_io(this, dumpInitField) - class(igrid), target, intent(inout) :: this - character(len=clen) :: fname - character(len=clen) :: tempname - !character(len=clen) :: command - character(len=clen) :: OutputDir - !integer :: system - integer :: runIDX - logical :: isThere - integer :: tag, idx, status(MPI_STATUS_SIZE), ierr - integer, dimension(:,:), allocatable :: xst,xen,xsz - logical, optional, intent(in) :: dumpInitField - - ! Create data sharing info - !if (nrank == 0) then - allocate(xst(0:nproc-1,3),xen(0:nproc-1,3),xsz(0:nproc-1,3)) - xst = 0; xen = 0; xsz = 0; - !end if - - - ! communicate local processor grid info (Assume x-decomposition) - if (nrank == 0) then - xst(0,:) = this%gpC%xst - xen(0,:) = this%gpC%xen +! subroutine start_io(this, dumpInitField) +! class(igrid), target, intent(inout) :: this +! character(len=clen) :: fname +! character(len=clen) :: tempname +! !character(len=clen) :: command +! character(len=clen) :: OutputDir +! !integer :: system +! integer :: runIDX +! logical :: isThere +! integer :: tag, idx, status(MPI_STATUS_SIZE), ierr +! integer, dimension(:,:), allocatable :: xst,xen,xsz +! logical, optional, intent(in) :: dumpInitField + +! ! Create data sharing info +! !if (nrank == 0) then +! allocate(xst(0:nproc-1,3),xen(0:nproc-1,3),xsz(0:nproc-1,3)) +! xst = 0; xen = 0; xsz = 0; +! !end if + + +! ! communicate local processor grid info (Assume x-decomposition) +! if (nrank == 0) then +! xst(0,:) = this%gpC%xst +! xen(0,:) = this%gpC%xen - tag = 0 - do idx = 1,nproc-1 - call MPI_RECV(xst(idx,:), 3, MPI_INTEGER, idx, tag,& - MPI_COMM_WORLD, status, ierr) - end do - tag = 1 - do idx = 1,nproc-1 - call MPI_RECV(xen(idx,:), 3, MPI_INTEGER, idx, tag,& - MPI_COMM_WORLD, status, ierr) - end do - tag = 2 - do idx = 1,nproc-1 - call MPI_RECV(xsz(idx,:), 3, MPI_INTEGER, idx, tag,& - MPI_COMM_WORLD, status, ierr) - end do +! tag = 0 +! do idx = 1,nproc-1 +! call MPI_RECV(xst(idx,:), 3, MPI_INTEGER, idx, tag,& +! MPI_COMM_WORLD, status, ierr) +! end do +! tag = 1 +! do idx = 1,nproc-1 +! call MPI_RECV(xen(idx,:), 3, MPI_INTEGER, idx, tag,& +! MPI_COMM_WORLD, status, ierr) +! end do +! tag = 2 +! do idx = 1,nproc-1 +! call MPI_RECV(xsz(idx,:), 3, MPI_INTEGER, idx, tag,& +! MPI_COMM_WORLD, status, ierr) +! end do + +! else +! tag = 0 +! call MPI_SEND(this%gpC%xst, 3, MPI_INTEGER, 0, tag, & +! & MPI_COMM_WORLD, ierr) +! tag = 1 +! call MPI_SEND(this%gpC%xen, 3, MPI_INTEGER, 0, tag, & +! & MPI_COMM_WORLD, ierr) +! tag = 2 +! call MPI_SEND(this%gpC%xsz, 3, MPI_INTEGER, 0, tag, & +! & MPI_COMM_WORLD, ierr) + +! end if + +! OutputDir = this%outputdir +! runIDX = this%runID + +! inquire(FILE=trim(OutputDir), exist=isThere) +! if (nrank == 0) then +! write(tempname,"(A3,I2.2,A6,A4)") "Run", runIDX, "HEADER",".txt" +! fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) + +! open (this%headerfid, file=trim(fname), FORM='formatted', STATUS='replace',ACTION='write') +! write(this%headerfid,*)"=========================================================================" +! write(this%headerfid,*)"--------------------- Header file for MATLAB ---------------------------" +! write(this%headerfid,"(A9,A10,A10,A10,A10,A10,A10)") "PROC", "xst", "xen", "yst", "yen","zst","zen" +! write(this%headerfid,*)"-------------------------------------------------------------------------" +! do idx = 0,nproc-1 +! write(this%headerfid,"(I8,6I10)") idx, xst(idx,1), xen(idx,1), xst(idx,2), xen(idx,2), xst(idx,3), xen(idx,3) +! end do +! write(this%headerfid,*)"-------------------------------------------------------------------------" +! write(this%headerfid,*)"Dumps made at:" +! end if +! call mpi_barrier(mpi_comm_world,ierr) + +! !if (nrank == 0) then +! deallocate(xst, xen, xsz) +! !end if + +! if (present(dumpInitField)) then +! if (dumpInitField) then +! call message(0,"Performing initialization data dump.") +! !call this%dumpFullField(this%u,'uVel') +! !call this%dumpFullField(this%v,'vVel') +! !call this%dumpFullField(this%wC,'wVel') +! !call this%dump_scalar_fields() +! !call this%dumpVisualizationInfo() +! !if (this%isStratified .or. this%initspinup) call this%dumpFullField(this%T,'potT') +! !if (this%fastCalcPressure) call this%dumpFullField(this%pressure,'prss') +! !if (this%computeDNSpressure) call this%dumpFullField(this%pressure_dns,'pdns') +! !if (this%computeturbinepressure) call this%dumpFullField(this%pressure_turbine,'ptrn') +! !if (this%computefringepressure) call this%dumpFullField(this%pressure_fringe,'pfrn') +! !if (this%useWindTurbines) then +! ! this%WindTurbineArr%dumpTurbField = .true. +! ! this%WindTurbineArr%step = this%step-1 +! !endif +! call this%dump_visualization_files() +! call message(0,"Done with the initialization data dump.") +! end if +! end if +! end subroutine - else - tag = 0 - call MPI_SEND(this%gpC%xst, 3, MPI_INTEGER, 0, tag, & - & MPI_COMM_WORLD, ierr) - tag = 1 - call MPI_SEND(this%gpC%xen, 3, MPI_INTEGER, 0, tag, & - & MPI_COMM_WORLD, ierr) - tag = 2 - call MPI_SEND(this%gpC%xsz, 3, MPI_INTEGER, 0, tag, & - & MPI_COMM_WORLD, ierr) + subroutine start_io(this, dumpInitField) + class(igrid), target, intent(inout) :: this + character(len=clen) :: fname + character(len=clen) :: tempname + character(len=clen) :: OutputDir + integer :: runIDX + logical :: isThere + integer :: idx, ierr + logical, optional, intent(in) :: dumpInitField + + ! Local 3-int vectors (send buffers) + integer :: xst_loc(3), xen_loc(3), xsz_loc(3) + + ! Root receive buffers (packed, contiguous) + integer, allocatable :: xst_all(:), xen_all(:), xsz_all(:) + + ! Optional: convenience 2D views on root + integer, allocatable :: xst(:,:), xen(:,:), xsz(:,:) + + xst_loc = this%gpC%xst + xen_loc = this%gpC%xen + xsz_loc = this%gpC%xsz + + !----------------------------------------- + ! Allocate receive buffers on root only + !----------------------------------------- + if (nrank == 0) then + allocate(xst_all(3*nproc), xen_all(3*nproc), xsz_all(3*nproc)) + xst_all = 0; xen_all = 0; xsz_all = 0 + + allocate(xst(0:nproc-1,3), xen(0:nproc-1,3), xsz(0:nproc-1,3)) + xst = 0; xen = 0; xsz = 0 + end if - end if + !----------------------------------------- + ! Gather to rank 0 + ! Each rank sends 3 ints; root receives 3*nproc ints + !----------------------------------------- + call MPI_GATHER(xst_loc, 3, MPI_INTEGER, xst_all, 3, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHER(xen_loc, 3, MPI_INTEGER, xen_all, 3, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + call MPI_GATHER(xsz_loc, 3, MPI_INTEGER, xsz_all, 3, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) + + !----------------------------------------- + ! Unpack into (0:nproc-1,3) for existing code + !----------------------------------------- + if (nrank == 0) then + do idx = 0, nproc-1 + xst(idx,1:3) = xst_all(3*idx+1 : 3*idx+3) + xen(idx,1:3) = xen_all(3*idx+1 : 3*idx+3) + xsz(idx,1:3) = xsz_all(3*idx+1 : 3*idx+3) + end do + end if - OutputDir = this%outputdir - runIDX = this%runID - - inquire(FILE=trim(OutputDir), exist=isThere) - if (nrank == 0) then - write(tempname,"(A3,I2.2,A6,A4)") "Run", runIDX, "HEADER",".txt" - fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) - - open (this%headerfid, file=trim(fname), FORM='formatted', STATUS='replace',ACTION='write') - write(this%headerfid,*)"=========================================================================" - write(this%headerfid,*)"--------------------- Header file for MATLAB ---------------------------" - write(this%headerfid,"(A9,A10,A10,A10,A10,A10,A10)") "PROC", "xst", "xen", "yst", "yen","zst","zen" - write(this%headerfid,*)"-------------------------------------------------------------------------" - do idx = 0,nproc-1 - write(this%headerfid,"(I8,6I10)") idx, xst(idx,1), xen(idx,1), xst(idx,2), xen(idx,2), xst(idx,3), xen(idx,3) - end do - write(this%headerfid,*)"-------------------------------------------------------------------------" - write(this%headerfid,*)"Dumps made at:" - end if - call mpi_barrier(mpi_comm_world,ierr) - - !if (nrank == 0) then - deallocate(xst, xen, xsz) - !end if - - if (present(dumpInitField)) then - if (dumpInitField) then - call message(0,"Performing initialization data dump.") - !call this%dumpFullField(this%u,'uVel') - !call this%dumpFullField(this%v,'vVel') - !call this%dumpFullField(this%wC,'wVel') - !call this%dump_scalar_fields() - !call this%dumpVisualizationInfo() - !if (this%isStratified .or. this%initspinup) call this%dumpFullField(this%T,'potT') - !if (this%fastCalcPressure) call this%dumpFullField(this%pressure,'prss') - !if (this%computeDNSpressure) call this%dumpFullField(this%pressure_dns,'pdns') - !if (this%computeturbinepressure) call this%dumpFullField(this%pressure_turbine,'ptrn') - !if (this%computefringepressure) call this%dumpFullField(this%pressure_fringe,'pfrn') - !if (this%useWindTurbines) then - ! this%WindTurbineArr%dumpTurbField = .true. - ! this%WindTurbineArr%step = this%step-1 - !endif - call this%dump_visualization_files() - call message(0,"Done with the initialization data dump.") - end if - end if - end subroutine + OutputDir = this%outputdir + runIDX = this%runID + + inquire(FILE=trim(OutputDir), exist=isThere) ! This seems useless + if (nrank == 0) then + write(tempname,"(A3,I2.2,A6,A4)") "Run", runIDX, "HEADER", ".txt" + fname = OutputDir(:len_trim(OutputDir))//"/"//trim(tempname) + + open (this%headerfid, file=trim(fname), FORM='formatted', STATUS='replace', ACTION='write') + write(this%headerfid,*)"=========================================================================" + write(this%headerfid,*)"--------------------- Header file for MATLAB ---------------------------" + write(this%headerfid,"(A9,A10,A10,A10,A10,A10,A10)") "PROC", "xst", "xen", "yst", "yen","zst","zen" + write(this%headerfid,*)"-------------------------------------------------------------------------" + do idx = 0,nproc-1 + write(this%headerfid,"(I8,6I10)") idx, xst(idx,1), xen(idx,1), xst(idx,2), xen(idx,2), xst(idx,3), xen(idx,3) + end do + write(this%headerfid,*)"-------------------------------------------------------------------------" + write(this%headerfid,*)"Dumps made at:" + end if + + call MPI_BARRIER(MPI_COMM_WORLD, ierr) + + !----------------------------------------- + ! Deallocate (root only for root allocs) + !----------------------------------------- + if (nrank == 0) then + deallocate(xst_all, xen_all, xsz_all) + deallocate(xst, xen, xsz) + end if + + !----------------------------------------- + ! Remainder of your routine unchanged + !----------------------------------------- + if (present(dumpInitField)) then + if (dumpInitField) then + call message(0,"Performing initialization data dump.") + call this%dump_visualization_files() + call message(0,"Done with the initialization data dump.") + end if + end if + end subroutine subroutine readField3D(RunID, TIDX, inputDir, label, field, gpC) use exits, only: GracefulExit diff --git a/src/incompressible/igrid_files/popRHS_stuff.F90 b/src/incompressible/igrid_files/popRHS_stuff.F90 index c8c6f4bd..e2f56ef8 100644 --- a/src/incompressible/igrid_files/popRHS_stuff.F90 +++ b/src/incompressible/igrid_files/popRHS_stuff.F90 @@ -203,6 +203,7 @@ subroutine populate_RHS_extraTerms(this, copyFringeRHS, storeForBudget) class(igrid), intent(inout) :: this logical, intent(in) :: copyFringeRHS, storeForBudget integer :: idx + logical :: pass_cntrl_logic=.False. ! Step 7a: Extra Forcing if (this%useExtraForcing) then @@ -280,8 +281,37 @@ subroutine populate_RHS_extraTerms(this, copyFringeRHS, storeForBudget) ! Step 9: Frame rotatio PI controller to fix yaw angle at a given height if (this%useControl .AND. abs(180.d0/pi*this%angleHubHeight)>0.0d0) then - call this%angCont_yaw%update_RHS_control(this%dt, this%u_rhs, this%v_rhs, & - this%w_rhs, this%u, this%v, this%newTimeStep, this%angleHubHeight, this%wFilt, this%deltaGalpha, this%zHubIndex, this%angleTrigger) + pass_cntrl_logic = this%dummy_controller + if (this%dummy_controller) then + if(ASSOCIATED(this%angCont_yaw_dummy))then + ! Copy some values from the other controller as they will not be + ! calculated when updating the RHS + ! TODO: A copy procedure would make this cleaner + this%angCont_yaw%phi_n = this%angCont_yaw_dummy%phi_n + this%angCont_yaw%phi = this%angCont_yaw_dummy%phi + this%angCont_yaw%wFilt = this%angCont_yaw_dummy%wFilt + this%angCont_yaw%wFilt_n = this%angCont_yaw_dummy%wFilt_n + + ! Do the same for igrid attributes + this%angleHubHeight = this%angCont_yaw_dummy%phi_n + this%wFilt = this%angCont_yaw_dummy%wFilt_n + this%deltaGalpha = this%angCont_yaw_dummy%deltaGalpha + this%zHubIndex = this%angCont_yaw_dummy%z_ref + this%angleTrigger = this%angCont_yaw_dummy%angleTrigger + + ! passed logic + pass_cntrl_logic = this%dummy_controller + else + ! this is probably the initializtion step + ! hotfix to having this routine being called before + ! angCont_yaw_dummy points to the main controller + pass_cntrl_logic = .False. + end if + end if + call this%angCont_yaw%update_RHS_control(this%dt, this%u_rhs, this%v_rhs, & + this%w_rhs, this%u, this%v, this%newTimeStep, this%angleHubHeight, & + this%wFilt, this%deltaGalpha, this%zHubIndex, this%angleTrigger, & + pass_cntrl_logic) this%totalAngle = this%totalAngle + this%angleHubHeight this%angleHubHeight = 1.d0 ! HOTFIX - do not use angleHubHeight for the hub height wind angle end if diff --git a/src/incompressible/igrid_files/rhs_stuff.F90 b/src/incompressible/igrid_files/rhs_stuff.F90 index 1607e00a..550b96b3 100644 --- a/src/incompressible/igrid_files/rhs_stuff.F90 +++ b/src/incompressible/igrid_files/rhs_stuff.F90 @@ -6,7 +6,7 @@ subroutine get_geostrophic_forcing(this, Fg_x, Fg_y) real(rkind), dimension(:,:,:), pointer :: gx_vec, gy_vec real(rkind) :: gx, gy - if (not(this%useConstantG) .and. (this%fringe_x%TargetsAssociated)) then + if ((.not. this%useConstantG) .and. (this%fringe_x%TargetsAssociated)) then ! adds a coriolis term that changes in Z gx_vec => this%fringe_x%u_target gy_vec => this%fringe_x%v_target @@ -51,7 +51,7 @@ subroutine addCoriolisTerm(this, urhs, vrhs, wrhs) ! MODIFYING GEOSTROPHIC BEGINS HERE: - if (not(this%useConstantG) .and. (this%fringe_x%TargetsAssociated)) then + if ((.not. this%useConstantG) .and. (this%fringe_x%TargetsAssociated)) then u_target => this%fringe_x%u_target v_target => this%fringe_x%v_target @@ -208,6 +208,9 @@ subroutine addNonLinearTerm_Rot(this, u_rhs, v_rhs, w_rhs) T2E = T2E*this%vE T1E = T1E + T2E !call this%spectE%fft(T1E,this%w_rhs) + if(this%useFringeAD)then + T1E = T1E * this%fringe_ad%Fringe_kernel + end if call this%spectE%fft(T1E,w_rhs) if (this%isStratified .or. this%initspinup) then @@ -233,7 +236,7 @@ subroutine addNonLinearTerm_skewSymm(this, urhs, vrhs, wrhs) real(rkind), dimension(:,:,:), pointer :: dvdzC, dudzC real(rkind), dimension(:,:,:), pointer :: dwdxC, dwdyC real(rkind), dimension(:,:,:), pointer :: T1C, T2C, T1E, T2E - complex(rkind), dimension(:,:,:), pointer :: fT1C, fT2C, fT1E, fT2E + complex(rkind), dimension(:,:,:), pointer :: fT1C, fT2C, fT1E, fT2E, fT3E complex(rkind), dimension(:,:,:), pointer :: tzC, tzE complex(rkind), dimension(this%sp_gpC%ysz(1),this%sp_gpC%ysz(2),this%sp_gpC%ysz(3)), intent(inout) :: urhs, vrhs complex(rkind), dimension(this%sp_gpE%ysz(1),this%sp_gpE%ysz(2),this%sp_gpE%ysz(3)), intent(inout) :: wrhs @@ -250,6 +253,11 @@ subroutine addNonLinearTerm_skewSymm(this, urhs, vrhs, wrhs) fT1C => this%cbuffyC(:,:,:,1); fT2C => this%cbuffyC(:,:,:,2) fT1E => this%cbuffyE(:,:,:,1); fT2E => this%cbuffyE(:,:,:,2) + if(this%useFringeAD) then + ! An extra buffer to collect the w convection term in spectral domain + ! ifft the w convection term, mutliply it by the fringe_kernel, then fft back to add to wrhs. + fT3E => this%cbuffyE(:,:,:,3) + end if tzC => this%cbuffzC(:,:,:,1); tzE => this%cbuffzE(:,:,:,1) @@ -289,9 +297,14 @@ subroutine addNonLinearTerm_skewSymm(this, urhs, vrhs, wrhs) call transpose_y_to_z(fT1C,tzC, this%sp_gpC) call this%Pade6opZ%interpz_C2E(tzC,tzE,WdWdzBC_bottom,WdWdzBC_top) !call transpose_z_to_y(tzE,this%w_rhs, this%sp_gpE) - call transpose_z_to_y(tzE,wrhs, this%sp_gpE) !this%w_rhs = this%w_rhs + fT2E - wrhs = wrhs + fT2E + if(this%useFringeAD)then + call transpose_z_to_y(tzE,fT3E, this%sp_gpE) + fT3E = fT3E + fT2E + else + call transpose_z_to_y(tzE,wrhs, this%sp_gpE) + wrhs = wrhs + fT2E + end if T1C = this%u*this%u call this%spectC%fft(T1C,fT1C) @@ -311,7 +324,11 @@ subroutine addNonLinearTerm_skewSymm(this, urhs, vrhs, wrhs) call this%Pade6opZ%ddz_C2E(tzC,tzE,WWBC_bottom,WWBC_top) call transpose_z_to_y(tzE,fT1E,this%sp_gpE) !this%w_rhs = this%w_rhs + fT1E - wrhs = wrhs + fT1E + if(this%useFringeAD)then + fT3E = fT3E + fT1E + else + wrhs = wrhs + fT1E + end if T1C = this%u*this%v call this%spectC%fft(T1C,fT1C) @@ -332,8 +349,11 @@ subroutine addNonLinearTerm_skewSymm(this, urhs, vrhs, wrhs) call this%spectE%mtimes_ik1_ip(fT1E) !this%w_rhs = this%w_rhs + fT1E - wrhs = wrhs + fT1E - + if(this%useFringeAD)then + fT3E = fT3E + fT1E + else + wrhs = wrhs + fT1E + end if T1E = this%vE*this%w call this%spectE%fft(T1E,fT1E) @@ -345,7 +365,22 @@ subroutine addNonLinearTerm_skewSymm(this, urhs, vrhs, wrhs) call this%spectE%mtimes_ik2_ip(fT1E) !this%w_rhs = this%w_rhs + fT1E - wrhs = wrhs + fT1E + if(this%useFringeAD)then + fT3E = fT3E + fT1E + else + wrhs = wrhs + fT1E + end if + + if(this%useFringeAD)then + ! ifft + call this%spectE%ifft(fT3E,T1E) + + ! Multiply by the damping kernel + T1E = T1E * this%fringe_ad%Fringe_kernel + + ! fft back + call this%spectE%fft(T1E, wrhs) + end if !this%u_rhs = -half*this%u_rhs !this%v_rhs = -half*this%v_rhs @@ -397,7 +432,7 @@ subroutine addBuoyancyTerm(this, urhs, vrhs, wrhs) mind = this%moistureIndex call transpose_y_to_z(this%scalars(mind)%fhat, this%cbuffzC(:,:,:,1), this%sp_gpC) call this%Pade6opZ%interpz_C2E(this%cbuffzC(:,:,:,1), this%cbuffzE(:,:,:,1), this%scalars(mind)%BC_bottom, this%scalars(mind)%BC_top) - call transpose_z_to_y(this%cbuffzE(:,:,:,1), this%cbuffyE(:,:,:,1), this%sp_gpC) + call transpose_z_to_y(this%cbuffzE(:,:,:,1), this%cbuffyE(:,:,:,1), this%sp_gpE) fT1E = (this%TEhat + this%moistureFactor*this%cbuffyE(:,:,:,1))*this%BuoyancyFact ! See definition of buoyancy factor in init !else !fT1E = (this%TEhat)*this%BuoyancyFact ! See definition of buoyancy factor in init diff --git a/src/incompressible/igrid_files/timestepping_stuff.F90 b/src/incompressible/igrid_files/timestepping_stuff.F90 index aa69b66e..b42d9439 100644 --- a/src/incompressible/igrid_files/timestepping_stuff.F90 +++ b/src/incompressible/igrid_files/timestepping_stuff.F90 @@ -540,24 +540,23 @@ subroutine wrapup_timestep(this) end if end if - if (this%vizDump_Schedule == 1) then - if (this%DumpThisStep) then - call message(2,"Performing a fixed timed visualization dump at time:", this%tsim) - call message(2,"This time step used a deltaT:",this%dt) - call this%dump_visualization_files() - end if - else - if (mod(this%step,this%t_dataDump) == 0) then - call message(0,"Scheduled visualization dump.") - call this%dump_visualization_files() - end if - end if + if (this%vizDump_Schedule == 1 .and. this%DumpThisStep) then + call message(0,"Performing a fixed timed visualization dump at time:", this%tsim) + call message(2,"This time step used a deltaT:",this%dt) + call this%dump_visualization_files() - if (forceWrite) then - call message(2,"Performing a forced visualization dump.") - call this%dump_visualization_files() - end if + else if (this%vizDump_Schedule /= 1 .and. mod(this%step, this%t_dataDump) == 0) then + + call message(0,"Scheduled visualization dump.") + call this%dump_visualization_files() + + else if (forceWrite) then + + call message(0,"Performing a forced visualization dump.") + call this%dump_visualization_files() + + end if if (this%initspinup) then if (this%tsim > this%Tstop_initspinup) then diff --git a/src/incompressible/turbineMod.F90 b/src/incompressible/turbineMod.F90 index 14899be2..36e12f35 100644 --- a/src/incompressible/turbineMod.F90 +++ b/src/incompressible/turbineMod.F90 @@ -309,7 +309,7 @@ subroutine init(this, inputFile, gpC, gpE, spectC, spectE, cbuffyC, cbuffYE, cbu allocate(this%dynamicArray(this%nTurbines)) ! TODO make generic turbine and move this outside do i = 1, this%nTurbines - call this%turbArrayADM_fil(i)%init(turbInfoDir, i, mesh(:,:,:,1), mesh(:,:,:,2), mesh(:,:,:,3)) + call this%turbArrayADM_fil(i)%init(turbInfoDir, i, mesh(:,:,:,1), mesh(:,:,:,2), mesh(:,:,:,3), dx, dy, dz) this%gamma(i) = this%turbArrayADM_fil(i)%yaw*pi/180.d0 ! stored in RADIANS TODO - phase this out this%theta(i) = 0.d0 ! tilt angle @@ -324,7 +324,7 @@ subroutine init(this, inputFile, gpC, gpE, spectC, spectE, cbuffyC, cbuffYE, cbu ! added ADM type 6 for pressure figure KSH 09/17/2023 allocate (this%turbArrayADM_CT(this%nTurbines)) do i = 1, this%nTurbines - call this%turbArrayADM_CT(i)%init(turbInfoDir, i, mesh(:,:,:,1), mesh(:,:,:,2), mesh(:,:,:,3)) + call this%turbArrayADM_CT(i)%init(turbInfoDir, i, mesh(:,:,:,1), mesh(:,:,:,2), mesh(:,:,:,3), dx, dy, dz) this%gamma(i) = this%turbArrayADM_CT(i)%yaw*pi/180.d0 ! stored in RADIANS TODO - phase this out this%theta(i) = 0.d0 end do @@ -785,7 +785,7 @@ subroutine getForceRHS(this, dt, u, v, wC, urhs, vrhs, wrhs, newTimeStep, inst_h call this%dynamicArray(i)%time_advance(dt) endif - call this%turbArrayADM_fil(i)%get_RHS(u,v,wC,this%fx,this%fy,this%fz) + call this%turbArrayADM_fil(i)%get_RHS(u,v,wC,this%fx,this%fy,this%fz, budgetCall) end do case (6) do i = 1, this%nTurbines diff --git a/src/io/io_VTK.F90 b/src/io/io_VTK.F90 deleted file mode 100644 index 1b75c28b..00000000 --- a/src/io/io_VTK.F90 +++ /dev/null @@ -1,229 +0,0 @@ -module io_VTK_stuff - - use mpi - use kind_parameters, only : rkind,clen - use decomp_2d, only: decomp_info, get_decomp_info, decomp_2d_init, decomp_2d_finalize, & - transpose_x_to_y, transpose_y_to_x, transpose_y_to_z, transpose_z_to_y,& - update_halo, nrank, nproc - use Lib_VTK_IO - use IR_Precision - use exits, only: GracefulExit, message - use io_stuff, only: io - implicit none - - external :: SYSTEM, MPI_RECV, MPI_SEND - - type, extends(io) :: io_VTK - - contains - - procedure :: init - procedure :: destroy - - procedure :: WriteViz - procedure :: SetVizcount - - end type - -contains - - subroutine init(this, vizdir_, file_prefix_, nprimary_, primary_names_) - class(io_VTK), intent(inout) :: this - character(len=*), intent(in) :: vizdir_ - character(len=*), intent(in) :: file_prefix_ - integer, intent(in) :: nprimary_ - character(len=*), dimension(nprimary_), intent(in) :: primary_names_ - - integer :: i - - this%vizcount = 0 - this%vizdir = vizdir_ - - ! Create vizdir if it does not exist - ! call execute_command_line('mkdir -p ' // adjustl(trim(this%vizdir))) - call system('mkdir -p ' // adjustl(trim(this%vizdir))) - - this%file_prefix = '' - if (trim(file_prefix_) .NE. '') then - this%file_prefix = trim(file_prefix_) // '_' - end if - - this%nprimary = nprimary_ - - if(size(primary_names_,1) .ne. this%nprimary) then - call GracefulExit("Incompatible number of variables and number of variable names in VTK IO",981) - end if - - if (allocated(this%primary_names)) deallocate(this%primary_names) - allocate(this%primary_names(this%nprimary)) - - do i=1,this%nprimary - this%primary_names(i) = trim(primary_names_(i)) - end do - - end subroutine - - subroutine destroy(this) - class(io_VTK), intent(inout) :: this - - this%vizcount = 0 - this%vizdir = '' - this%file_prefix = '' - this%nprimary = 0 - if (allocated(this%primary_names)) deallocate(this%primary_names) - - end subroutine - - subroutine WriteViz(this, gp, mesh, primary, tsim, secondary, secondary_names) - class(io_VTK), intent(inout) :: this - class(decomp_info), intent(in) :: gp - real(rkind), dimension(gp%ysz(1),gp%ysz(2),gp%ysz(3),3), intent(in) :: mesh - real(rkind), dimension(gp%ysz(1),gp%ysz(2),gp%ysz(3),this%nprimary), intent(in) :: primary - real(rkind), intent(in), optional :: tsim - real(rkind), dimension(:,:,:,:), intent(in), optional :: secondary - character(len=*), dimension(:), intent(in), optional :: secondary_names - - real(rkind), dimension(:,:,:), allocatable :: tmp1,tmp2,tmp3 - integer :: nx1,nx2,ny1,ny2,nz1,nz2,nn - integer :: nx,ny,nz - integer, dimension(MPI_STATUS_SIZE) :: mpistatus - integer :: i,ierr,E_IO - - character(len=clen) :: dummy - - call system('mkdir -p ' // adjustl(trim(this%vizdir)//'/'//trim(strz(4,this%vizcount)))) - write(dummy,'(I4)') this%vizcount - call message("Writing viz dump "//trim(dummy)//" to " //trim(this%vizdir)//'/'//trim(this%file_prefix)//trim(strz(4,this%vizcount))//'.pvts') - - if (present(secondary)) then - if (.not. present(secondary_names)) then - call GracefulExit("Cannot specify secondary array without secondary variable names in VTK IO",982) - else - if (size(secondary,4) .ne. size(secondary_names,1)) then - call GracefulExit("Number of secondary output arrays not equal to the number of secondary variable names",983) - end if - end if - end if - - nx = gp%xsz(1); ny = gp%ysz(2); nz = gp%zsz(3) - - nx1 = gp%yst(1) - nx2 = gp%yen(1)+1 - ny1 = gp%yst(2) - ny2 = gp%yen(2) ! no +1 here since we're in the y decomposition - nz1 = gp%yst(3) - nz2 = gp%yen(3)+1 - - ! No overlap point for boundary processors - if ( (gp%yen(1) == nx) ) then - nx2 = nx - end if - if ( (gp%yen(3) == nz) ) then - nz2 = nz - end if - - nn = (nx2-nx1+1)*(ny2-ny1+1)*(nz2-nz1+1) - - E_IO = VTK_INI_XML_WRITE(fformat='binary', & - filename=trim(this%vizdir)//'/'//trim(strz(4,this%vizcount))//'/'//trim(this%file_prefix)//trim(strz(4,this%vizcount))//'_'//trim(strz(6,nrank))//'.vts', & - mesh_topology='StructuredGrid', nx1=nx1, nx2=nx2, ny1=ny1, ny2=ny2, nz1=nz1, nz2=nz2) - - E_IO = VTK_FLD_XML(fld_action='open') - if (present(tsim)) then - E_IO = VTK_FLD_XML(fld=tsim,fname='TIME') - end if - E_IO = VTK_FLD_XML(fld=this%vizcount,fname='CYCLE') - E_IO = VTK_FLD_XML(fld_action='close') - - ! Halo update for x, y and z - call update_halo(mesh(:,:,:,1),tmp1,1,gp,.FALSE.) - call update_halo(mesh(:,:,:,2),tmp2,1,gp,.FALSE.) - call update_halo(mesh(:,:,:,3),tmp3,1,gp,.FALSE.) - - E_IO = VTK_GEO_XML_WRITE(nx1=nx1,nx2=nx2,ny1=ny1,ny2=ny2,nz1=nz1,nz2=nz2,NN=nn,& - X=tmp1(1:nx2-nx1+1,1:ny2-ny1+1,1:nz2-nz1+1), & - Y=tmp2(1:nx2-nx1+1,1:ny2-ny1+1,1:nz2-nz1+1), & - Z=tmp3(1:nx2-nx1+1,1:ny2-ny1+1,1:nz2-nz1+1) ) - - if( allocated(tmp1) ) deallocate(tmp1) - if( allocated(tmp2) ) deallocate(tmp2) - if( allocated(tmp3) ) deallocate(tmp3) - - E_IO = VTK_DAT_XML(var_location='node',var_block_action='open') - - do i=1,this%nprimary - call update_halo(primary(:,:,:,i),tmp1,1,gp,.FALSE.) - E_IO = VTK_VAR_XML(NC_NN=nn,varname=trim(this%primary_names(i)),var=tmp1(1:nx2-nx1+1,1:ny2-ny1+1,1:nz2-nz1+1)) - if( allocated(tmp1) ) deallocate(tmp1) - end do - - if (present(secondary)) then - do i=1,size(secondary,4) - call update_halo(secondary(:,:,:,i),tmp1,1,gp,.FALSE.) - E_IO = VTK_VAR_XML(NC_NN=nn,varname=trim(secondary_names(i)),var=tmp1(1:nx2-nx1+1,1:ny2-ny1+1,1:nz2-nz1+1)) - if( allocated(tmp1) ) deallocate(tmp1) - end do - end if - - E_IO = VTK_DAT_XML(var_location='node',var_block_action='close') - E_IO = VTK_GEO_XML_WRITE() - - E_IO = VTK_END_XML() - - call MPI_BARRIER(MPI_COMM_WORLD, ierr) - - if (nrank == 0) then - ! First process saves also the composite .pvts file - E_IO = PVTK_INI_XML(filename = trim(this%vizdir)//'/'//trim(this%file_prefix)//trim(strz(4,this%vizcount))//'.pvts', mesh_topology = 'PStructuredGrid',& - nx1=1, nx2=nx, ny1=1, ny2=ny, nz1=1, nz2=nz, tp='Float64') - do i=0,nproc-1 - if (i .NE. 0) then - call MPI_RECV(nx1,1,MPI_INTEGER,i,i ,MPI_COMM_WORLD,mpistatus,ierr) - call MPI_RECV(nx2,1,MPI_INTEGER,i,i+ nproc,MPI_COMM_WORLD,mpistatus,ierr) - call MPI_RECV(ny1,1,MPI_INTEGER,i,i+2*nproc,MPI_COMM_WORLD,mpistatus,ierr) - call MPI_RECV(ny2,1,MPI_INTEGER,i,i+3*nproc,MPI_COMM_WORLD,mpistatus,ierr) - call MPI_RECV(nz1,1,MPI_INTEGER,i,i+4*nproc,MPI_COMM_WORLD,mpistatus,ierr) - call MPI_RECV(nz2,1,MPI_INTEGER,i,i+5*nproc,MPI_COMM_WORLD,mpistatus,ierr) - end if - E_IO = PVTK_GEO_XML(nx1=nx1,nx2=nx2,ny1=ny1,ny2=ny2,nz1=nz1,nz2=nz2,& - source=trim(strz(4,this%vizcount))//'/'//trim(this%file_prefix)//trim(strz(4,this%vizcount))//'_'//trim(strz(6,i))//'.vts') - end do - - E_IO = PVTK_DAT_XML(var_location='node',var_block_action='open') - - do i=1,this%nprimary - E_IO = PVTK_VAR_XML(varname=trim(this%primary_names(i)),tp='Float64') - end do - - if (present(secondary)) then - do i=1,size(secondary,4) - E_IO = PVTK_VAR_XML(varname=trim(secondary_names(i)),tp='Float64') - end do - end if - - E_IO = PVTK_DAT_XML(var_location='node',var_block_action='close') - - E_IO = PVTK_END_XML() - else - call MPI_SEND(nx1,1,MPI_INTEGER,0,nrank ,MPI_COMM_WORLD,ierr) - call MPI_SEND(nx2,1,MPI_INTEGER,0,nrank+ nproc,MPI_COMM_WORLD,ierr) - call MPI_SEND(ny1,1,MPI_INTEGER,0,nrank+2*nproc,MPI_COMM_WORLD,ierr) - call MPI_SEND(ny2,1,MPI_INTEGER,0,nrank+3*nproc,MPI_COMM_WORLD,ierr) - call MPI_SEND(nz1,1,MPI_INTEGER,0,nrank+4*nproc,MPI_COMM_WORLD,ierr) - call MPI_SEND(nz2,1,MPI_INTEGER,0,nrank+5*nproc,MPI_COMM_WORLD,ierr) - end if - - ! Update vizcount - this%vizcount = this%vizcount + 1 - - end subroutine - - subroutine SetVizcount(this,step) - class(io_VTK), intent(inout) :: this - integer, intent(in) :: step - - this%vizcount = step - - end subroutine - -end module diff --git a/src/io/io_hdf5.F90 b/src/io/io_hdf5.F90 index 79657e41..74d668ee 100644 --- a/src/io/io_hdf5.F90 +++ b/src/io/io_hdf5.F90 @@ -6,8 +6,7 @@ module io_hdf5_stuff use exits, only: GracefulExit implicit none - external :: MPI_ALLREDUCE, SYSTEM, MPI_BCAST - + external :: MPI_ALLREDUCE, MPI_BCAST type :: io_hdf5 diff --git a/src/utilities/reductions.F90 b/src/utilities/reductions.F90 index 595e9e9b..8afc691e 100644 --- a/src/utilities/reductions.F90 +++ b/src/utilities/reductions.F90 @@ -12,7 +12,7 @@ module reductions external :: MPI_ALLREDUCE interface P_MAXVAL - module procedure P_MAXVAL_arr4, P_MAXVAL_arr3, P_MAXVAL_arr2, P_MAXVAL_sca, P_MAXVAL_int, P_MAXVAL_int_locComm + module procedure P_MAXVAL_arr4, P_MAXVAL_arr3, P_MAXVAL_arr3_locComm, P_MAXVAL_arr2, P_MAXVAL_sca, P_MAXVAL_int, P_MAXVAL_int_locComm end interface interface P_MINVAL @@ -63,6 +63,18 @@ function P_MAXVAL_arr4(x) result(maximum) end function + function P_MAXVAL_arr3_locComm(x, locCommWorld) result(maximum) + real(rkind), dimension(:,:,:), intent(in) :: x + integer, intent(in) :: locCommWorld + real(rkind) :: maximum + real(rkind) :: mymax + integer :: ierr + + mymax = MAXVAL(x) + call MPI_Allreduce(mymax, maximum, 1, mpirkind, MPI_MAX, locCommWorld, ierr) + + end function + function P_MAXVAL_arr3(x) result(maximum) real(rkind), dimension(:,:,:), intent(in) :: x real(rkind) :: maximum diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index d8b7fafd..e204f340 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -3,10 +3,10 @@ file(GLOB tests_source_files *.F90) # set(tests_source_files "test_cd10.F90;test_cd06.F90") # Include directories -include_directories( ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${VTK_IO_INCLUDE_PATH} ${HDF5_INCLUDE_PATH} ${PadeOps_BINARY_DIR}/src ) +include_directories( ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${HDF5_INCLUDE_PATH} ${PadeOps_BINARY_DIR}/src ) # Link directories -link_directories( ${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${VTK_IO_LIBRARY_PATH} ${HDF5_LIBRARY_PATH} ${PadeOps_BINARY_DIR}/src ) +link_directories( ${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${HDF5_LIBRARY_PATH} ${PadeOps_BINARY_DIR}/src ) # Create the test executables foreach ( testfile ${tests_source_files} ) @@ -15,7 +15,7 @@ foreach ( testfile ${tests_source_files} ) add_executable( ${testexec} ${testfile} ) - target_link_libraries( ${testexec} IncompressibleOps CompressibleOps 2decomp_fft fftw3 ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ) + target_link_libraries( ${testexec} IncompressibleOps CompressibleOps 2decomp_fft fftw3 ) if (MPI_Fortran_COMPILER_FLAGS) set_target_properties(${testexec} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}")