From 703ea8ca42266693a1b16a2fa9fde2b7b2c3ac8a Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 18 Sep 2025 18:10:51 -0500 Subject: [PATCH 001/114] Add gablsdyn with dynamic profiling of T --- problems/incompressible/gablsdyn_igrid.F90 | 64 ++++ .../gablsdyn_igrid_files/initialize.F90 | 355 ++++++++++++++++++ .../gablsdyn_igrid_files/input_gablsdyn.dat | 172 +++++++++ .../gablsdyn_igrid_files/io.F90 | 251 +++++++++++++ .../gablsdyn_igrid_files/temporalHook.F90 | 110 ++++++ 5 files changed, 952 insertions(+) create mode 100644 problems/incompressible/gablsdyn_igrid.F90 create mode 100644 problems/incompressible/gablsdyn_igrid_files/initialize.F90 create mode 100644 problems/incompressible/gablsdyn_igrid_files/input_gablsdyn.dat create mode 100644 problems/incompressible/gablsdyn_igrid_files/io.F90 create mode 100644 problems/incompressible/gablsdyn_igrid_files/temporalHook.F90 diff --git a/problems/incompressible/gablsdyn_igrid.F90 b/problems/incompressible/gablsdyn_igrid.F90 new file mode 100644 index 00000000..1672ca3e --- /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..327826fd --- /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 + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z0init = 1.d-4, frameAngle = -26.d0, z_Tref = zero, T_inv = zero, dTdz = zero + real(rkind), dimension(:,:,:), allocatable :: randArr, Tpurt, eta + + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, 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) + !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 + ! Added to account for frame angle + !u = u * cos(frameAngle * pi / 180.d0) + !v = v * sin(frameAngle * pi / 180.d0) + + allocate(Tpurt(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) + + 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 + if(allocated(randArr)) deallocate(randArr) + + where (z > 50.d0/xdim) + 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 = zero, Tsurf0 = one, z0init = 1.d-4, dTsurf_dt, z_Tref, T_inv, dTdz + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, 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 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 = zero, Tsurf0 = one, z0init = 1.d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, 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 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 = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z0init = 1.d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz + !real(rkind) :: beta, sigma, phi_ref + !integer :: z_ref + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, 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, z0init = 2.5d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz + !real(rkind) :: beta, sigma, phi_ref + !integer :: z_ref + !namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle!, beta, sigma, phi_ref, z_ref + + 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 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..df5a8126 --- /dev/null +++ b/problems/incompressible/gablsdyn_igrid_files/temporalHook.F90 @@ -0,0 +1,110 @@ +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, dummy_contoller + namelist /CONTROL/ beta, sigma, phi_ref, z_ref, alpha, controlType, angleTrigger, dummy_contoller + + 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 From 85a2862c6317fe517e6d34b48323f2ccf1e5a998 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 18 Sep 2025 18:11:17 -0500 Subject: [PATCH 002/114] use local fftw3 on Stampede3 --- setup/SetupEnv_Stampede3.sh | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh index d5a6cf76..c2b4dd73 100644 --- a/setup/SetupEnv_Stampede3.sh +++ b/setup/SetupEnv_Stampede3.sh @@ -2,13 +2,14 @@ module load cmake 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 From 9100acdcbc03772ff1771362b2d33345c297565f Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 18 Sep 2025 18:13:07 -0500 Subject: [PATCH 003/114] add stable_pbl_concurrent from Kirby's branch --- problems/turbines/stable_pbl_concurrent.F90 | 123 +++++++ .../initialize.F90 | 347 ++++++++++++++++++ .../inputs/input_main.dat | 6 + .../inputs/input_precursor.dat | 151 ++++++++ .../inputs/input_primary.dat | 177 +++++++++ .../inputs/input_stable.dat | 160 ++++++++ .../temporalHook.F90 | 84 +++++ 7 files changed, 1048 insertions(+) create mode 100644 problems/turbines/stable_pbl_concurrent.F90 create mode 100644 problems/turbines/stable_pbl_concurrent_files/initialize.F90 create mode 100644 problems/turbines/stable_pbl_concurrent_files/inputs/input_main.dat create mode 100644 problems/turbines/stable_pbl_concurrent_files/inputs/input_precursor.dat create mode 100644 problems/turbines/stable_pbl_concurrent_files/inputs/input_primary.dat create mode 100644 problems/turbines/stable_pbl_concurrent_files/inputs/input_stable.dat create mode 100644 problems/turbines/stable_pbl_concurrent_files/temporalHook.F90 diff --git a/problems/turbines/stable_pbl_concurrent.F90 b/problems/turbines/stable_pbl_concurrent.F90 new file mode 100644 index 00000000..2901824a --- /dev/null +++ b/problems/turbines/stable_pbl_concurrent.F90 @@ -0,0 +1,123 @@ +! 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 + + 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%wC, precursor%T) + call primary%fringe_x%associateFringeTarget_scalar(precursor%T) + 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 From 2eb3f7a872b484be03179826709d8d2edc1e6605 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 19 Sep 2025 10:37:46 -0500 Subject: [PATCH 004/114] add dummy controller so conc. follows prec. actions --- problems/turbines/stable_pbl_concurrent.F90 | 16 +++++++++- src/incompressible/angleContol.F90 | 29 +++++++++++++------ src/incompressible/igrid.F90 | 4 ++- .../igrid_files/popRHS_stuff.F90 | 22 ++++++++++++-- 4 files changed, 58 insertions(+), 13 deletions(-) diff --git a/problems/turbines/stable_pbl_concurrent.F90 b/problems/turbines/stable_pbl_concurrent.F90 index 2901824a..2840c952 100644 --- a/problems/turbines/stable_pbl_concurrent.F90 +++ b/problems/turbines/stable_pbl_concurrent.F90 @@ -12,7 +12,7 @@ program stable_pbl_concurrent 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 + use exits, only: message, gracefulExit implicit none @@ -53,6 +53,20 @@ program stable_pbl_concurrent call primary%fringe_x%associateFringeTarget_scalar(precursor%T) end if + if (primary%useControl .AND. primary%dummy_contoller)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_contoller) 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 + 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 diff --git a/src/incompressible/angleContol.F90 b/src/incompressible/angleContol.F90 index 4a2a3883..a4d3840c 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, dummy_contoller) 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) :: dummy_contoller 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. dummy_contoller) 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 !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 @@ -179,10 +186,14 @@ 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) + + ! By default + dummy_controller = .FALSE. + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', iostat=ierr) read(unit=ioUnit, NML=CONTROL) @@ -213,7 +224,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/igrid.F90 b/src/incompressible/igrid.F90 index f07ce9ec..f694e7eb 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -268,6 +268,8 @@ module IncompressibleGrid ! Control logical :: useControl = .false. type(angCont), allocatable, public :: angCont_yaw + type(angCont), pointer :: angCont_yaw_dummy => NULL() + logical :: dummy_contoller = .false. real(rkind) :: angleHubHeight, totalAngle, wFilt, restartPhi, deltaGalpha, angleTrigger integer :: zHubIndex = 16 @@ -1313,7 +1315,7 @@ 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_contoller) end if this%angleHubHeight = 1.d0 this%totalAngle = 0.d0 diff --git a/src/incompressible/igrid_files/popRHS_stuff.F90 b/src/incompressible/igrid_files/popRHS_stuff.F90 index c8c6f4bd..9ec4ae19 100644 --- a/src/incompressible/igrid_files/popRHS_stuff.F90 +++ b/src/incompressible/igrid_files/popRHS_stuff.F90 @@ -280,8 +280,26 @@ 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) + if (this%dummy_contoller) 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 + 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, & + this%dummy_contoller) this%totalAngle = this%totalAngle + this%angleHubHeight this%angleHubHeight = 1.d0 ! HOTFIX - do not use angleHubHeight for the hub height wind angle end if From 10ba539287d7ac8e7bf690c646acb155134baab2 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 27 Oct 2025 21:10:49 +0000 Subject: [PATCH 005/114] changes to make code compile on AMD machine with GNU --- CMakeLists.txt | 6 +-- setup/SetupEnv_Archer.sh | 47 ++++++++++++++++++++ src/CMakeLists.txt | 6 ++- src/incompressible/actuatorDisk_CT.F90 | 8 ++-- src/incompressible/actuatorDisk_filtered.F90 | 8 ++-- src/incompressible/igrid_files/rhs_stuff.F90 | 4 +- src/io/io_VTK.F90 | 4 +- src/io/io_hdf5.F90 | 3 +- 8 files changed, 67 insertions(+), 19 deletions(-) create mode 100644 setup/SetupEnv_Archer.sh diff --git a/CMakeLists.txt b/CMakeLists.txt index ca85ccba..40deddfb 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -58,7 +58,7 @@ 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 @@ -69,9 +69,9 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") 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") + 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") 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/src/CMakeLists.txt b/src/CMakeLists.txt index 8778d34e..fb3da30c 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -23,13 +23,15 @@ add_library(PadeOps STATIC ${utilities_source_files} ${derivatives_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}) 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 ${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}) endif() if ( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) target_link_libraries(PadeOps fftw3 2decomp_fft ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ${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 ${VTK_IO_LIBRARY_PATH}/libVTK_IO.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}) endif() diff --git a/src/incompressible/actuatorDisk_CT.F90 b/src/incompressible/actuatorDisk_CT.F90 index 264808c5..3d0175f6 100644 --- a/src/incompressible/actuatorDisk_CT.F90 +++ b/src/incompressible/actuatorDisk_CT.F90 @@ -214,14 +214,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 +239,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,7 +343,7 @@ 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 diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index cad0f736..8aa1fd2a 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -239,14 +239,14 @@ subroutine get_R2(this, ys, zs, R2) 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 + 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 @@ -264,7 +264,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 @@ -372,7 +372,7 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals) real(rkind), dimension(this%nxLoc, this%nyLoc, this%nzLoc), intent(in) :: u, v, w 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 ! update yaw and tilt of the turbine diff --git a/src/incompressible/igrid_files/rhs_stuff.F90 b/src/incompressible/igrid_files/rhs_stuff.F90 index 1607e00a..ee803913 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 diff --git a/src/io/io_VTK.F90 b/src/io/io_VTK.F90 index 1b75c28b..21eaa123 100644 --- a/src/io/io_VTK.F90 +++ b/src/io/io_VTK.F90 @@ -11,8 +11,8 @@ module io_VTK_stuff use io_stuff, only: io implicit none - external :: SYSTEM, MPI_RECV, MPI_SEND - + external :: MPI_RECV, MPI_SEND + type, extends(io) :: io_VTK contains 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 From 4fb972007a652b3b0707b61bee64284068390fff Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 10 Nov 2025 18:07:14 +0000 Subject: [PATCH 006/114] fix release run on AMD using GNU --- CMakeLists.txt | 24 +- .../gablsdyn_igrid_files/temporalHook.F90 | 5 +- problems/turbines/stable_pbl_concurrent.F90 | 5 +- setup/SetupEnv_Archer2.sh | 44 ++++ src/CMakeLists.txt | 18 +- src/incompressible/angleContol.F90 | 13 +- src/incompressible/budget_time_avg.F90 | 8 +- .../budget_time_avg_deficit.F90 | 9 +- src/incompressible/igrid.F90 | 16 +- .../igrid_files/popRHS_stuff.F90 | 44 ++-- src/io/io_VTK.F90 | 229 ------------------ tests/CMakeLists.txt | 6 +- 12 files changed, 128 insertions(+), 293 deletions(-) create mode 100644 setup/SetupEnv_Archer2.sh delete mode 100644 src/io/io_VTK.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 40deddfb..97b4afed 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -21,9 +21,9 @@ 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") # Where to look for HDF5 set(HDF5_PATH $ENV{HDF5_PATH}) @@ -64,21 +64,23 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU_OSX") # 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() + 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 -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 -fallow-argument-mismatch -finit-integer=0 -finit-real=zero") 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/gablsdyn_igrid_files/temporalHook.F90 b/problems/incompressible/gablsdyn_igrid_files/temporalHook.F90 index df5a8126..68b7f9b6 100644 --- a/problems/incompressible/gablsdyn_igrid_files/temporalHook.F90 +++ b/problems/incompressible/gablsdyn_igrid_files/temporalHook.F90 @@ -20,8 +20,9 @@ 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, dummy_contoller - namelist /CONTROL/ beta, sigma, phi_ref, z_ref, alpha, controlType, angleTrigger, dummy_contoller + 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) diff --git a/problems/turbines/stable_pbl_concurrent.F90 b/problems/turbines/stable_pbl_concurrent.F90 index 2840c952..873ecb13 100644 --- a/problems/turbines/stable_pbl_concurrent.F90 +++ b/problems/turbines/stable_pbl_concurrent.F90 @@ -53,10 +53,10 @@ program stable_pbl_concurrent call primary%fringe_x%associateFringeTarget_scalar(precursor%T) end if - if (primary%useControl .AND. primary%dummy_contoller)then + 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_contoller) then + elseif(precursor%dummy_controller) then call gracefulExit("Both Primary and Precursor have dummy controllers. Exiting.", 44) else if(.NOT. allocated(precursor%angCont_yaw))then @@ -64,6 +64,7 @@ program stable_pbl_concurrent 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 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/src/CMakeLists.txt b/src/CMakeLists.txt index fb3da30c..e5da4f25 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -13,27 +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() # 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 ${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 $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") # 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 ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ${MPI_LIBRARIES}) + 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/incompressible/angleContol.F90 b/src/incompressible/angleContol.F90 index a4d3840c..72370ba4 100644 --- a/src/incompressible/angleContol.F90 +++ b/src/incompressible/angleContol.F90 @@ -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, dummy_contoller) + 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,7 +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) :: dummy_contoller + logical, intent(in) :: dumcntl integer :: nx, ny, i, j ! PID tuning parameters real(rkind) :: wControl_n, vM, uM @@ -66,7 +66,7 @@ subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, p ny = this%gpC%ysz(2) ! Only do the following if it is not a dummy controller - if (.NOT. dummy_contoller) then + 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) @@ -161,7 +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 + 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 @@ -175,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 @@ -191,9 +191,6 @@ subroutine init(this, inputfile, spectC, spectE, gpC, gpE, rbuffxC, rbuffxE, cbu !read(unit=ioUnit, NML=CONTROL) !close(ioUnit) - ! By default - dummy_controller = .FALSE. - ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', iostat=ierr) read(unit=ioUnit, NML=CONTROL) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 3074bf3b..cb4766ad 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -283,11 +283,11 @@ subroutine init(this, inputfile, igrid_sim) this%HaveScalars = this%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%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%isStratified) then ! Always assume that you are stratified diff --git a/src/incompressible/budget_time_avg_deficit.F90 b/src/incompressible/budget_time_avg_deficit.F90 index aadc61ea..48477a6e 100644 --- a/src/incompressible/budget_time_avg_deficit.F90 +++ b/src/incompressible/budget_time_avg_deficit.F90 @@ -302,12 +302,11 @@ 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%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%isStratified) then ! Always assume that you are stratified diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index f694e7eb..0300ee0d 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -269,7 +269,7 @@ module IncompressibleGrid logical :: useControl = .false. type(angCont), allocatable, public :: angCont_yaw type(angCont), pointer :: angCont_yaw_dummy => NULL() - logical :: dummy_contoller = .false. + logical :: dummy_controller = .false. real(rkind) :: angleHubHeight, totalAngle, wFilt, restartPhi, deltaGalpha, angleTrigger integer :: zHubIndex = 16 @@ -525,6 +525,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 @@ -1282,10 +1283,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 @@ -1315,13 +1313,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%dummy_contoller) + 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/popRHS_stuff.F90 b/src/incompressible/igrid_files/popRHS_stuff.F90 index 9ec4ae19..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,26 +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 - if (this%dummy_contoller) 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 + 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, & - this%dummy_contoller) + 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/io/io_VTK.F90 b/src/io/io_VTK.F90 deleted file mode 100644 index 21eaa123..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 :: 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/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}") From 125d08449e4906c7c3df5eaa26ff35a3959e273f Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 3 Dec 2025 18:41:04 +0000 Subject: [PATCH 007/114] add O3 in GNU make flags --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 97b4afed..e4c9972e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -70,7 +70,7 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") 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") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O3 -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 -ffree-form -ffree-line-length-none -fcheck=all -fbounds-check -ffpe-trap=zero,overflow -Wall -Wconversion -Wextra -Waliasing -Wsurprising -fallow-argument-mismatch -finit-integer=0 -finit-real=zero") endif() From 2aef2c0bc0b44821d0e4a4b57eaee3df91a4c473 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 3 Dec 2025 18:42:05 +0000 Subject: [PATCH 008/114] only do checks for xy-budget flags if xy-budgets are on --- src/incompressible/budget_xy_avg.F90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/incompressible/budget_xy_avg.F90 b/src/incompressible/budget_xy_avg.F90 index 6ec8c19b..54297899 100644 --- a/src/incompressible/budget_xy_avg.F90 +++ b/src/incompressible/budget_xy_avg.F90 @@ -202,11 +202,10 @@ 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 + 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 allocate(this%Budget_0s(this%nz,21)) allocate(this%Budget_0(this%nz,21)) allocate(this%Budget_1(this%nz,14)) From 9e2aef15c02516e57ed0f39aef4931f2fdf62bb3 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 3 Dec 2025 18:42:50 +0000 Subject: [PATCH 009/114] comment out start_io and xy-budgets in gablsdyn --- problems/incompressible/gablsdyn_igrid.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/problems/incompressible/gablsdyn_igrid.F90 b/problems/incompressible/gablsdyn_igrid.F90 index 1672ca3e..933e4782 100644 --- a/problems/incompressible/gablsdyn_igrid.F90 +++ b/problems/incompressible/gablsdyn_igrid.F90 @@ -30,13 +30,13 @@ program gabls_igrid 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%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_xy%init(inputfile, igp) !<-- Budget class initialization call budg_tavg%init(inputfile, igp) !<-- Budget class initialization call tic() @@ -45,11 +45,11 @@ program gabls_igrid 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_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_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) From 69ee72849d10504c24156005a9755abea63ee6f7 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 3 Dec 2025 18:43:45 +0000 Subject: [PATCH 010/114] initialize domain in gablsdyn from 1D vertical profiles --- .../gablsdyn_igrid_files/initialize.F90 | 103 +++++++++++++----- 1 file changed, 75 insertions(+), 28 deletions(-) diff --git a/problems/incompressible/gablsdyn_igrid_files/initialize.F90 b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 index 327826fd..038ae917 100644 --- a/problems/incompressible/gablsdyn_igrid_files/initialize.F90 +++ b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 @@ -2,7 +2,7 @@ module gabls_igrid_parameters ! TAKE CARE OF TIME NON-DIMENSIONALIZATION IN THIS MODULE - use exits, only: message + use exits, only: message, GracefulExit use kind_parameters, only: rkind use constants, only: zero, kappa, pi implicit none @@ -62,7 +62,7 @@ subroutine compute_xdim_udim(inputfile) subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) use gabls_igrid_parameters - use kind_parameters, only: rkind + use kind_parameters, only: rkind, clen use constants, only: zero, one, two, pi, half use gridtools, only: alloc_buffs use random, only: gaussian_random @@ -77,19 +77,27 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) 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(:,:,:), pointer :: u, v, w, wC, T, x, y, z, trgt real(rkind), dimension(:,:,:), allocatable :: ybuffC, ybuffE, zbuffC, zbuffE integer :: nz, nzE, k real(rkind) :: sig real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z0init = 1.d-4, frameAngle = -26.d0, z_Tref = zero, T_inv = zero, dTdz = zero real(rkind), dimension(:,:,:), allocatable :: randArr, Tpurt, eta + real(rkind), dimension(:), allocatable :: buffer1d + logical :: file_init = .false. + character(len=clen), target :: ufile, vfile, wfile, tfile + integer :: i, j + character(len=clen), pointer :: pfile + integer :: ios + real(rkind) :: dummy, prof - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz - + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz, file_init + namelist /INITIALIZE/ ufile, vfile, wfile, tfile + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) - close(ioUnit) + close(ioUnit) !!!!!!!!!!!!!!!!!!!!! DON'T CHANGE THE POINTERS / ALLOCATIONS !!!!!!!!!!!!!!!!!!!!!! @@ -100,22 +108,61 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) !allocate(randArr(size(T,1),size(T,2),size(T,3))) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if(file_init)then + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') + read(unit=ioUnit, NML=INITIALIZE) + close(ioUnit) + + allocate(buffer1d(decompC%zsz(3)+1)) ! Equal to number of edges + call message(0, 'Allocated 1D buffer to', decompC%zsz(3)+1) + + do k=1,4 + if(k==1)then + trgt => u + pfile => ufile + elseif(k==2)then + trgt => v + pfile => vfile + elseif(k==3)then + trgt => wC + pfile => wfile + elseif(k==4)then + trgt => T + pfile => tfile + end if + + ! Open file for reading + call message(0, 'Reading from '//trim(pfile)) + open(newunit=ioUnit, file=trim(pfile), status='old', action='read', iostat=ios) + if (ios /= 0) call GracefulExit('Cannot open '//trim(pfile), 288) + read(ioUnit, *, iostat=ios) ! Skip header + do i = 1, decompC%zsz(3)+1 + read(ioUnit, *, iostat=ios) dummy, prof + if (ios /= 0) call GracefulExit('Not enough entries in '//trim(pfile), 288) + buffer1d(i) = prof + end do + close(ioUnit) - u = one - v = zero - wC = zero - ! Added to account for frame angle - !u = u * cos(frameAngle * pi / 180.d0) - !v = v * sin(frameAngle * pi / 180.d0) - - allocate(Tpurt(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) + do i=1,size(trgt,1) + do j=1,size(trgt,2) + trgt(i,j,:) = half*(buffer1d(1:nz-1) + buffer1d(2:nz)) + end do + end do + end do + deallocate(buffer1d) + + else + u = one + v = zero + wC = zero + T = dTdz*(z - z_Tref) + Tsurf0 + T_inv + where(z < z_Tref) + T = Tsurf0 + end where + end if - T = dTdz*(z - z_Tref) + Tsurf0 + T_inv - where(z < z_Tref) - T = Tsurf0 - end where - ! Add random numbers + allocate(Tpurt(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) 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) @@ -152,7 +199,6 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) call message(0,"Velocity Field Initialized") !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - end subroutine subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) @@ -164,7 +210,8 @@ subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) real(rkind), intent(out) :: wTh_surf integer :: ioUnit real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, z0init = 1.d-4, dTsurf_dt, z_Tref, T_inv, dTdz - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, z_Tref, T_inv, dTdz + logical :: file_init = .false. + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, z_Tref, T_inv, dTdz, file_init ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -183,7 +230,8 @@ subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) character(len=*), intent(in) :: inputfile integer :: ioUnit real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, z0init = 1.d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz + logical :: file_init = .false. + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz, file_init ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -254,9 +302,10 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) 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, z0init = 1.d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz + logical :: file_init = .false. !real(rkind) :: beta, sigma, phi_ref !integer :: z_ref - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz, file_init ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -304,11 +353,9 @@ subroutine set_Reference_Temperature(inputfile, Thetaref) real(rkind), intent(out) :: Thetaref integer :: ioUnit real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z0init = 2.5d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz - !real(rkind) :: beta, sigma, phi_ref - !integer :: z_ref - !namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle!, beta, sigma, phi_ref, z_ref - + logical :: file_init = .false. + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz, file_init + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) From b3d1180f4572f4b30d7801fb8dca0a365ea95798 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 10 Dec 2025 20:19:14 +0000 Subject: [PATCH 011/114] put def of namelist in tile prog before keys def - to work with GNU --- problems/incompressible/tile_fields.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) 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 From d54bcac6c5bfd1264d774dbb81f24dd68a8f2ab9 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 10 Dec 2025 20:23:13 +0000 Subject: [PATCH 012/114] roll back to original initialize.F90 in gablsdyn --- .../gablsdyn_igrid_files/initialize.F90 | 105 +++++------------- 1 file changed, 29 insertions(+), 76 deletions(-) diff --git a/problems/incompressible/gablsdyn_igrid_files/initialize.F90 b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 index 038ae917..2ce2af55 100644 --- a/problems/incompressible/gablsdyn_igrid_files/initialize.F90 +++ b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 @@ -2,7 +2,7 @@ module gabls_igrid_parameters ! TAKE CARE OF TIME NON-DIMENSIONALIZATION IN THIS MODULE - use exits, only: message, GracefulExit + use exits, only: message use kind_parameters, only: rkind use constants, only: zero, kappa, pi implicit none @@ -62,7 +62,7 @@ subroutine compute_xdim_udim(inputfile) subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) use gabls_igrid_parameters - use kind_parameters, only: rkind, clen + use kind_parameters, only: rkind use constants, only: zero, one, two, pi, half use gridtools, only: alloc_buffs use random, only: gaussian_random @@ -77,27 +77,19 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) 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, trgt + 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 real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z0init = 1.d-4, frameAngle = -26.d0, z_Tref = zero, T_inv = zero, dTdz = zero real(rkind), dimension(:,:,:), allocatable :: randArr, Tpurt, eta - real(rkind), dimension(:), allocatable :: buffer1d - logical :: file_init = .false. - character(len=clen), target :: ufile, vfile, wfile, tfile - integer :: i, j - character(len=clen), pointer :: pfile - integer :: ios - real(rkind) :: dummy, prof - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz, file_init - namelist /INITIALIZE/ ufile, vfile, wfile, tfile - + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) - close(ioUnit) + close(ioUnit) !!!!!!!!!!!!!!!!!!!!! DON'T CHANGE THE POINTERS / ALLOCATIONS !!!!!!!!!!!!!!!!!!!!!! @@ -108,61 +100,22 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) !allocate(randArr(size(T,1),size(T,2),size(T,3))) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - if(file_init)then - open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') - read(unit=ioUnit, NML=INITIALIZE) - close(ioUnit) - - allocate(buffer1d(decompC%zsz(3)+1)) ! Equal to number of edges - call message(0, 'Allocated 1D buffer to', decompC%zsz(3)+1) - - do k=1,4 - if(k==1)then - trgt => u - pfile => ufile - elseif(k==2)then - trgt => v - pfile => vfile - elseif(k==3)then - trgt => wC - pfile => wfile - elseif(k==4)then - trgt => T - pfile => tfile - end if - - ! Open file for reading - call message(0, 'Reading from '//trim(pfile)) - open(newunit=ioUnit, file=trim(pfile), status='old', action='read', iostat=ios) - if (ios /= 0) call GracefulExit('Cannot open '//trim(pfile), 288) - read(ioUnit, *, iostat=ios) ! Skip header - do i = 1, decompC%zsz(3)+1 - read(ioUnit, *, iostat=ios) dummy, prof - if (ios /= 0) call GracefulExit('Not enough entries in '//trim(pfile), 288) - buffer1d(i) = prof - end do - close(ioUnit) - do i=1,size(trgt,1) - do j=1,size(trgt,2) - trgt(i,j,:) = half*(buffer1d(1:nz-1) + buffer1d(2:nz)) - end do - end do - end do - deallocate(buffer1d) - - else - u = one - v = zero - wC = zero - T = dTdz*(z - z_Tref) + Tsurf0 + T_inv - where(z < z_Tref) - T = Tsurf0 - end where - end if + u = one + v = zero + wC = zero + ! Added to account for frame angle + !u = u * cos(frameAngle * pi / 180.d0) + !v = v * sin(frameAngle * pi / 180.d0) - ! Add random numbers allocate(Tpurt(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) + + 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) @@ -199,6 +152,7 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) call message(0,"Velocity Field Initialized") !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + end subroutine subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) @@ -210,8 +164,7 @@ subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) real(rkind), intent(out) :: wTh_surf integer :: ioUnit real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, z0init = 1.d-4, dTsurf_dt, z_Tref, T_inv, dTdz - logical :: file_init = .false. - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, z_Tref, T_inv, dTdz, file_init + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, z_Tref, T_inv, dTdz ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -230,8 +183,7 @@ subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) character(len=*), intent(in) :: inputfile integer :: ioUnit real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, z0init = 1.d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz - logical :: file_init = .false. - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz, file_init + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -302,10 +254,9 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) 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, z0init = 1.d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz - logical :: file_init = .false. !real(rkind) :: beta, sigma, phi_ref !integer :: z_ref - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz, file_init + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -353,9 +304,11 @@ subroutine set_Reference_Temperature(inputfile, Thetaref) real(rkind), intent(out) :: Thetaref integer :: ioUnit real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z0init = 2.5d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz - logical :: file_init = .false. - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz, file_init - + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz + !real(rkind) :: beta, sigma, phi_ref + !integer :: z_ref + !namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle!, beta, sigma, phi_ref, z_ref + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) @@ -399,4 +352,4 @@ subroutine setScalar_source(decompC, inpDirectory, mesh, scalar_id, scalarSource real(rkind), dimension(:,:,:), intent(out) :: scalarSource scalarSource = 0.d0 -end subroutine +end subroutine \ No newline at end of file From b7e76278cabbe3a001960fa1b92c2c6b7b8dbfef Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sat, 27 Dec 2025 18:48:17 -0500 Subject: [PATCH 013/114] fix fringe association for w --- problems/incompressible/diurnal_concurrent.F90 | 2 +- problems/turbines/stable_pbl_concurrent.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) 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/turbines/stable_pbl_concurrent.F90 b/problems/turbines/stable_pbl_concurrent.F90 index 873ecb13..e95d515f 100644 --- a/problems/turbines/stable_pbl_concurrent.F90 +++ b/problems/turbines/stable_pbl_concurrent.F90 @@ -49,7 +49,7 @@ program stable_pbl_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) call primary%fringe_x%associateFringeTarget_scalar(precursor%T) end if From 7dfc51aab8319746699ca1a41cd5139bfc59b893 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 28 Jan 2026 22:30:19 -0500 Subject: [PATCH 014/114] Add compact set of deficit budgets --- .../turbines/pre_conc_compact_budgets.F90 | 146 ++ .../initialize.F90 | 347 ++++ .../temporalHook.F90 | 84 + .../budget_time_avg_deficit_compact.F90 | 1583 +++++++++++++++++ 4 files changed, 2160 insertions(+) create mode 100644 problems/turbines/pre_conc_compact_budgets.F90 create mode 100644 problems/turbines/pre_conc_compact_budgets_files/initialize.F90 create mode 100644 problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 create mode 100644 src/incompressible/budget_time_avg_deficit_compact.F90 diff --git a/problems/turbines/pre_conc_compact_budgets.F90 b/problems/turbines/pre_conc_compact_budgets.F90 new file mode 100644 index 00000000..1bdff60b --- /dev/null +++ b/problems/turbines/pre_conc_compact_budgets.F90 @@ -0,0 +1,146 @@ +! 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_mod, only: budgets_time_avg_deficit + 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) :: budg_tavg, pre_budg_tavg + !type(budgets_time_avg_deficit) :: budg_tavg_deficit + 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 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) + call budg_tavg_deficit_compact%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() + 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 budg_tavg%destroy() !<-- release memory taken by the budget classes + call pre_budg_tavg%destroy() + !if (do_deficit_budgets) call budg_tavg_deficit%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..fe6c4b6d --- /dev/null +++ b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 @@ -0,0 +1,347 @@ +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, 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 pre_conc_compact_budgets_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 pre_conc_compact_budgets_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/pre_conc_compact_budgets_files/temporalHook.F90 b/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 new file mode 100644 index 00000000..de9f0e46 --- /dev/null +++ b/problems/turbines/pre_conc_compact_budgets_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/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 new file mode 100644 index 00000000..c769cd55 --- /dev/null +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -0,0 +1,1583 @@ +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 + use mpi + + 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. + logical :: write_budget0=.false., write_budget1=.false., write_budget2=.false., write_budget3=.false. + + type(budgets_time_avg), pointer :: pre_budget, prim_budget + + 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 + 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 :: getProductOfMeans + procedure, private :: writeTimeSum + procedure, private :: readTimeSum + + procedure, private :: ddx_R2R + procedure, private :: ddy_R2R + procedure, private :: ddz_R2R + procedure, private :: ddz_C2R + procedure, private :: interp_Edge2Cell + procedure, private :: interp_Cell2Edge + procedure, private :: multiply_CellFieldsOnEdges + procedure, private :: multiply_edges_interp_cell + end type + + contains + + subroutine init(this, pre_budget, primary_inputfile, prim_budget) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + character(len=*), intent(in) :: primary_inputfile + type(budgets_time_avg), intent(inout), target :: pre_budget, prim_budget + 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 :: write_budget0=.false., write_budget1=.false., write_budget2=.false., write_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, & + write_budget0, write_budget1, write_budget2, write_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_budget => prim_budget + this%run_id = this%prim_budget%igrid_sim%runid + this%nx = this%prim_budget%igrid_sim%gpC%xsz(1) + this%ny = this%prim_budget%igrid_sim%gpC%xsz(2) + this%nz = this%prim_budget%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_budget%igrid_sim%useWindTurbines + this%isStratified = this%prim_budget%igrid_sim%isStratified + this%useCoriolis = this%prim_budget%igrid_sim%useCoriolis + this%time_weighted_average = use_time_weighted_average + this%forceDump = .false. + this%write_budget0 = write_budget0 + this%write_budget1 = write_budget1 + this%write_budget2 = write_budget2 + this%write_budget3 = write_budget3 + + if(write_budget0)this%do_budget0=.true. + if(write_budget1)this%do_budget1=.true. + if(write_budget2)this%do_budget2=.true. + if(write_budget3)this%do_budget3=.true. + + 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 + 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 = 12 + 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 = 19 + else + this%size_budget_3 = 17 + 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 ((trim(budgets_dir) .eq. "null") .or.(trim(budgets_dir) .eq. "NULL")) then + this%budgets_dir = this%prim_budget%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 + 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_budget%igrid_sim%tsim > this%prim_budget%igrid_sim%tstop) then + this%forceDump = .TRUE. + endif + + if (this%do_budgets) then + if( ( (this%tidx_budget_start>0) .and. (this%prim_budget%igrid_sim%step>this%tidx_budget_start) ) .or. & + ( (this%time_budget_start>0) .and. (this%prim_budget%igrid_sim%tsim>this%time_budget_start) ) ) then + + if (mod(this%prim_budget%igrid_sim%step,this%tidx_compute) .eq. 0) then + call this%updateBudget() + end if + + if ((mod(this%prim_budget%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_budget%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_budget%igrid_sim%sgsmodel%populate_tauij_E_to_C() + + ! To be multiplied by every term added to the sum + if(this%time_weighted_average)then + this%weight = this%prim_budget%igrid_sim%dt + else + this%weight = real(1., rkind) + end if + + 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 + this%timeSum = this%timeSum + this%prim_budget%igrid_sim%dt + 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 :: writeBudget + + if(this%time_weighted_average)then + totalWeight = this%timeSum + 1.d-18 + call this%writeTimeSum() + else + totalWeight = real(this%counter,rkind) + 1.d-18 + end if + + ! Cell x-pencil buffers + ! Buffers 1 and 2 are used locally inside getProductOfMeans + buffer => this%prim_budget%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 + 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%write_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 + + do budgetid=1,3 + select case(budgetid) + case(1) + budget => this%budget_1 + budgetsize = this%size_budget_1 + writeBudget = this%write_budget1 + case(2) + budget => this%budget_2 + budgetsize = this%size_budget_2 + writeBudget = this%write_budget2 + case(3) + budget => this%budget_3 + budgetsize = this%size_budget_3 + writeBudget = this%write_budget3 + end select + + if(writeBudget)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 + 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 + this%pre_budget%budget_0 = this%pre_budget%budget_0*totalWeight + this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight + 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_budget%igrid_sim%cbuffyE(:,:,:,1) + cbuffyC1 => this%prim_budget%igrid_sim%cbuffyC(:,:,:,2) ! 1 is used in ddx, ddy, ddz routines + rbuffxE1 => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) + rbuffxC1 => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) + rbuffxC2 => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) + + ! STEP 1: Compute mean Delta U, Delta V, and Delta W + this%budget_0(:,:,:,1) = this%budget_0(:,:,:,1) + this%weight*(this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u) + this%budget_0(:,:,:,2) = this%budget_0(:,:,:,2) + this%weight*(this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v) + this%budget_0(:,:,:,3) = this%budget_0(:,:,:,3) + this%weight*(this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC) + + ! STEP 2: Pressure + this%budget_0(:,:,:,4) = this%budget_0(:,:,:,4) + this%weight*(this%prim_budget%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%weight*(this%prim_budget%igrid_sim%T - this%pre_budget%igrid_sim%T) + + cbuffyE1 = this%prim_budget%wb - this%pre_budget%wb + call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, rbuffxC1) + this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) + this%weight*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%weight*(this%prim_budget%igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij) + + ! Step 5: SGS stress gradients + ! Reverse signs of usgs, vsgs, wsgs + cbuffyC1 = this%pre_budget%usgs - this%prim_budget%usgs + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,12) = this%budget_0(:,:,:,12) + this%weight*rbuffxC1 + + cbuffyC1 = this%pre_budget%vsgs - this%prim_budget%vsgs + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,13) = this%budget_0(:,:,:,13) + this%weight*rbuffxC1 + + cbuffyE1 = this%pre_budget%wsgs - this%prim_budget%wsgs + call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, rbuffxC1) + this%budget_0(:,:,:,14) = this%budget_0(:,:,:,14) + this%weight*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) + this%weight*rbuffxC1 + this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) + this%weight*rbuffxC2 + + call this%prim_budget%igrid_sim%get_geostrophic_forcing(rbuffxC1, rbuffxC2) + this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) - this%weight*rbuffxC1 + this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) - this%weight*rbuffxC2 + + ! Coriolis term, X + cbuffyC1 = this%prim_budget%ucor - this%pre_budget%ucor + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) + this%weight*rbuffxC1 + + ! Coriolis term, Y + cbuffyC1 = this%prim_budget%vcor - this%pre_budget%vcor + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) + this%weight*rbuffxC1 + end if + + ! Step 7: Pressure gradient force + ! px sign is reversed + cbuffyC1 = this%pre_budget%px - this%prim_budget%px + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) + this%weight*rbuffxC1 + + ! py sign is reversed + cbuffyC1 = this%pre_budget%py - this%prim_budget%py + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) + this%weight*rbuffxC1 + + ! pz sign is reversed + cbuffyE1 = this%pre_budget%pz - this%prim_budget%pz + call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, rbuffxC1) + this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) + this%weight*rbuffxC1 + + ! Step 8: turbine forcing + if(this%useWindTurbines)then + cbuffyC1 = this%prim_budget%uturb - this%pre_budget%uturb + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,21) = this%budget_0(:,:,:,21) + this%weight*rbuffxC1 + + cbuffyC1 = this%prim_budget%vturb - this%pre_budget%vturb + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + this%budget_0(:,:,:,22) = this%budget_0(:,:,:,22) + this%weight*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 + + ! Cell x-pencil buffers + du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) + dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) + dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) + buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + + ! Edge x-pencil buffers (only 2 are allocated in igrid.F90) + duE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) + dvE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,2) + dwE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,1) + + ! Perturbation fields + du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u + dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v + dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC + + duE = this%prim_budget%igrid_sim%uE - this%pre_budget%igrid_sim%uE + dvE = this%prim_budget%igrid_sim%vE - this%pre_budget%igrid_sim%vE + dwE = this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w + + ! Reynolds stresses + this%budget_1(:,:,:,1) = this%budget_1(:,:,:,1) + this%weight * du * du + this%budget_1(:,:,:,2) = this%budget_1(:,:,:,2) + this%weight * du * dv + buffer = this%multiply_Edges_interp_cell(duE, dwE) + this%budget_1(:,:,:,3) = this%budget_1(:,:,:,3) + this%weight * buffer + this%budget_1(:,:,:,4) = this%budget_1(:,:,:,4) + this%weight * dv * dv + buffer = this%multiply_Edges_interp_cell(dvE, dwE) + this%budget_1(:,:,:,5) = this%budget_1(:,:,:,5) + this%weight * buffer + this%budget_1(:,:,:,6) = this%budget_1(:,:,:,6) + this%weight * dw * dw + + ! Mixed Reynolds stresses + this%budget_1(:,:,:,7) = this%budget_1(:,:,:,7) + this%weight * du * this%pre_budget%igrid_sim%u + this%budget_1(:,:,:,8) = this%budget_1(:,:,:,8) + this%weight * du * this%pre_budget%igrid_sim%v + this%budget_1(:,:,:,9) = this%budget_1(:,:,:,9) + this%weight * dv * this%pre_budget%igrid_sim%u + buffer = this%multiply_Edges_interp_cell(duE, this%pre_budget%igrid_sim%w) + this%budget_1(:,:,:,10) = this%budget_1(:,:,:,10) + this%weight * buffer + buffer = this%multiply_Edges_interp_cell(dwE, this%pre_budget%igrid_sim%uE) + this%budget_1(:,:,:,11) = this%budget_1(:,:,:,11) + this%weight * buffer + this%budget_1(:,:,:,12) = this%budget_1(:,:,:,12) + this%weight * dv * this%pre_budget%igrid_sim%v + buffer = this%multiply_Edges_interp_cell(dvE, this%pre_budget%igrid_sim%w) + this%budget_1(:,:,:,13) = this%budget_1(:,:,:,13) + this%weight * buffer + buffer = this%multiply_Edges_interp_cell(dwE, this%pre_budget%igrid_sim%vE) + this%budget_1(:,:,:,14) = this%budget_1(:,:,:,14) + this%weight * buffer + this%budget_1(:,:,:,15) = this%budget_1(:,:,:,15) + this%weight * dw * this%pre_budget%igrid_sim%wC + + nullify(du, dv, dw, duE, dvE, dwE, buffer) + end subroutine + + ! ---------------------- Budget 2 ------------------------ + subroutine AssembleBudget2(this) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + real(rkind), dimension(:,:,:), pointer :: du, dv, dw, buffer + + ! Cell x-pencil buffers + du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) + dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) + dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) + buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + + ! Perturbation fields + du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u + dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v + dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC + + call this%ddx_R2R(du, buffer) + this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + this%weight * du * buffer + this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%weight * this%pre_budget%igrid_sim%u * buffer + + call this%ddy_R2R(du, buffer) + this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + this%weight * dv * buffer + this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%weight * this%pre_budget%igrid_sim%v * buffer + + call this%ddz_R2R(du, buffer) + this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + this%weight * dw * buffer + this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%weight * this%pre_budget%igrid_sim%wC * buffer + + call this%ddx_R2R(dv, buffer) + this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + this%weight * du * buffer + this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%weight * this%pre_budget%igrid_sim%u * buffer + + call this%ddy_R2R(dv, buffer) + this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + this%weight * dv * buffer + this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%weight * this%pre_budget%igrid_sim%v * buffer + + call this%ddz_R2R(dv, buffer) + this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + this%weight * dw * buffer + this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%weight * this%pre_budget%igrid_sim%wC * buffer + + call this%ddx_R2R(dw, buffer) + this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + this%weight * du * buffer + this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%weight * this%pre_budget%igrid_sim%u * buffer + + call this%ddy_R2R(dw, buffer) + this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + this%weight * dv * buffer + this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%weight * this%pre_budget%igrid_sim%v * buffer + + call this%ddz_R2R(dw, buffer) + this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + this%weight * dw * buffer + this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%weight * this%pre_budget%igrid_sim%wC * buffer + + call this%ddx_R2R(this%pre_budget%igrid_sim%u, buffer) + this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + this%weight * du * buffer + this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%weight * this%pre_budget%igrid_sim%u * buffer + + call this%ddy_R2R(this%pre_budget%igrid_sim%u, buffer) + this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + this%weight * dv * buffer + this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%weight * this%pre_budget%igrid_sim%v * buffer + + call this%ddz_R2R(this%pre_budget%igrid_sim%u, buffer) + this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + this%weight * dw * buffer + this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%weight * this%pre_budget%igrid_sim%wC * buffer + + call this%ddx_R2R(this%pre_budget%igrid_sim%v, buffer) + this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + this%weight * du * buffer + this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%weight * this%pre_budget%igrid_sim%u * buffer + + call this%ddy_R2R(this%pre_budget%igrid_sim%v, buffer) + this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + this%weight * dv * buffer + this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%weight * this%pre_budget%igrid_sim%v * buffer + + call this%ddz_R2R(this%pre_budget%igrid_sim%v, buffer) + this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + this%weight * dw * buffer + this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%weight * this%pre_budget%igrid_sim%wC * buffer + + call this%ddx_R2R(this%pre_budget%igrid_sim%wC, buffer) + this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + this%weight * du * buffer + this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%weight * this%pre_budget%igrid_sim%u * buffer + + call this%ddy_R2R(this%pre_budget%igrid_sim%wC, buffer) + this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + this%weight * dv * buffer + this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%weight * this%pre_budget%igrid_sim%v * buffer + + call this%ddz_R2R(this%pre_budget%igrid_sim%wC, buffer) + this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + this%weight * dw * buffer + this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%weight * this%pre_budget%igrid_sim%wC * buffer + + nullify(du, dv, dw, buffer) + 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, wcbase + real(rkind), dimension(:,:,:), pointer :: rbuffxE1, buffer, bf + complex(rkind), dimension(:,:,:), pointer :: cbuffyE1, cbuffyC1 + + ! Cell x-pencil buffers + du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) + dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) + dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) + + buffer => this%pre_budget%igrid_sim%rbuffxC(:,:,:,1) + bf => this%pre_budget%igrid_sim%rbuffxC(:,:,:,2) + + ! Cell y-pencil buffer + cbuffyC1 => this%prim_budget%igrid_sim%cbuffyC(:,:,:,2) + + ! Edge x-pencil buffer + rbuffxE1 => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) + + ! Edge y-pencil buffer + cbuffyE1 => this%prim_budget%igrid_sim%cbuffyE(:,:,:,1) + + ! Perturbation fields + du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u + dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v + dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC + this%delta_tauij = this%prim_budget%igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij + + ubase => this%pre_budget%igrid_sim%u + vbase => this%pre_budget%igrid_sim%v + wcbase => this%pre_budget%igrid_sim%wC + + ! 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%prim_budget%px + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) + this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ this%weight * bf * du + this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ this%weight * bf * ubase + + cbuffyC1 = this%pre_budget%py - this%prim_budget%py + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) + this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ this%weight * bf * dv + this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ this%weight * bf * vbase + + cbuffyE1 = this%pre_budget%pz - this%prim_budget%pz + call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, bf) + this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ this%weight * bf * dw + this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ this%weight * bf * wcbase + + ! 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, bf) + this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- this%weight * bf * du + + call this%pre_budget%igrid_sim%spectC%ifft(this%pre_budget%py, bf) + this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- this%weight * bf * dv + + call this%pre_budget%igrid_sim%spectE%ifft(this%pre_budget%pz, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, bf) + this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- this%weight * bf * 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%prim_budget%usgs + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + this%weight * bf * ubase + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + this%weight * bf * du + + cbuffyC1 = this%pre_budget%vsgs - this%prim_budget%vsgs + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + this%weight * bf * vbase + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + this%weight * bf * dv + + cbuffyE1 = this%pre_budget%wsgs - this%prim_budget%wsgs + call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, bf) + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + this%weight * bf * wcbase + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + this%weight * bf * dw + + ! The remaining of B3(4) is exactly B3(7). Calculation is done once + ! Term 7: delta tau_ij' d_j(base u_i') [SGS dissipation] + ! Term 13: d_j(delta u_j' base u_i' base u_i')/2 [Turbulent transport of TKE] + ! Term 14: d_j(base u_j' base u_i' delta u_i') [Turbulent transport of TKE] + ! Term 15: d_j(delta u_j' base u_i' delta u_i') [Turbulent transport of TKE] + call this%ddx_R2R(ubase,bf) + buffer = this%weight * bf * this%delta_tauij(:,:,:,1) ! i=1, j=1 + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + buffer = this%weight * bf * du * ubase + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + buffer + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + buffer + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * du * du + + call this%ddy_R2R(ubase,bf) + buffer = this%weight * bf * this%delta_tauij(:,:,:,2) ! i=1, j=2 + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * dv * ubase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * vbase * du + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dv * du + + call this%ddz_R2R(ubase,bf) + buffer = this%weight * bf * this%delta_tauij(:,:,:,3) ! i=1, j=3 + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * dw * ubase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * wcbase * du + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dw * du + + call this%ddx_R2R(vbase,bf) + buffer = this%weight * bf * this%delta_tauij(:,:,:,2) ! i=2, j=1 + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * du * vbase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * ubase * dv + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * du * dv + + call this%ddy_R2R(vbase,bf) + buffer = this%weight * bf * this%delta_tauij(:,:,:,4) ! i=2, j=2 + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + buffer = this%weight * bf * dv * vbase + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + buffer + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + buffer + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dv * dv + + call this%ddz_R2R(vbase,bf) + buffer = this%weight * bf * this%delta_tauij(:,:,:,5) ! i=2, j=3 + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * dw * vbase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * wcbase * dv + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dw * dv + + call this%ddx_R2R(wcbase,bf) + buffer = this%weight * bf * this%delta_tauij(:,:,:,3) ! i=3, j=1 + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * du * wcbase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * ubase * dw + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * du * dw + + call this%ddy_R2R(wcbase,bf) + buffer = this%weight * bf * this%delta_tauij(:,:,:,5) ! i=3, j=2 + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * dv * wcbase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * vbase * dw + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dv * dw + + call this%ddz_R2R(wcbase,bf) + buffer = this%weight * bf * this%delta_tauij(:,:,:,6) ! i=3, j=3 + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer + this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer + buffer = this%weight * bf * dw * wcbase + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + buffer + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + buffer + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dw * 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, bf) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - this%weight * bf * du + + call this%pre_budget%igrid_sim%spectC%ifft(this%pre_budget%vsgs, bf) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - this%weight * bf * dv + + call this%pre_budget%igrid_sim%spectE%ifft(this%pre_budget%wsgs, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, bf) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - this%weight * bf * dw + + ! The remaining of B3(5) is the exactly as B3(8) + ! Term 8: base tau_ij' * d_j(delta u_i') [SGS dissipation] + ! Do the rest of B3(6): d_j(delta u_i' * delta tau_ij') [SGS transport] + ! Term 9: delta tau_ij' * d_j(delta u_i') [SGS dissipation] + ! Term 14: d_j(base u_j' base u_i' delta u_i') [Turbulent transport of TKE] + ! Term 15: d_j(delta u_j' base u_i' delta u_i') [Turbulent transport of TKE] + ! Term 16: d_j(base u_j' delta u_i' delta u_i')/2 [Turbulent transport of TKE] + ! Term 17: d_j(delta u_j' delta u_i' delta u_i')/2 [Turbulent transport of TKE] + + call this%ddx_R2R(du, bf)! i=1, j=1 + buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,1) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + buffer = this%weight * bf * this%delta_tauij(:,:,:,1) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * ubase * ubase + buffer = this%weight * bf * du * ubase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ buffer + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ buffer + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * du * du + + call this%ddy_R2R(du, bf)! i=1, j=2 + buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,2) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + buffer = this%weight * bf * this%delta_tauij(:,:,:,2) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * ubase * vbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * dv * ubase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * vbase * du + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dv * du + + call this%ddz_R2R(du, bf)! i=1, j=3 + buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,3) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + buffer = this%weight * bf * this%delta_tauij(:,:,:,3) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * ubase * wcbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * dw * ubase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * wcbase * du + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dw * du + + call this%ddx_R2R(dv, bf)! i=2, j=1 + buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,2) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + buffer = this%weight * bf * this%delta_tauij(:,:,:,2) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * vbase * ubase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * du * vbase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * ubase * dv + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * du * dv + + call this%ddy_R2R(dv, bf)! i=2, j=2 + buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,4) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + buffer = this%weight * bf * this%delta_tauij(:,:,:,4) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * vbase * vbase + buffer = this%weight * bf * dv * vbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ buffer + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ buffer + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dv * dv + + call this%ddz_R2R(dv, bf)! i=2, j=3 + buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,5) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + buffer = this%weight * bf * this%delta_tauij(:,:,:,5) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * vbase * wcbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * dw * vbase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * wcbase * dv + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dw * dv + + call this%ddx_R2R(dw, bf)! i=3, j=1 + buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,3) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + buffer = this%weight * bf * this%delta_tauij(:,:,:,3) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * wcbase * ubase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * du * wcbase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * ubase * dw + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * du * dw + + call this%ddy_R2R(dw, bf)! i=3, j=2 + buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,5) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + buffer = this%weight * bf * this%delta_tauij(:,:,:,5) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * wcbase * vbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * dv * wcbase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * vbase * dw + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dv * dw + + call this%ddz_R2R(dw, bf)! i=3, j=3 + buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,6) + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer + this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer + buffer = this%weight * bf * this%delta_tauij(:,:,:,6) + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer + this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * wcbase * wcbase + buffer = this%weight * bf * dw * wcbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ buffer + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ buffer + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dw * dw + + ! Term 10: delta u_3' delta wb' + ! Term 11: delta u_3' base wb' + ! Term 12: base u_3' delta wb' + if(this%isStratified)then + cbuffyE1 = this%prim_budget%wb - this%pre_budget%wb + call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, buffer) + this%budget_3(:,:,:,10) = this%budget_3(:,:,:,10) + this%weight * dw * buffer + this%budget_3(:,:,:,12) = this%budget_3(:,:,:,12) + this%weight * wcbase * buffer + + call this%pre_budget%igrid_sim%spectE%ifft(this%pre_budget%wb, rbuffxE1) + call this%interp_Edge2Cell(rbuffxE1, buffer) + this%budget_3(:,:,:,11) = this%budget_3(:,:,:,11) + this%weight * dw * buffer + end if + + if (this%useWindTurbines)then + cbuffyC1 = this%prim_budget%uturb - this%pre_budget%uturb + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) + this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + this%weight * du * buffer + this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + this%weight * ubase * buffer + + cbuffyC1 = this%prim_budget%vturb - this%pre_budget%vturb + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) + this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + this%weight * dv * buffer + this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + this%weight * vbase * buffer + end if + + nullify(du, dv, dw, rbuffxE1, buffer, bf, cbuffyE1, cbuffyC1, ubase, vbase, wcbase) + 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_budget%igrid_sim%rbuffxC(:,:,:,1) + bf2 => this%prim_budget%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) + call this%ddx_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) + call this%ddy_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) + call this%ddz_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + case(2) + call this%ddx_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) + call this%ddy_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) + call this%ddz_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + case(3) + call this%ddx_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) + call this%ddy_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) + call this%ddz_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + case(4) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + case(5) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + case(6) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + case(7) + call this%ddx_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) + call this%ddy_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) + call this%ddz_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + case(8) + call this%ddx_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) + call this%ddy_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) + call this%ddz_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + case(9) + call this%ddx_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) + call this%ddy_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) + call this%ddz_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + case(10) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + case(11) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + case(12) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + end select + + else if(budgetid.eq.3)then + select case(idx) + case(1) ! d_j(delta u_j' delta p') + buffer = buffer + this%budget_0(:,:,:,1)*this%budget_0(:,:,:,18) + buffer = buffer + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,19) + buffer = buffer + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,20) + case(2) ! d_j(base u_j' delta p') + buffer = buffer + this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,18) + buffer = buffer + this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,19) + buffer = buffer + this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,20) + + case(3) ! d_j(delta u_j' base p') + ! px, py, pz signs are reversed in base-flow budget + buffer = buffer - this%budget_0(:,:,:,1)*this%pre_budget%budget_1(:,:,:,2) + buffer = buffer - this%budget_0(:,:,:,2)*this%pre_budget%budget_1(:,:,:,6) + buffer = buffer - this%budget_0(:,:,:,3)*this%pre_budget%budget_1(:,:,:,9) + + case(4) ! d_j(base u_i' delta tau_ij') [SGS transport] + buffer = buffer + this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,12) + buffer = buffer + this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,13) + buffer = buffer + this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,14) + + ! The rest of the term is the same as that of B3(7) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1),bf) + buffer=buffer + bf * this%budget_0(:,:,:,6) ! i=1, j=1 + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1),bf) + buffer=buffer + bf * this%budget_0(:,:,:,7) ! i=1, j=2 + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1),bf) + buffer=buffer + bf * this%budget_0(:,:,:,8) ! i=1, j=3 + + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2),bf) + buffer=buffer + bf * this%budget_0(:,:,:,7) ! i=2, j=1 + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2),bf) + buffer=buffer + bf * this%budget_0(:,:,:,9) ! i=2, j=2 + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2),bf) + buffer=buffer + bf * this%budget_0(:,:,:,10) ! i=2, j=3 + + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3),bf) + buffer=buffer + bf * this%budget_0(:,:,:,8) ! i=3, j=1 + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3),bf) + buffer=buffer + bf * this%budget_0(:,:,:,10) ! i=3, j=2 + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3),bf) + buffer=buffer + bf * this%budget_0(:,:,:,11) ! i=3, j=3 + + 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 = buffer - this%budget_0(:,:,:,1)*this%pre_budget%budget_1(:,:,:,3) + buffer = buffer - this%budget_0(:,:,:,2)*this%pre_budget%budget_1(:,:,:,7) + buffer = buffer - this%budget_0(:,:,:,3)*this%pre_budget%budget_1(:,:,:,10) + + ! The rest of this term is the same as B3(8) + call this%ddx_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,11) ! i=1, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,12) ! i=1, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,13) ! i=1, j=3 + + call this%ddx_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,12) ! i=2, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,14) ! i=2, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,15) ! i=2, j=3 + + call this%ddx_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,13) ! i=3, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,15) ! i=3, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,16) ! i=3, j=3 + + case(6) ! d_j(delta u_i' * delta tau_ij') [SGS transport] + buffer = buffer + this%budget_0(:,:,:,1)*this%budget_0(:,:,:,12) + buffer = buffer + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,13) + buffer = buffer + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,14) + + ! The rest of this term is the same as B3(9) + call this%ddx_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%budget_0(:,:,:,6) ! i=1, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%budget_0(:,:,:,7) ! i=1, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%budget_0(:,:,:,8) ! i=1, j=3 + + call this%ddx_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%budget_0(:,:,:,7) ! i=2, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%budget_0(:,:,:,9) ! i=2, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%budget_0(:,:,:,10) ! i=2, j=3 + + call this%ddx_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%budget_0(:,:,:,8) ! i=3, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%budget_0(:,:,:,10) ! i=3, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%budget_0(:,:,:,11) ! i=3, j=3 + + case(7) ! delta tau_ij' * d_j(base u_i') [SGS dissipation] + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1),bf) + buffer=buffer + bf * this%budget_0(:,:,:,6) ! i=1, j=1 + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1),bf) + buffer=buffer + bf * this%budget_0(:,:,:,7) ! i=1, j=2 + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1),bf) + buffer=buffer + bf * this%budget_0(:,:,:,8) ! i=1, j=3 + + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2),bf) + buffer=buffer + bf * this%budget_0(:,:,:,7) ! i=2, j=1 + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2),bf) + buffer=buffer + bf * this%budget_0(:,:,:,9) ! i=2, j=2 + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2),bf) + buffer=buffer + bf * this%budget_0(:,:,:,10) ! i=2, j=3 + + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3),bf) + buffer=buffer + bf * this%budget_0(:,:,:,8) ! i=3, j=1 + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3),bf) + buffer=buffer + bf * this%budget_0(:,:,:,10) ! i=3, j=2 + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3),bf) + buffer=buffer + bf * this%budget_0(:,:,:,11) ! i=3, j=3 + + case(8) ! base tau_ij' * d_j(delta u_i') [SGS dissipation] + call this%ddx_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,11) ! i=1, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,12) ! i=1, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,13) ! i=1, j=3 + + call this%ddx_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,12) ! i=2, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,14) ! i=2, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,15) ! i=2, j=3 + + call this%ddx_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,13) ! i=3, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,15) ! i=3, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,16) ! i=3, j=3 + + case(9) ! delta tau_ij' * d_j(delta u_i') [SGS dissipation] + call this%ddx_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%budget_0(:,:,:,6) ! i=1, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%budget_0(:,:,:,7) ! i=1, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,1),bf) + buffer=buffer+bf*this%budget_0(:,:,:,8) ! i=1, j=3 + + call this%ddx_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%budget_0(:,:,:,7) ! i=2, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%budget_0(:,:,:,9) ! i=2, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,2),bf) + buffer=buffer+bf*this%budget_0(:,:,:,10) ! i=2, j=3 + + call this%ddx_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%budget_0(:,:,:,8) ! i=3, j=1 + call this%ddy_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%budget_0(:,:,:,10) ! i=3, j=2 + call this%ddz_R2R(this%budget_0(:,:,:,3),bf) + buffer=buffer+bf*this%budget_0(:,:,:,11) ! i=3, j=3 + + 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) ! d_j(delta u_j' base u_i' base u_i')/2 [Turbulent transport of TKE] + bf = 0.5d0*(this%pre_budget%budget_0(:,:,:,4) + this%pre_budget%budget_0(:,:,:,7) + this%pre_budget%budget_0(:,:,:,9)) & + - (this%pre_budget%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,1) + & + this%pre_budget%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,2) + & + this%pre_budget%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,3)) + 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); 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) + + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,7) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,9) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,11) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,8) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,12) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,14) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,10) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,13) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,15) + + case(14) ! d_j(base u_j' base u_i' delta u_i') [Turbulent transport of TKE] + bf = this%budget_1(:,:,:,7) + this%budget_1(:,:,:,12) + this%budget_1(:,:,:,15) - & + 2.d0 * (this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) + & + this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,2) + & + this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,3)) + 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 + call this%ddz_R2R(bf, bf2); buffer = buffer + this%pre_budget%budget_0(:,:,:,3)*bf2 + + buffer = buffer + this%pre_budget%budget_0(:,:,:,1)*this%budget_2(:,:,:,7) + & + this%pre_budget%budget_0(:,:,:,2)*this%budget_2(:,:,:,8) + & + this%pre_budget%budget_0(:,:,:,3)*this%budget_2(:,:,:,9) + + call this%ddx_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,4) + call this%ddy_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,5) + call this%ddz_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,6) + call this%ddx_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,5) + call this%ddy_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,7) + call this%ddz_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,8) + call this%ddx_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,6) + call this%ddy_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,8) + call this%ddz_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,9) + + 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) + + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,7) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,8) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,10) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,9) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,12) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,13) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,11) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,14) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,15) + + case(15) ! d_j(delta u_j' base u_i' delta u_i') [Turbulent transport of TKE] + bf = this%budget_1(:,:,:,7) + this%budget_1(:,:,:,12) + this%budget_1(:,:,:,15) - & + 2.d0 * (this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) + & + this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,2) + & + this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,3)) + 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); buffer = buffer + this%budget_0(:,:,:,3)*bf2 + + buffer = buffer + 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) + call this%ddx_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,7) + call this%ddy_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,9) + call this%ddz_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,11) + call this%ddx_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,8) + call this%ddy_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,12) + call this%ddz_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,14) + call this%ddx_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,10) + call this%ddy_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,13) + call this%ddz_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,15) + + buffer = buffer + this%budget_0(:,:,:,1)*this%budget_2(:,:,:,4) + & + this%budget_0(:,:,:,2)*this%budget_2(:,:,:,5) + & + this%budget_0(:,:,:,3)*this%budget_2(:,:,:,6) + + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,1) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,2) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,3) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,2) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,4) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,5) + call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,3) + call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,5) + call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,6) + + case(16) ! d_j(base u_j' delta u_i' delta u_i')/2 [Turbulent transport of TKE] + bf = 0.5d0*(this%budget_1(:,:,:,1) + this%budget_1(:,:,:,4) + this%budget_1(:,:,:,6)) & + - (this%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) + & + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,2) + & + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,3)) + 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 + call this%ddz_R2R(bf, bf2); 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) + + call this%ddx_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,7) + call this%ddy_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,8) + call this%ddz_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,10) + call this%ddx_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,9) + call this%ddy_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,12) + call this%ddz_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,13) + call this%ddx_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,11) + call this%ddy_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,14) + call this%ddz_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,15) + + case(17) ! d_j(delta u_j' delta u_i' delta u_i')/2 [Turbulent transport of TKE] + bf = 0.5d0*(this%budget_1(:,:,:,1) + this%budget_1(:,:,:,4) + this%budget_1(:,:,:,6)) & + - (this%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) + & + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,2) + & + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,3)) + 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); 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) + + call this%ddx_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,1) + call this%ddy_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,2) + call this%ddz_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,3) + call this%ddx_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,2) + call this%ddy_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,4) + call this%ddz_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,5) + call this%ddx_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,3) + call this%ddy_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,5) + call this%ddz_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,6) + + case(18) + buffer = this%budget_0(:,:,:,1)*this%budget_0(:,:,:,21) + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,22) + case(19) + 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 + 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_budget%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_budget%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_budget%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_budget%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_budget%igrid_sim%rbuffxC(:,:,:,4) + this%counter = cid + + if(this%time_weighted_average)then + ! If this is time-weighted averaging, we should read the sum of times + call this%readTimeSum(trim(dir),rid,tid,cid) + totalWeight = this%timeSum + 1.d-18 + else + totalWeight = real(this%counter,rkind) + 1.d-18 + end if + + ! 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 + + nullify(buffer) + 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 + end subroutine + + subroutine destroy(this) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + + nullify(this%prim_budget, this%pre_budget) + 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) + end if + end subroutine + + ! ----------------------private derivative operators ------------------------ + 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 + + call this%prim_budget%igrid_sim%spectC%fft(f,this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%prim_budget%igrid_sim%spectC%mtimes_ik1_ip(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdx) + 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 + + call this%prim_budget%igrid_sim%spectC%fft(f,this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%prim_budget%igrid_sim%spectC%mtimes_ik2_ip(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdy) + end subroutine + + subroutine ddz_R2R(this, f, dfdz) + 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) :: dfdz + + call this%prim_budget%igrid_sim%spectC%fft(f,this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%ddz_C2R(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdz) + end subroutine + + subroutine ddz_C2R(this, fhat, dfdz) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + complex(rkind), dimension(this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(1),this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(2),this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(3)), intent(in) :: fhat + real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: dfdz + + call transpose_y_to_z(fhat,this%prim_budget%igrid_sim%cbuffzC(:,:,:,1),this%prim_budget%igrid_sim%sp_gpC) + call this%prim_budget%igrid_sim%Pade6opZ%ddz_C2C(this%prim_budget%igrid_sim%cbuffzC(:,:,:,1),this%prim_budget%igrid_sim%cbuffzC(:,:,:,2),0,0) + call transpose_z_to_y(this%prim_budget%igrid_sim%cbuffzC(:,:,:,2),this%prim_budget%igrid_sim%cbuffyC(:,:,:,1),this%prim_budget%igrid_sim%sp_gpC) + call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdz) + end subroutine + + subroutine interp_Edge2Cell(this, fE, fC) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(in) :: fE + real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: fC + + call transpose_x_to_y(fE,this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),this%prim_budget%igrid_sim%gpE) + call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%gpE) + call this%prim_budget%igrid_sim%Pade6opZ%interpz_E2C(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,2),0,0) + call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzC(:,:,:,2),this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),fC,this%prim_budget%igrid_sim%gpC) + end subroutine + + subroutine interp_Cell2Edge(this, fC, fE) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: fC + real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(out) :: fE + + call transpose_x_to_y(fC,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),0,0) + call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),this%prim_budget%igrid_sim%gpE) + call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),fE,this%prim_budget%igrid_sim%gpE) + end subroutine + + subroutine multiply_CellFieldsOnEdges(this, f1C, f2C, fmultC) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: f1C,f2C + real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: fmultC + + ! interpolate 1st Cell field + call transpose_x_to_y(f1C,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),0,0) + + ! interpolate 2nd Cell field + call transpose_x_to_y(f2C,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,2),0,0) + + ! multiply on Edges and interpolate back to Cells + this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) = this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) * this%prim_budget%igrid_sim%rbuffzE(:,:,:,2) + call this%prim_budget%igrid_sim%Pade6opZ%interpz_E2C(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),0,0) + call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),fmultC,this%prim_budget%igrid_sim%gpC) + end subroutine + + ! multiply on edge cells and interpolate to cell centers to reduce aliasing issues + function multiply_Edges_interp_cell(this, f1E, f2E) result(fmultC) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(in) :: f1E,f2E + real(rkind), dimension(this%prim_budget%igrid_sim%gpC%xsz(1),this%prim_budget%igrid_sim%gpC%xsz(2),this%prim_budget%igrid_sim%gpC%xsz(3)) :: fmultC + + call this%interp_Edge2Cell(f1E * f2E, fmultC) + end function +end module \ No newline at end of file From d5fa5106dcfa290e005f5c6c18a9ceceb9ec2f2b Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 28 Jan 2026 22:30:47 -0500 Subject: [PATCH 015/114] Fix the sign of the mean buoyancy term --- src/incompressible/budget_time_avg.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index cb4766ad..c5ea50e6 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -625,7 +625,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) From ce6e0fab21d450d877bf35a0169a9d6413131329 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 28 Jan 2026 22:31:28 -0500 Subject: [PATCH 016/114] comment out unnesscary checks in actuator disk --- src/incompressible/actuatorDisk_CT.F90 | 6 +++--- src/incompressible/actuatorDisk_filtered.F90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/incompressible/actuatorDisk_CT.F90 b/src/incompressible/actuatorDisk_CT.F90 index 3d0175f6..26047581 100644 --- a/src/incompressible/actuatorDisk_CT.F90 +++ b/src/incompressible/actuatorDisk_CT.F90 @@ -347,9 +347,9 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals, yaw, theta) 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 8aa1fd2a..c635499c 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -376,9 +376,9 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals) 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 yaw = this%yaw * pi/180.d0 tilt = this%tilt * pi/180.d0 From e2a6314aa452c8bbbc12c1ac73951b96862eba3f Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 30 Jan 2026 15:48:42 -0500 Subject: [PATCH 017/114] move delta_tauij to updateBudget --- src/incompressible/budget_time_avg_deficit_compact.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index c769cd55..040e88bd 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -222,6 +222,7 @@ subroutine updateBudget(this) ! Interpolate SGS stresses to cells call this%pre_budget%igrid_sim%sgsmodel%populate_tauij_E_to_C() call this%prim_budget%igrid_sim%sgsmodel%populate_tauij_E_to_C() + this%delta_tauij = this%prim_budget%igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij ! To be multiplied by every term added to the sum if(this%time_weighted_average)then @@ -359,7 +360,7 @@ subroutine AssembleBudget0(this) 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%weight*(this%prim_budget%igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij) + this%budget_0(:,:,:,6:11) = this%budget_0(:,:,:,6:11) + this%weight * this%delta_tauij ! Step 5: SGS stress gradients ! Reverse signs of usgs, vsgs, wsgs @@ -602,7 +603,6 @@ subroutine AssembleBudget3(this) du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC - this%delta_tauij = this%prim_budget%igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij ubase => this%pre_budget%igrid_sim%u vbase => this%pre_budget%igrid_sim%v From 460e041fc8fb64bb2958a0f1ca1d85bba9ce2a50 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 30 Jan 2026 15:55:42 -0500 Subject: [PATCH 018/114] remove time-weighted sum because time-averaged budget are not summed in the same way --- .../budget_time_avg_deficit_compact.F90 | 460 +++++++++--------- 1 file changed, 232 insertions(+), 228 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index 040e88bd..966da501 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -57,8 +57,8 @@ module budgets_time_avg_deficit_compact_mod procedure, private :: AssembleBudget3 procedure, private :: getProductOfMeans - procedure, private :: writeTimeSum - procedure, private :: readTimeSum + ! procedure, private :: writeTimeSum + ! procedure, private :: readTimeSum procedure, private :: ddx_R2R procedure, private :: ddy_R2R @@ -110,7 +110,9 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) this%useWindTurbines = this%prim_budget%igrid_sim%useWindTurbines this%isStratified = this%prim_budget%igrid_sim%isStratified this%useCoriolis = this%prim_budget%igrid_sim%useCoriolis - this%time_weighted_average = use_time_weighted_average + ! 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%write_budget0 = write_budget0 this%write_budget1 = write_budget1 @@ -225,11 +227,11 @@ subroutine updateBudget(this) this%delta_tauij = this%prim_budget%igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij ! To be multiplied by every term added to the sum - if(this%time_weighted_average)then - this%weight = this%prim_budget%igrid_sim%dt - else - this%weight = real(1., rkind) - end if + ! if(this%time_weighted_average)then + ! this%weight = this%prim_budget%igrid_sim%dt + ! else + ! this%weight = real(1., rkind) + ! end if if(this%do_budget0) call this%AssembleBudget0() if(this%do_budget1) call this%AssembleBudget1() @@ -237,7 +239,7 @@ subroutine updateBudget(this) if(this%do_budget3) call this%AssembleBudget3() this%counter = this%counter + 1 - this%timeSum = this%timeSum + this%prim_budget%igrid_sim%dt + ! this%timeSum = this%timeSum + this%prim_budget%igrid_sim%dt end subroutine subroutine DumpBudget(this) @@ -248,12 +250,13 @@ subroutine DumpBudget(this) real(rkind), dimension(:,:,:,:), pointer :: budget logical :: writeBudget - if(this%time_weighted_average)then - totalWeight = this%timeSum + 1.d-18 - call this%writeTimeSum() - else - totalWeight = real(this%counter,rkind) + 1.d-18 - end if + ! if(this%time_weighted_average)then + ! totalWeight = this%timeSum + 1.d-18 + ! call this%writeTimeSum() + ! else + ! totalWeight = real(this%counter,rkind) + 1.d-18 + ! end if + totalWeight = real(this%counter,rkind) + 1.d-18 ! Cell x-pencil buffers ! Buffers 1 and 2 are used locally inside getProductOfMeans @@ -342,89 +345,89 @@ subroutine AssembleBudget0(this) rbuffxC2 => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) ! STEP 1: Compute mean Delta U, Delta V, and Delta W - this%budget_0(:,:,:,1) = this%budget_0(:,:,:,1) + this%weight*(this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u) - this%budget_0(:,:,:,2) = this%budget_0(:,:,:,2) + this%weight*(this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v) - this%budget_0(:,:,:,3) = this%budget_0(:,:,:,3) + this%weight*(this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC) + this%budget_0(:,:,:,1) = this%budget_0(:,:,:,1) + (this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u) + this%budget_0(:,:,:,2) = this%budget_0(:,:,:,2) + (this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v) + this%budget_0(:,:,:,3) = this%budget_0(:,:,:,3) + (this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC) ! STEP 2: Pressure - this%budget_0(:,:,:,4) = this%budget_0(:,:,:,4) + this%weight*(this%prim_budget%igrid_sim%pressure - this%pre_budget%igrid_sim%pressure) + this%budget_0(:,:,:,4) = this%budget_0(:,:,:,4) + (this%prim_budget%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%weight*(this%prim_budget%igrid_sim%T - this%pre_budget%igrid_sim%T) + this%budget_0(:,:,:,5) = this%budget_0(:,:,:,5) + (this%prim_budget%igrid_sim%T - this%pre_budget%igrid_sim%T) cbuffyE1 = this%prim_budget%wb - this%pre_budget%wb call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) call this%interp_Edge2Cell(rbuffxE1, rbuffxC1) - this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) + this%weight*rbuffxC1 + 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%weight * this%delta_tauij + 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%prim_budget%usgs call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) - this%budget_0(:,:,:,12) = this%budget_0(:,:,:,12) + this%weight*rbuffxC1 + this%budget_0(:,:,:,12) = this%budget_0(:,:,:,12) + rbuffxC1 cbuffyC1 = this%pre_budget%vsgs - this%prim_budget%vsgs call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) - this%budget_0(:,:,:,13) = this%budget_0(:,:,:,13) + this%weight*rbuffxC1 + this%budget_0(:,:,:,13) = this%budget_0(:,:,:,13) + rbuffxC1 cbuffyE1 = this%pre_budget%wsgs - this%prim_budget%wsgs call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) call this%interp_Edge2Cell(rbuffxE1, rbuffxC1) - this%budget_0(:,:,:,14) = this%budget_0(:,:,:,14) + this%weight*rbuffxC1 + 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) + this%weight*rbuffxC1 - this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) + this%weight*rbuffxC2 + this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) + rbuffxC1 + this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) + rbuffxC2 call this%prim_budget%igrid_sim%get_geostrophic_forcing(rbuffxC1, rbuffxC2) - this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) - this%weight*rbuffxC1 - this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) - this%weight*rbuffxC2 + this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) - rbuffxC1 + this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) - rbuffxC2 ! Coriolis term, X cbuffyC1 = this%prim_budget%ucor - this%pre_budget%ucor call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) - this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) + this%weight*rbuffxC1 + this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) + rbuffxC1 ! Coriolis term, Y cbuffyC1 = this%prim_budget%vcor - this%pre_budget%vcor call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) - this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) + this%weight*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%prim_budget%px call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) - this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) + this%weight*rbuffxC1 + this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) + rbuffxC1 ! py sign is reversed cbuffyC1 = this%pre_budget%py - this%prim_budget%py call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) - this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) + this%weight*rbuffxC1 + this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) + rbuffxC1 ! pz sign is reversed cbuffyE1 = this%pre_budget%pz - this%prim_budget%pz call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) call this%interp_Edge2Cell(rbuffxE1, rbuffxC1) - this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) + this%weight*rbuffxC1 + this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) + rbuffxC1 ! Step 8: turbine forcing if(this%useWindTurbines)then cbuffyC1 = this%prim_budget%uturb - this%pre_budget%uturb call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) - this%budget_0(:,:,:,21) = this%budget_0(:,:,:,21) + this%weight*rbuffxC1 + this%budget_0(:,:,:,21) = this%budget_0(:,:,:,21) + rbuffxC1 cbuffyC1 = this%prim_budget%vturb - this%pre_budget%vturb call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) - this%budget_0(:,:,:,22) = this%budget_0(:,:,:,22) + this%weight*rbuffxC1 + this%budget_0(:,:,:,22) = this%budget_0(:,:,:,22) + rbuffxC1 end if nullify(rbuffxE1, rbuffxC1, rbuffxC2, cbuffyC1, cbuffyE1) @@ -456,29 +459,29 @@ subroutine AssembleBudget1(this) dwE = this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w ! Reynolds stresses - this%budget_1(:,:,:,1) = this%budget_1(:,:,:,1) + this%weight * du * du - this%budget_1(:,:,:,2) = this%budget_1(:,:,:,2) + this%weight * du * dv + this%budget_1(:,:,:,1) = this%budget_1(:,:,:,1) + du * du + this%budget_1(:,:,:,2) = this%budget_1(:,:,:,2) + du * dv buffer = this%multiply_Edges_interp_cell(duE, dwE) - this%budget_1(:,:,:,3) = this%budget_1(:,:,:,3) + this%weight * buffer - this%budget_1(:,:,:,4) = this%budget_1(:,:,:,4) + this%weight * dv * dv + this%budget_1(:,:,:,3) = this%budget_1(:,:,:,3) + buffer + this%budget_1(:,:,:,4) = this%budget_1(:,:,:,4) + dv * dv buffer = this%multiply_Edges_interp_cell(dvE, dwE) - this%budget_1(:,:,:,5) = this%budget_1(:,:,:,5) + this%weight * buffer - this%budget_1(:,:,:,6) = this%budget_1(:,:,:,6) + this%weight * dw * dw + 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) + this%weight * du * this%pre_budget%igrid_sim%u - this%budget_1(:,:,:,8) = this%budget_1(:,:,:,8) + this%weight * du * this%pre_budget%igrid_sim%v - this%budget_1(:,:,:,9) = this%budget_1(:,:,:,9) + this%weight * dv * this%pre_budget%igrid_sim%u + 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 buffer = this%multiply_Edges_interp_cell(duE, this%pre_budget%igrid_sim%w) - this%budget_1(:,:,:,10) = this%budget_1(:,:,:,10) + this%weight * buffer + this%budget_1(:,:,:,10) = this%budget_1(:,:,:,10) + buffer buffer = this%multiply_Edges_interp_cell(dwE, this%pre_budget%igrid_sim%uE) - this%budget_1(:,:,:,11) = this%budget_1(:,:,:,11) + this%weight * buffer - this%budget_1(:,:,:,12) = this%budget_1(:,:,:,12) + this%weight * dv * this%pre_budget%igrid_sim%v + this%budget_1(:,:,:,11) = this%budget_1(:,:,:,11) + buffer + this%budget_1(:,:,:,12) = this%budget_1(:,:,:,12) + dv * this%pre_budget%igrid_sim%v buffer = this%multiply_Edges_interp_cell(dvE, this%pre_budget%igrid_sim%w) - this%budget_1(:,:,:,13) = this%budget_1(:,:,:,13) + this%weight * buffer + this%budget_1(:,:,:,13) = this%budget_1(:,:,:,13) + buffer buffer = this%multiply_Edges_interp_cell(dwE, this%pre_budget%igrid_sim%vE) - this%budget_1(:,:,:,14) = this%budget_1(:,:,:,14) + this%weight * buffer - this%budget_1(:,:,:,15) = this%budget_1(:,:,:,15) + this%weight * dw * this%pre_budget%igrid_sim%wC + 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) end subroutine @@ -500,76 +503,76 @@ subroutine AssembleBudget2(this) dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC call this%ddx_R2R(du, buffer) - this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + this%weight * du * buffer - this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%weight * this%pre_budget%igrid_sim%u * buffer + this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + du * buffer + this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%pre_budget%igrid_sim%u * buffer call this%ddy_R2R(du, buffer) - this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + this%weight * dv * buffer - this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%weight * this%pre_budget%igrid_sim%v * buffer + this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + dv * buffer + this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%pre_budget%igrid_sim%v * buffer call this%ddz_R2R(du, buffer) - this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + this%weight * dw * buffer - this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%weight * this%pre_budget%igrid_sim%wC * buffer + this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + dw * buffer + this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%pre_budget%igrid_sim%wC * buffer call this%ddx_R2R(dv, buffer) - this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + this%weight * du * buffer - this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%weight * this%pre_budget%igrid_sim%u * buffer + this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + du * buffer + this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%pre_budget%igrid_sim%u * buffer call this%ddy_R2R(dv, buffer) - this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + this%weight * dv * buffer - this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%weight * this%pre_budget%igrid_sim%v * buffer + this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + dv * buffer + this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%pre_budget%igrid_sim%v * buffer call this%ddz_R2R(dv, buffer) - this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + this%weight * dw * buffer - this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%weight * this%pre_budget%igrid_sim%wC * buffer + this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + dw * buffer + this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%pre_budget%igrid_sim%wC * buffer call this%ddx_R2R(dw, buffer) - this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + this%weight * du * buffer - this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%weight * this%pre_budget%igrid_sim%u * buffer + this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + du * buffer + this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%pre_budget%igrid_sim%u * buffer call this%ddy_R2R(dw, buffer) - this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + this%weight * dv * buffer - this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%weight * this%pre_budget%igrid_sim%v * buffer + this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + dv * buffer + this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%pre_budget%igrid_sim%v * buffer call this%ddz_R2R(dw, buffer) - this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + this%weight * dw * buffer - this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%weight * this%pre_budget%igrid_sim%wC * buffer + this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + dw * buffer + this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%pre_budget%igrid_sim%wC * buffer call this%ddx_R2R(this%pre_budget%igrid_sim%u, buffer) - this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + this%weight * du * buffer - this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%weight * this%pre_budget%igrid_sim%u * buffer + this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + du * buffer + this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%pre_budget%igrid_sim%u * buffer call this%ddy_R2R(this%pre_budget%igrid_sim%u, buffer) - this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + this%weight * dv * buffer - this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%weight * this%pre_budget%igrid_sim%v * buffer + this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + dv * buffer + this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%pre_budget%igrid_sim%v * buffer call this%ddz_R2R(this%pre_budget%igrid_sim%u, buffer) - this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + this%weight * dw * buffer - this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%weight * this%pre_budget%igrid_sim%wC * buffer + this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + dw * buffer + this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%pre_budget%igrid_sim%wC * buffer call this%ddx_R2R(this%pre_budget%igrid_sim%v, buffer) - this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + this%weight * du * buffer - this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%weight * this%pre_budget%igrid_sim%u * buffer + this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + du * buffer + this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%pre_budget%igrid_sim%u * buffer call this%ddy_R2R(this%pre_budget%igrid_sim%v, buffer) - this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + this%weight * dv * buffer - this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%weight * this%pre_budget%igrid_sim%v * buffer + this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + dv * buffer + this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%pre_budget%igrid_sim%v * buffer call this%ddz_R2R(this%pre_budget%igrid_sim%v, buffer) - this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + this%weight * dw * buffer - this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%weight * this%pre_budget%igrid_sim%wC * buffer + this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + dw * buffer + this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%pre_budget%igrid_sim%wC * buffer call this%ddx_R2R(this%pre_budget%igrid_sim%wC, buffer) - this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + this%weight * du * buffer - this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%weight * this%pre_budget%igrid_sim%u * buffer + this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + du * buffer + this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%pre_budget%igrid_sim%u * buffer call this%ddy_R2R(this%pre_budget%igrid_sim%wC, buffer) - this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + this%weight * dv * buffer - this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%weight * this%pre_budget%igrid_sim%v * buffer + this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + dv * buffer + this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%pre_budget%igrid_sim%v * buffer call this%ddz_R2R(this%pre_budget%igrid_sim%wC, buffer) - this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + this%weight * dw * buffer - this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%weight * this%pre_budget%igrid_sim%wC * buffer + this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + dw * buffer + this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%pre_budget%igrid_sim%wC * buffer nullify(du, dv, dw, buffer) end subroutine @@ -613,50 +616,50 @@ subroutine AssembleBudget3(this) ! px, py, pz signs are reversed cbuffyC1 = this%pre_budget%px - this%prim_budget%px call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) - this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ this%weight * bf * du - this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ this%weight * bf * ubase + this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ bf * du + this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ bf * ubase cbuffyC1 = this%pre_budget%py - this%prim_budget%py call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) - this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ this%weight * bf * dv - this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ this%weight * bf * vbase + this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ bf * dv + this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ bf * vbase cbuffyE1 = this%pre_budget%pz - this%prim_budget%pz call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) call this%interp_Edge2Cell(rbuffxE1, bf) - this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ this%weight * bf * dw - this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ this%weight * bf * wcbase + this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ bf * dw + this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ bf * wcbase ! 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, bf) - this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- this%weight * bf * du + this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- bf * du call this%pre_budget%igrid_sim%spectC%ifft(this%pre_budget%py, bf) - this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- this%weight * bf * dv + this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- bf * dv call this%pre_budget%igrid_sim%spectE%ifft(this%pre_budget%pz, rbuffxE1) call this%interp_Edge2Cell(rbuffxE1, bf) - this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- this%weight * bf * dw + this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- bf * 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%prim_budget%usgs call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + this%weight * bf * ubase - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + this%weight * bf * du + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + bf * ubase + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + bf * du cbuffyC1 = this%pre_budget%vsgs - this%prim_budget%vsgs call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + this%weight * bf * vbase - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + this%weight * bf * dv + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + bf * vbase + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + bf * dv cbuffyE1 = this%pre_budget%wsgs - this%prim_budget%wsgs call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) call this%interp_Edge2Cell(rbuffxE1, bf) - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + this%weight * bf * wcbase - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + this%weight * bf * dw + this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + bf * wcbase + this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + bf * dw ! The remaining of B3(4) is exactly B3(7). Calculation is done once ! Term 7: delta tau_ij' d_j(base u_i') [SGS dissipation] @@ -664,91 +667,91 @@ subroutine AssembleBudget3(this) ! Term 14: d_j(base u_j' base u_i' delta u_i') [Turbulent transport of TKE] ! Term 15: d_j(delta u_j' base u_i' delta u_i') [Turbulent transport of TKE] call this%ddx_R2R(ubase,bf) - buffer = this%weight * bf * this%delta_tauij(:,:,:,1) ! i=1, j=1 + buffer = bf * this%delta_tauij(:,:,:,1) ! i=1, j=1 this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - buffer = this%weight * bf * du * ubase + buffer = bf * du * ubase this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + buffer this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + buffer - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * du * du + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * du * du call this%ddy_R2R(ubase,bf) - buffer = this%weight * bf * this%delta_tauij(:,:,:,2) ! i=1, j=2 + buffer = bf * this%delta_tauij(:,:,:,2) ! i=1, j=2 this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * dv * ubase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * vbase * du - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dv * du + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * dv * ubase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * vbase * du + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dv * du call this%ddz_R2R(ubase,bf) - buffer = this%weight * bf * this%delta_tauij(:,:,:,3) ! i=1, j=3 + buffer = bf * this%delta_tauij(:,:,:,3) ! i=1, j=3 this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * dw * ubase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * wcbase * du - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dw * du + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * dw * ubase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * wcbase * du + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dw * du call this%ddx_R2R(vbase,bf) - buffer = this%weight * bf * this%delta_tauij(:,:,:,2) ! i=2, j=1 + buffer = bf * this%delta_tauij(:,:,:,2) ! i=2, j=1 this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * du * vbase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * ubase * dv - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * du * dv + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * du * vbase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * ubase * dv + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * du * dv call this%ddy_R2R(vbase,bf) - buffer = this%weight * bf * this%delta_tauij(:,:,:,4) ! i=2, j=2 + buffer = bf * this%delta_tauij(:,:,:,4) ! i=2, j=2 this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - buffer = this%weight * bf * dv * vbase + buffer = bf * dv * vbase this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + buffer this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + buffer - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dv * dv + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dv * dv call this%ddz_R2R(vbase,bf) - buffer = this%weight * bf * this%delta_tauij(:,:,:,5) ! i=2, j=3 + buffer = bf * this%delta_tauij(:,:,:,5) ! i=2, j=3 this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * dw * vbase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * wcbase * dv - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dw * dv + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * dw * vbase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * wcbase * dv + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dw * dv call this%ddx_R2R(wcbase,bf) - buffer = this%weight * bf * this%delta_tauij(:,:,:,3) ! i=3, j=1 + buffer = bf * this%delta_tauij(:,:,:,3) ! i=3, j=1 this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * du * wcbase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * ubase * dw - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * du * dw + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * du * wcbase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * ubase * dw + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * du * dw call this%ddy_R2R(wcbase,bf) - buffer = this%weight * bf * this%delta_tauij(:,:,:,5) ! i=3, j=2 + buffer = bf * this%delta_tauij(:,:,:,5) ! i=3, j=2 this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + this%weight * bf * dv * wcbase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + this%weight * bf * vbase * dw - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dv * dw + this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * dv * wcbase + this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * vbase * dw + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dv * dw call this%ddz_R2R(wcbase,bf) - buffer = this%weight * bf * this%delta_tauij(:,:,:,6) ! i=3, j=3 + buffer = bf * this%delta_tauij(:,:,:,6) ! i=3, j=3 this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - buffer = this%weight * bf * dw * wcbase + buffer = bf * dw * wcbase this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + buffer this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + buffer - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + this%weight * bf * dw * dw + this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dw * 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, bf) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - this%weight * bf * du + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - bf * du call this%pre_budget%igrid_sim%spectC%ifft(this%pre_budget%vsgs, bf) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - this%weight * bf * dv + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - bf * dv call this%pre_budget%igrid_sim%spectE%ifft(this%pre_budget%wsgs, rbuffxE1) call this%interp_Edge2Cell(rbuffxE1, bf) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - this%weight * bf * dw + this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - bf * dw ! The remaining of B3(5) is the exactly as B3(8) ! Term 8: base tau_ij' * d_j(delta u_i') [SGS dissipation] @@ -760,115 +763,115 @@ subroutine AssembleBudget3(this) ! Term 17: d_j(delta u_j' delta u_i' delta u_i')/2 [Turbulent transport of TKE] call this%ddx_R2R(du, bf)! i=1, j=1 - buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,1) + buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,1) this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = this%weight * bf * this%delta_tauij(:,:,:,1) + buffer = bf * this%delta_tauij(:,:,:,1) this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * ubase * ubase - buffer = this%weight * bf * du * ubase + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * ubase * ubase + buffer = bf * du * ubase this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ buffer this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ buffer - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * du * du + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * du * du call this%ddy_R2R(du, bf)! i=1, j=2 - buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,2) + buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,2) this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = this%weight * bf * this%delta_tauij(:,:,:,2) + buffer = bf * this%delta_tauij(:,:,:,2) this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * ubase * vbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * dv * ubase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * vbase * du - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dv * du + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * ubase * vbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * dv * ubase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * vbase * du + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dv * du call this%ddz_R2R(du, bf)! i=1, j=3 - buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,3) + buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,3) this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = this%weight * bf * this%delta_tauij(:,:,:,3) + buffer = bf * this%delta_tauij(:,:,:,3) this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * ubase * wcbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * dw * ubase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * wcbase * du - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dw * du + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * ubase * wcbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * dw * ubase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * wcbase * du + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dw * du call this%ddx_R2R(dv, bf)! i=2, j=1 - buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,2) + buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,2) this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = this%weight * bf * this%delta_tauij(:,:,:,2) + buffer = bf * this%delta_tauij(:,:,:,2) this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * vbase * ubase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * du * vbase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * ubase * dv - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * du * dv + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * vbase * ubase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * du * vbase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * ubase * dv + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * du * dv call this%ddy_R2R(dv, bf)! i=2, j=2 - buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,4) + buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,4) this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = this%weight * bf * this%delta_tauij(:,:,:,4) + buffer = bf * this%delta_tauij(:,:,:,4) this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * vbase * vbase - buffer = this%weight * bf * dv * vbase + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * vbase * vbase + buffer = bf * dv * vbase this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ buffer this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ buffer - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dv * dv + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dv * dv call this%ddz_R2R(dv, bf)! i=2, j=3 - buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,5) + buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,5) this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = this%weight * bf * this%delta_tauij(:,:,:,5) + buffer = bf * this%delta_tauij(:,:,:,5) this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * vbase * wcbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * dw * vbase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * wcbase * dv - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dw * dv + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * vbase * wcbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * dw * vbase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * wcbase * dv + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dw * dv call this%ddx_R2R(dw, bf)! i=3, j=1 - buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,3) + buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,3) this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = this%weight * bf * this%delta_tauij(:,:,:,3) + buffer = bf * this%delta_tauij(:,:,:,3) this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * wcbase * ubase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * du * wcbase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * ubase * dw - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * du * dw + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * wcbase * ubase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * du * wcbase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * ubase * dw + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * du * dw call this%ddy_R2R(dw, bf)! i=3, j=2 - buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,5) + buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,5) this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = this%weight * bf * this%delta_tauij(:,:,:,5) + buffer = bf * this%delta_tauij(:,:,:,5) this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * wcbase * vbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ this%weight * bf * dv * wcbase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ this%weight * bf * vbase * dw - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dv * dw + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * wcbase * vbase + this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * dv * wcbase + this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * vbase * dw + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dv * dw call this%ddz_R2R(dw, bf)! i=3, j=3 - buffer = this%weight * bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,6) + buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,6) this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = this%weight * bf * this%delta_tauij(:,:,:,6) + buffer = bf * this%delta_tauij(:,:,:,6) this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ this%weight * bf * wcbase * wcbase - buffer = this%weight * bf * dw * wcbase + this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * wcbase * wcbase + buffer = bf * dw * wcbase this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ buffer this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ buffer - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ this%weight * bf * dw * dw + this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dw * dw ! Term 10: delta u_3' delta wb' ! Term 11: delta u_3' base wb' @@ -877,24 +880,24 @@ subroutine AssembleBudget3(this) cbuffyE1 = this%prim_budget%wb - this%pre_budget%wb call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) call this%interp_Edge2Cell(rbuffxE1, buffer) - this%budget_3(:,:,:,10) = this%budget_3(:,:,:,10) + this%weight * dw * buffer - this%budget_3(:,:,:,12) = this%budget_3(:,:,:,12) + this%weight * wcbase * buffer + this%budget_3(:,:,:,10) = this%budget_3(:,:,:,10) + dw * buffer + this%budget_3(:,:,:,12) = this%budget_3(:,:,:,12) + wcbase * buffer call this%pre_budget%igrid_sim%spectE%ifft(this%pre_budget%wb, rbuffxE1) call this%interp_Edge2Cell(rbuffxE1, buffer) - this%budget_3(:,:,:,11) = this%budget_3(:,:,:,11) + this%weight * dw * buffer + this%budget_3(:,:,:,11) = this%budget_3(:,:,:,11) + dw * buffer end if if (this%useWindTurbines)then cbuffyC1 = this%prim_budget%uturb - this%pre_budget%uturb call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) - this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + this%weight * du * buffer - this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + this%weight * ubase * buffer + this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + du * buffer + this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + ubase * buffer cbuffyC1 = this%prim_budget%vturb - this%pre_budget%vturb call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) - this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + this%weight * dv * buffer - this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + this%weight * vbase * buffer + this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + dv * buffer + this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + vbase * buffer end if nullify(du, dv, dw, rbuffxE1, buffer, bf, cbuffyE1, cbuffyC1, ubase, vbase, wcbase) @@ -1323,31 +1326,31 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) 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_budget%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 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_budget%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 @@ -1387,13 +1390,14 @@ subroutine RestartBudget(this, dir, rid, tid, cid) buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) this%counter = cid - if(this%time_weighted_average)then - ! If this is time-weighted averaging, we should read the sum of times - call this%readTimeSum(trim(dir),rid,tid,cid) - totalWeight = this%timeSum + 1.d-18 - else - totalWeight = real(this%counter,rkind) + 1.d-18 - end if + ! if(this%time_weighted_average)then + ! ! If this is time-weighted averaging, we should read the sum of times + ! call this%readTimeSum(trim(dir),rid,tid,cid) + ! totalWeight = this%timeSum + 1.d-18 + ! else + ! totalWeight = real(this%counter,rkind) + 1.d-18 + ! end if + 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 From 0ce6c070fa11e2eb13503bf4a07db4faa4a5bfec Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sun, 1 Feb 2026 15:47:41 -0500 Subject: [PATCH 019/114] Update AssembleBudget2 to use already computed flow gradients in igrid --- .../budget_time_avg_deficit_compact.F90 | 208 +++++++++++------- 1 file changed, 129 insertions(+), 79 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index 966da501..9c3bd388 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -489,92 +489,142 @@ subroutine AssembleBudget1(this) ! ---------------------- Budget 2 ------------------------ subroutine AssembleBudget2(this) class(budgets_time_avg_deficit_compact), intent(inout), target :: this - real(rkind), dimension(:,:,:), pointer :: du, dv, dw, buffer + real(rkind), dimension(:,:,:), pointer :: du, dv, buffC + real(rkind), dimension(:,:,:), pointer :: dwE, buffE, duE, dvE + real(rkind), dimension(:,:,:), pointer :: ubase, vbase, wbaseE, ubaseE, vbaseE + real(rkind), dimension(:,:,:), pointer :: dudxC_prim, dudyC_prim, dudzE_prim, dudxC_pre, dudyC_pre, dudzE_pre + real(rkind), dimension(:,:,:), pointer :: dvdxC_prim, dvdyC_prim, dvdzE_prim, dvdxC_pre, dvdyC_pre, dvdzE_pre + real(rkind), dimension(:,:,:), pointer :: dwdxE_prim, dwdyE_prim, dwdzE_prim, dwdxE_pre, dwdyE_pre, dwdzE_pre ! Cell x-pencil buffers - du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) - dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) - dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) - buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) + dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) + buffC => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) + dwE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) + buffE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,2) + duE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,1) + dvE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,2) ! Perturbation fields - du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u - dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v - dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC - - call this%ddx_R2R(du, buffer) - this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + du * buffer - this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%pre_budget%igrid_sim%u * buffer - - call this%ddy_R2R(du, buffer) - this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + dv * buffer - this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%pre_budget%igrid_sim%v * buffer - - call this%ddz_R2R(du, buffer) - this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + dw * buffer - this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + this%pre_budget%igrid_sim%wC * buffer - - call this%ddx_R2R(dv, buffer) - this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + du * buffer - this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%pre_budget%igrid_sim%u * buffer - - call this%ddy_R2R(dv, buffer) - this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + dv * buffer - this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%pre_budget%igrid_sim%v * buffer - - call this%ddz_R2R(dv, buffer) - this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + dw * buffer - this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + this%pre_budget%igrid_sim%wC * buffer - - call this%ddx_R2R(dw, buffer) - this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + du * buffer - this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%pre_budget%igrid_sim%u * buffer - - call this%ddy_R2R(dw, buffer) - this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + dv * buffer - this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%pre_budget%igrid_sim%v * buffer - - call this%ddz_R2R(dw, buffer) - this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + dw * buffer - this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + this%pre_budget%igrid_sim%wC * buffer - - call this%ddx_R2R(this%pre_budget%igrid_sim%u, buffer) - this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + du * buffer - this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%pre_budget%igrid_sim%u * buffer - - call this%ddy_R2R(this%pre_budget%igrid_sim%u, buffer) - this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + dv * buffer - this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%pre_budget%igrid_sim%v * buffer - - call this%ddz_R2R(this%pre_budget%igrid_sim%u, buffer) - this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + dw * buffer - this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + this%pre_budget%igrid_sim%wC * buffer - - call this%ddx_R2R(this%pre_budget%igrid_sim%v, buffer) - this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + du * buffer - this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%pre_budget%igrid_sim%u * buffer - - call this%ddy_R2R(this%pre_budget%igrid_sim%v, buffer) - this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + dv * buffer - this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%pre_budget%igrid_sim%v * buffer + du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u + dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v + duE = this%prim_budget%igrid_sim%uE - this%pre_budget%igrid_sim%uE + dvE = this%prim_budget%igrid_sim%vE - this%pre_budget%igrid_sim%vE + dwE = this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w - call this%ddz_R2R(this%pre_budget%igrid_sim%v, buffer) - this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + dw * buffer - this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + this%pre_budget%igrid_sim%wC * buffer + ! Base-flow fields + ubase => this%pre_budget%igrid_sim%u + vbase => this%pre_budget%igrid_sim%v + ubaseE => this%pre_budget%igrid_sim%uE + vbaseE => this%pre_budget%igrid_sim%vE + wbaseE=> this%pre_budget%igrid_sim%w + ! ----------------------------------------------------------- + ! + ! Primary simulation: + ! Cell gradients + dudxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,1) + dudyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,2) + dvdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,4) + dvdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,5) + + ! Edge gradients + dudzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,3) + dvdzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,6) + dwdxE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,7) + dwdyE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,8) + dwdzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,9) + ! ----------------------------------------------------------- + ! + ! Precursor simulation: + ! Cell gradients + dudxC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,1) + dudyC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,2) + dvdxC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,4) + dvdyC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,5) + + ! Edge gradients + dudzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,3) + dvdzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,6) + dwdxE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,7) + dwdyE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,8) + dwdzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,9) + ! ----------------------------------------------------------- + + ! Term 1: 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) + buffE = dwE * (dudzE_prim - dudzE_pre) + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + buffC + + ! Term 2: 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) + buffE = dwE * (dvdzE_prim - dvdzE_pre) + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + buffC + + ! Term 3: delta u_j d_j(delta w) + buffE = duE * (dwdxE_prim - dwdxE_pre) + dvE * (dwdyE_prim - dwdyE_pre) + dwE * (dwdzE_prim - dwdzE_pre) + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + buffC - call this%ddx_R2R(this%pre_budget%igrid_sim%wC, buffer) - this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + du * buffer - this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%pre_budget%igrid_sim%u * buffer - - call this%ddy_R2R(this%pre_budget%igrid_sim%wC, buffer) - this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + dv * buffer - this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%pre_budget%igrid_sim%v * buffer - - call this%ddz_R2R(this%pre_budget%igrid_sim%wC, buffer) - this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + dw * buffer - this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + this%pre_budget%igrid_sim%wC * buffer + ! Term 4: delta u_j d_j(base u) + this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + du * dudxC_pre + dv * dudyC_pre + buffE = dwE * dudzE_pre + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + buffC + + ! Term 5: delta u_j d_j(base v) + this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + du * dvdxC_pre + dv * dvdyC_pre + buffE = dwE * dvdzE_pre + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + buffC + + ! Term 6: delta u_j d_j(base w) + buffE = duE * dwdxE_pre + dvE * dwdyE_pre + dwE * dwdzE_pre + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + buffC - nullify(du, dv, dw, buffer) + ! Term 7: 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) + buffE = wbaseE * (dudzE_prim - dudzE_pre) + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + buffC + + ! Term 8: 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) + buffE = wbaseE * (dvdzE_prim - dvdzE_pre) + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + buffC + + ! Term 9: base u_j d_j(delta w) + buffE = ubaseE * (dwdxE_prim - dwdxE_pre) + vbaseE * (dwdyE_prim-dwdyE_pre) + wbaseE * (dwdzE_prim-dwdzE_pre) + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + buffC + + ! Term 10: base u_j d_j(base u) + this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + ubase * dudxC_pre + vbase * dudyC_pre + buffE = wbaseE * dudzE_pre + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + buffC + + ! Term 11: base u_j d_j(base v) + this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + ubase * dvdxC_pre + vbase * dvdyC_pre + buffE = wbaseE * dvdzE_pre + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + buffC + + ! Term 12: base u_j d_j(base w) + buffE=ubaseE * dwdxE_pre + vbaseE * dwdyE_pre + wbaseE * dwdzE_pre + call this%interp_Edge2Cell(buffE, buffC) + this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + buffC + + ! Release memory + nullify(du, dv, buffC) + nullify(dwE, buffE, duE, dvE) + nullify(ubase, vbase, wbaseE, ubaseE, vbaseE) + nullify(dudxC_prim, dudyC_prim, dudzE_prim, dudxC_pre, dudyC_pre, dudzE_pre) + nullify(dvdxC_prim, dvdyC_prim, dvdzE_prim, dvdxC_pre, dvdyC_pre, dvdzE_pre) + nullify(dwdxE_prim, dwdyE_prim, dwdzE_prim, dwdxE_pre, dwdyE_pre, dwdzE_pre) end subroutine ! ---------------------- Budget 3 ------------------------ From c735fb830c92e4d51e1a6e12695660477118c263 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 2 Feb 2026 11:14:32 -0500 Subject: [PATCH 020/114] intermediate save --- .../budget_time_avg_deficit_compact.F90 | 37 ++++++++++++++++--- 1 file changed, 31 insertions(+), 6 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index 9c3bd388..dce3c8eb 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -64,6 +64,7 @@ module budgets_time_avg_deficit_compact_mod procedure, private :: ddy_R2R procedure, private :: ddz_R2R procedure, private :: ddz_C2R + procedure, private :: dealias procedure, private :: interp_Edge2Cell procedure, private :: interp_Cell2Edge procedure, private :: multiply_CellFieldsOnEdges @@ -489,17 +490,20 @@ subroutine AssembleBudget1(this) ! ---------------------- Budget 2 ------------------------ subroutine AssembleBudget2(this) class(budgets_time_avg_deficit_compact), intent(inout), target :: this - real(rkind), dimension(:,:,:), pointer :: du, dv, buffC + real(rkind), dimension(:,:,:), pointer :: du, dv, buffC, dw, buffer real(rkind), dimension(:,:,:), pointer :: dwE, buffE, duE, dvE real(rkind), dimension(:,:,:), pointer :: ubase, vbase, wbaseE, ubaseE, vbaseE real(rkind), dimension(:,:,:), pointer :: dudxC_prim, dudyC_prim, dudzE_prim, dudxC_pre, dudyC_pre, dudzE_pre + real(rkind), dimension(:,:,:), pointer :: dudzC_prim, dvdzC_prim, dudzC_pre, dvdzC_pre real(rkind), dimension(:,:,:), pointer :: dvdxC_prim, dvdyC_prim, dvdzE_prim, dvdxC_pre, dvdyC_pre, dvdzE_pre real(rkind), dimension(:,:,:), pointer :: dwdxE_prim, dwdyE_prim, dwdzE_prim, dwdxE_pre, dwdyE_pre, dwdzE_pre - + ! Cell x-pencil buffers du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) buffC => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) + dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + buffer => this%pre_budget%igrid_sim%rbuffxC(:,:,:,1) dwE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) buffE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,2) duE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,1) @@ -508,6 +512,7 @@ subroutine AssembleBudget2(this) ! Perturbation fields du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v + dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC duE = this%prim_budget%igrid_sim%uE - this%pre_budget%igrid_sim%uE dvE = this%prim_budget%igrid_sim%vE - this%pre_budget%igrid_sim%vE dwE = this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w @@ -524,6 +529,7 @@ subroutine AssembleBudget2(this) ! Cell gradients dudxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,1) dudyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,2) + dudzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,3) dvdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,4) dvdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,5) @@ -539,6 +545,7 @@ subroutine AssembleBudget2(this) ! Cell 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) @@ -551,10 +558,18 @@ subroutine AssembleBudget2(this) ! ----------------------------------------------------------- ! Term 1: 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) - buffE = dwE * (dudzE_prim - dudzE_pre) - call this%interp_Edge2Cell(buffE, buffC) + ! buffE = dwE * (dudzE_prim - dudzE_pre) + ! call this%interp_Edge2Cell(buffE, buffC) + buffC = du * (dudxC_prim - dudxC_pre) + dv * (dudyC_prim - dudyC_pre) + dw * (dudzC_prim - dudzC_pre) + call this%dealias(buffC) this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + buffC + + ! this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + & + ! du * (dudxC_prim - dudxC_pre) + dv * (dudyC_prim - dudyC_pre) + dw * (dudzC_prim - dudzC_pre) + !buffE = dwE * (dudzE_prim - dudzE_pre) + ! buffE = dudzE_prim - dudzE_pre + ! call this%interp_Edge2Cell(buffE, buffC) + ! this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + buffC * dw ! Term 2: 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) @@ -619,7 +634,7 @@ subroutine AssembleBudget2(this) this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + buffC ! Release memory - nullify(du, dv, buffC) + nullify(du, dv, dw, buffC) nullify(dwE, buffE, duE, dvE) nullify(ubase, vbase, wbaseE, ubaseE, vbaseE) nullify(dudxC_prim, dudyC_prim, dudzE_prim, dudxC_pre, dudyC_pre, dudzE_pre) @@ -1049,6 +1064,7 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) end select + call this%dealias(buffer) else if(budgetid.eq.3)then select case(idx) @@ -1537,6 +1553,15 @@ subroutine destroy(this) end subroutine ! ----------------------private derivative operators ------------------------ + subroutine dealias(this, f) + class(budgets_time_avg_deficit_compact), intent(inout) :: this + real(rkind), dimension(this%nx,this%ny,this%nz), intent(inout) :: f + + call this%prim_budget%igrid_sim%spectC%fft(f,this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), 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 From 9e5389f93cf5347fa221ef6573d0af14bfb84a86 Mon Sep 17 00:00:00 2001 From: karimMohamedAhmed Date: Mon, 2 Feb 2026 12:25:07 -0500 Subject: [PATCH 021/114] push to Anvil to test Budget 2 --- .../budget_time_avg_deficit_compact.F90 | 355 ++++++++++-------- 1 file changed, 203 insertions(+), 152 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index dce3c8eb..c2f47f1d 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -15,7 +15,7 @@ module budgets_time_avg_deficit_compact_mod type :: budgets_time_avg_deficit_compact private - integer :: run_id, nx, ny, nz + integer :: run_id, nx, ny, nz!, nxE, nyE, nzE logical :: do_budget0=.false., do_budget1=.false., do_budget2=.false., do_budget3=.false. logical :: write_budget0=.false., write_budget1=.false., write_budget2=.false., write_budget3=.false. @@ -23,6 +23,8 @@ module budgets_time_avg_deficit_compact_mod 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 :: extraCellFields!, extraEdgeFields + logical :: doExtraFields = .false. integer :: counter real(rkind) :: timeSum, weight character(len=clen) :: budgets_dir @@ -55,6 +57,7 @@ module budgets_time_avg_deficit_compact_mod procedure, private :: AssembleBudget1 procedure, private :: AssembleBudget2 procedure, private :: AssembleBudget3 + procedure, private :: AssembleExtraFields procedure, private :: getProductOfMeans ! procedure, private :: writeTimeSum @@ -103,6 +106,9 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) this%nx = this%prim_budget%igrid_sim%gpC%xsz(1) this%ny = this%prim_budget%igrid_sim%gpC%xsz(2) this%nz = this%prim_budget%igrid_sim%gpC%xsz(3) ! centered grid x, y, z + ! this%nxE = this%prim_budget%igrid_sim%gpE%xsz(1) + ! this%nyE = this%prim_budget%igrid_sim%gpE%xsz(2) + ! this%nzE = this%prim_budget%igrid_sim%gpE%xsz(3) this%do_budgets = do_budgets this%tidx_dump = tidx_dump this%tidx_compute = tidx_compute @@ -132,6 +138,7 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) this%do_budget1=.true. this%do_budget2=.true. end if + if(this%do_budget2)this%doExtraFields = .true. this%budgets_dir = budgets_dir if(this%do_budgets) then @@ -168,6 +175,11 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) allocate(this%delta_tauij(this%nx,this%ny,this%nz,6)) end if + if(this%doExtraFields)then + allocate(this%extraCellFields(this%nx,this%ny,this%nz,18)) + !allocate(this%extraEdgeFields(this%nxE,this%nyE,this%nzE,8)) + end if + if ((trim(budgets_dir) .eq. "null") .or.(trim(budgets_dir) .eq. "NULL")) then this%budgets_dir = this%prim_budget%igrid_sim%outputDir end if @@ -234,6 +246,7 @@ subroutine updateBudget(this) ! this%weight = real(1., rkind) ! end if + if(this%doExtraFields) call this%AssembleExtraFields() if(this%do_budget0) call this%AssembleBudget0() if(this%do_budget1) call this%AssembleBudget1() if(this%do_budget2) call this%AssembleBudget2() @@ -268,6 +281,10 @@ subroutine DumpBudget(this) 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%doExtraFields)then + this%extraCellFields = this%extraCellFields/totalWeight + !this%extraEdgeFields = this%extraEdgeFields/totalWeight + end if this%pre_budget%budget_0 = this%pre_budget%budget_0/totalWeight this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight @@ -328,10 +345,78 @@ subroutine DumpBudget(this) 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%doExtraFields)then + this%extraCellFields = this%extraCellFields*totalWeight + !this%extraEdgeFields = this%extraEdgeFields*totalWeight + end if this%pre_budget%budget_0 = this%pre_budget%budget_0*totalWeight this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight end subroutine + ! ---------------------- Extra Fields ------------------------ + subroutine AssembleExtraFields(this) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this + !real(rkind), dimension(:,:,:,:), pointer :: prim_Cgrads, pre_Cgrads, prim_Egrads, pre_Egrads + + ! prim_Cgrads => this%prim_budget%igrid_sim%duidxjC + ! pre_Cgrads => this%pre_budget%igrid_sim%duidxjC + ! prim_Egrads => this%prim_budget%igrid_sim%duidxjE + ! pre_Egrads => this%pre_budget%igrid_sim%duidxjE + + this%extraCellFields(:,:,:,1:9) = this%extraCellFields(:,:,:,1:9) + this%prim_budget%igrid_sim%duidxjC(:,:,:,1:9) - this%pre_budget%igrid_sim%duidxjC(:,:,:,1:9) + this%extraCellFields(:,:,:,10:18) = this%extraCellFields(:,:,:,10:18) + this%pre_budget%igrid_sim%duidxjC(:,:,:,1:9) + + ! Cell fields + ! ---------------- + ! 1) dudx + ! this%extraCellFields(:,:,:,1) = this%extraCellFields(:,:,:,1) + prim_Cgrads(:,:,:,1) - pre_Cgrads(:,:,:,1) + + ! ! 2) dudy + ! this%extraCellFields(:,:,:,2) = this%extraCellFields(:,:,:,2) + prim_Cgrads(:,:,:,2) - pre_Cgrads(:,:,:,2) + + ! ! 3) dvdx + ! this%extraCellFields(:,:,:,3) = this%extraCellFields(:,:,:,3) + prim_Cgrads(:,:,:,4) - pre_Cgrads(:,:,:,4) + + ! ! 4) dvdy + ! this%extraCellFields(:,:,:,4) = this%extraCellFields(:,:,:,4) + prim_Cgrads(:,:,:,5) - pre_Cgrads(:,:,:,5) + + ! ! 5) dudz + ! this%extraCellFields(:,:,:,5) = this%extraCellFields(:,:,:,5) + prim_Cgrads(:,:,:,3) - pre_Cgrads(:,:,:,3) + + ! ! 6) dvdz + ! this%extraCellFields(:,:,:,6) = this%extraCellFields(:,:,:,6) + prim_Cgrads(:,:,:,6) - pre_Cgrads(:,:,:,6) + + + ! Edge fields + ! ---------------- + ! 1) delta u at edges + ! this%extraEdgeFields(:,:,:,1) = this%extraEdgeFields(:,:,:,1) + this%prim_budget%igrid_sim%uE - this%pre_budget%igrid_sim%uE + + ! ! 2) delta v at edges + ! this%extraEdgeFields(:,:,:,2) = this%extraEdgeFields(:,:,:,2) + this%prim_budget%igrid_sim%vE - this%pre_budget%igrid_sim%vE + + ! ! 3) delta w at edges + ! this%extraEdgeFields(:,:,:,3) = this%extraEdgeFields(:,:,:,3) + this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w + + ! ! 4) dudz at edges + ! this%extraEdgeFields(:,:,:,4) = this%extraEdgeFields(:,:,:,4) + prim_Egrads(:,:,:,3) - pre_Egrads(:,:,:,3) + + ! ! 5) dvdz at edges + ! this%extraEdgeFields(:,:,:,5) = this%extraEdgeFields(:,:,:,5) + prim_Egrads(:,:,:,6) - pre_Egrads(:,:,:,6) + + ! ! 6) dwdx at edges + ! this%extraEdgeFields(:,:,:,6) = this%extraEdgeFields(:,:,:,6) + prim_Egrads(:,:,:,7) - pre_Egrads(:,:,:,7) + + ! ! 7) dwdy at edges + ! this%extraEdgeFields(:,:,:,7) = this%extraEdgeFields(:,:,:,7) + prim_Egrads(:,:,:,8) - pre_Egrads(:,:,:,8) + + ! ! 8) dwdz at edges + ! this%extraEdgeFields(:,:,:,8) = this%extraEdgeFields(:,:,:,8) + prim_Egrads(:,:,:,9) - pre_Egrads(:,:,:,9) + + !nullify(prim_Cgrads, pre_Cgrads, prim_Egrads, prim_Egrads, pre_Egrads) + end subroutine + + ! ---------------------- Budget 0 ------------------------ subroutine AssembleBudget0(this) class(budgets_time_avg_deficit_compact), intent(inout), target :: this @@ -490,39 +575,40 @@ subroutine AssembleBudget1(this) ! ---------------------- Budget 2 ------------------------ subroutine AssembleBudget2(this) class(budgets_time_avg_deficit_compact), intent(inout), target :: this - real(rkind), dimension(:,:,:), pointer :: du, dv, buffC, dw, buffer - real(rkind), dimension(:,:,:), pointer :: dwE, buffE, duE, dvE - real(rkind), dimension(:,:,:), pointer :: ubase, vbase, wbaseE, ubaseE, vbaseE - real(rkind), dimension(:,:,:), pointer :: dudxC_prim, dudyC_prim, dudzE_prim, dudxC_pre, dudyC_pre, dudzE_pre - real(rkind), dimension(:,:,:), pointer :: dudzC_prim, dvdzC_prim, dudzC_pre, dvdzC_pre - real(rkind), dimension(:,:,:), pointer :: dvdxC_prim, dvdyC_prim, dvdzE_prim, dvdxC_pre, dvdyC_pre, dvdzE_pre - real(rkind), dimension(:,:,:), pointer :: dwdxE_prim, dwdyE_prim, dwdzE_prim, dwdxE_pre, dwdyE_pre, dwdzE_pre - + real(rkind), dimension(:,:,:), pointer :: du, dv, buffC, dw!, buffer + !real(rkind), dimension(:,:,:), pointer :: dwE, buffE, duE, dvE + real(rkind), dimension(:,:,:), pointer :: ubase, vbase, wbase !wbaseE, ubaseE, vbaseE + 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 + integer :: k + ! Cell x-pencil buffers du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) - dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) - buffC => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) - dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) - buffer => this%pre_budget%igrid_sim%rbuffxC(:,:,:,1) - dwE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) - buffE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,2) - duE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,1) - dvE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,2) + dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) + dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) + buffC => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + ! buffer => this%pre_budget%igrid_sim%rbuffxC(:,:,:,1) + ! dwE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) + ! buffE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,2) + ! duE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,1) + ! dvE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,2) ! Perturbation fields du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC - duE = this%prim_budget%igrid_sim%uE - this%pre_budget%igrid_sim%uE - dvE = this%prim_budget%igrid_sim%vE - this%pre_budget%igrid_sim%vE - dwE = this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w + ! duE = this%prim_budget%igrid_sim%uE - this%pre_budget%igrid_sim%uE + ! dvE = this%prim_budget%igrid_sim%vE - this%pre_budget%igrid_sim%vE + ! dwE = this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w ! Base-flow fields ubase => this%pre_budget%igrid_sim%u vbase => this%pre_budget%igrid_sim%v - ubaseE => this%pre_budget%igrid_sim%uE - vbaseE => this%pre_budget%igrid_sim%vE - wbaseE=> this%pre_budget%igrid_sim%w + wbase => this%pre_budget%igrid_sim%wC + ! ubaseE => this%pre_budget%igrid_sim%uE + ! vbaseE => this%pre_budget%igrid_sim%vE + ! wbaseE=> this%pre_budget%igrid_sim%w ! ----------------------------------------------------------- ! ! Primary simulation: @@ -532,13 +618,17 @@ subroutine AssembleBudget2(this) dudzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,3) dvdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,4) dvdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,5) + dvdzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,6) + dwdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,7) + dwdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,8) + dwdzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,9) ! Edge gradients - dudzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,3) - dvdzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,6) - dwdxE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,7) - dwdyE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,8) - dwdzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,9) + ! dudzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,3) + ! dvdzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,6) + ! dwdxE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,7) + ! dwdyE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,8) + ! dwdzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,9) ! ----------------------------------------------------------- ! ! Precursor simulation: @@ -547,99 +637,57 @@ subroutine AssembleBudget2(this) 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) + 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) ! Edge gradients - dudzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,3) - dvdzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,6) - dwdxE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,7) - dwdyE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,8) - dwdzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,9) + ! dudzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,3) + ! dvdzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,6) + ! dwdxE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,7) + ! dwdyE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,8) + ! dwdzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,9) ! ----------------------------------------------------------- - ! Term 1: delta u_j d_j(delta u) - ! buffE = dwE * (dudzE_prim - dudzE_pre) - ! call this%interp_Edge2Cell(buffE, buffC) - buffC = du * (dudxC_prim - dudxC_pre) + dv * (dudyC_prim - dudyC_pre) + dw * (dudzC_prim - dudzC_pre) - call this%dealias(buffC) - this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + buffC - - ! this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + & - ! du * (dudxC_prim - dudxC_pre) + dv * (dudyC_prim - dudyC_pre) + dw * (dudzC_prim - dudzC_pre) - !buffE = dwE * (dudzE_prim - dudzE_pre) - ! buffE = dudzE_prim - dudzE_pre - ! call this%interp_Edge2Cell(buffE, buffC) - ! this%budget_2(:,:,:,1) = this%budget_2(:,:,:,1) + buffC * dw - - ! Term 2: 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) - buffE = dwE * (dvdzE_prim - dvdzE_pre) - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,2) = this%budget_2(:,:,:,2) + buffC - - ! Term 3: delta u_j d_j(delta w) - buffE = duE * (dwdxE_prim - dwdxE_pre) + dvE * (dwdyE_prim - dwdyE_pre) + dwE * (dwdzE_prim - dwdzE_pre) - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,3) = this%budget_2(:,:,:,3) + buffC - - ! Term 4: delta u_j d_j(base u) - this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + du * dudxC_pre + dv * dudyC_pre - buffE = dwE * dudzE_pre - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,4) = this%budget_2(:,:,:,4) + buffC - - ! Term 5: delta u_j d_j(base v) - this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + du * dvdxC_pre + dv * dvdyC_pre - buffE = dwE * dvdzE_pre - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,5) = this%budget_2(:,:,:,5) + buffC - - ! Term 6: delta u_j d_j(base w) - buffE = duE * dwdxE_pre + dvE * dwdyE_pre + dwE * dwdzE_pre - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,6) = this%budget_2(:,:,:,6) + buffC - - ! Term 7: 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) - buffE = wbaseE * (dudzE_prim - dudzE_pre) - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,7) = this%budget_2(:,:,:,7) + buffC - - ! Term 8: 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) - buffE = wbaseE * (dvdzE_prim - dvdzE_pre) - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,8) = this%budget_2(:,:,:,8) + buffC - - ! Term 9: base u_j d_j(delta w) - buffE = ubaseE * (dwdxE_prim - dwdxE_pre) + vbaseE * (dwdyE_prim-dwdyE_pre) + wbaseE * (dwdzE_prim-dwdzE_pre) - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,9) = this%budget_2(:,:,:,9) + buffC - - ! Term 10: base u_j d_j(base u) - this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + ubase * dudxC_pre + vbase * dudyC_pre - buffE = wbaseE * dudzE_pre - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,10) = this%budget_2(:,:,:,10) + buffC - - ! Term 11: base u_j d_j(base v) - this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + ubase * dvdxC_pre + vbase * dvdyC_pre - buffE = wbaseE * dvdzE_pre - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,11) = this%budget_2(:,:,:,11) + buffC - - ! Term 12: base u_j d_j(base w) - buffE=ubaseE * dwdxE_pre + vbaseE * dwdyE_pre + wbaseE * dwdzE_pre - call this%interp_Edge2Cell(buffE, buffC) - this%budget_2(:,:,:,12) = this%budget_2(:,:,:,12) + buffC + do k=1, this%size_budget_2 + select case(k) + case(1) ! delta u_j d_j(delta u) + buffC = du * (dudxC_prim - dudxC_pre) + dv * (dudyC_prim - dudyC_pre) + dw * (dudzC_prim - dudzC_pre) + case(2) ! delta u_j d_j(delta v) + buffC = du * (dvdxC_prim - dvdxC_pre) + dv * (dvdyC_prim - dvdyC_pre) + dw * (dvdzC_prim - dvdzC_pre) + case(3) ! delta u_j d_j(delta w) + buffC = du * (dwdxC_prim - dwdxC_pre) + dv * (dwdyC_prim - dwdyC_pre) + dw * (dwdzC_prim - dwdzC_pre) + case(4) ! delta u_j d_j(base u) + buffC = du * dudxC_pre + dv * dudyC_pre + dw * dudzC_pre + case(5) ! delta u_j d_j(base v) + buffC = du * dvdxC_pre + dv * dvdyC_pre + dw * dvdzC_pre + case(6) ! delta u_j d_j(base w) + buffC = du * dwdxC_pre + dv * dwdyC_pre + dw * dwdzC_pre + case(7) ! base u_j d_j(delta u) + buffC = ubase * (dudxC_prim - dudxC_pre) + vbase * (dudyC_prim - dudyC_pre) + wbase * (dudzC_prim - dudzC_pre) + case(8) ! base u_j d_j(delta v) + buffC = ubase * (dvdxC_prim - dvdxC_pre) + vbase * (dvdyC_prim - dvdyC_pre) + wbase * (dvdzC_prim - dvdzC_pre) + case(9) ! base u_j d_j(delta w) + buffC = ubase * (dwdxC_prim - dwdxC_pre) + vbase * (dwdyC_prim - dwdyC_pre) + wbase * (dwdzC_prim - dwdzC_pre) + case(10) ! base u_j d_j(base u) + buffC = ubase * dudxC_pre + vbase * dudyC_pre + wbase * dudzC_pre + case(11) ! base u_j d_j(base v) + buffC = ubase * dvdxC_pre + vbase * dvdyC_pre + wbase * dvdzC_pre + case(12) ! base u_j d_j(base w) + buffC = ubase * dwdxC_pre + vbase * dwdyC_pre + wbase * dwdzC_pre + end select + call this%dealias(buffC) + this%budget_2(:,:,:,k) = this%budget_2(:,:,:,k) + buffC + end do ! Release memory nullify(du, dv, dw, buffC) - nullify(dwE, buffE, duE, dvE) - nullify(ubase, vbase, wbaseE, ubaseE, vbaseE) - nullify(dudxC_prim, dudyC_prim, dudzE_prim, dudxC_pre, dudyC_pre, dudzE_pre) - nullify(dvdxC_prim, dvdyC_prim, dvdzE_prim, dvdxC_pre, dvdyC_pre, dvdzE_pre) - nullify(dwdxE_prim, dwdyE_prim, dwdzE_prim, dwdxE_pre, dwdyE_pre, dwdzE_pre) + 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 ------------------------ @@ -1016,53 +1064,53 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) else if(budgetid.eq.2)then select case(idx) case(1) - call this%ddx_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) - call this%ddy_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) - call this%ddz_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + buffer = this%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,1) + & + this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,2) + & + this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,3) case(2) - call this%ddx_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) - call this%ddy_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) - call this%ddz_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + buffer = this%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,4) + & + this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,5) + & + this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,6) case(3) - call this%ddx_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) - call this%ddy_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) - call this%ddz_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + buffer = this%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,7) + & + this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,8) + & + this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,9) case(4) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,1) + & + this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,2) + & + this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,3) case(5) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,4) + & + this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,5) + & + this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,6) case(6) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,1) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,2) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_0(:,:,:,3) - case(7) - call this%ddx_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) - call this%ddy_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) - call this%ddz_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,7) + & + this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,8) + & + this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,9) + case(7) + buffer = this%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,10) + & + this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,11) + & + this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,12) case(8) - call this%ddx_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) - call this%ddy_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) - call this%ddz_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + buffer = this%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,13) + & + this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,14) + & + this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,15) case(9) - call this%ddx_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) - call this%ddy_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) - call this%ddz_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + buffer = this%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,16) + & + this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,17) + & + this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,18) case(10) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,10) + & + this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,11) + & + this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,12) case(11) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,13) + & + this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,14) + & + this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,15) case(12) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,1) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,2) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,3) + buffer = this%pre_budget%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,16) + & + this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,17) + & + this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,18) end select call this%dealias(buffer) @@ -1536,7 +1584,9 @@ subroutine ResetBudget(this) 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%delta_tauij)) this%delta_tauij = zero + if(allocated(this%extraCellFields)) this%extraCellFields = zero + if(allocated(this%extraEdgeFields)) this%extraEdgeFields = zero end subroutine subroutine destroy(this) @@ -1549,6 +1599,7 @@ subroutine destroy(this) 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%extraCellFields)) deallocate(this%extraCellFields) end if end subroutine From 80059d88fd8908ac9c68e341262d42c73505013b Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 3 Feb 2026 16:08:25 -0500 Subject: [PATCH 022/114] add MCG- add parity for ddz & E2C- expand budget 2 --- .../budget_time_avg_deficit_compact.F90 | 1504 ++++++++--------- src/incompressible/igrid.F90 | 5 +- 2 files changed, 699 insertions(+), 810 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index c2f47f1d..d13c1920 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -3,8 +3,11 @@ module budgets_time_avg_deficit_compact_mod use decomp_2d use budgets_time_avg_mod, only: budgets_time_avg use exits, only: message, GracefulExit - use constants, only: zero + use constants, only: zero, half, two use mpi + use incompressibleGrid, only : 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 @@ -15,16 +18,15 @@ module budgets_time_avg_deficit_compact_mod type :: budgets_time_avg_deficit_compact private - integer :: run_id, nx, ny, nz!, nxE, nyE, nzE + integer :: run_id, nx, ny, nz logical :: do_budget0=.false., do_budget1=.false., do_budget2=.false., do_budget3=.false. - logical :: write_budget0=.false., write_budget1=.false., write_budget2=.false., write_budget3=.false. type(budgets_time_avg), pointer :: pre_budget, prim_budget 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 :: extraCellFields!, extraEdgeFields - logical :: doExtraFields = .false. + real(rkind), dimension(:,:,:,:), allocatable :: MCG + logical :: doMCG = .false. integer :: counter real(rkind) :: timeSum, weight character(len=clen) :: budgets_dir @@ -57,7 +59,8 @@ module budgets_time_avg_deficit_compact_mod procedure, private :: AssembleBudget1 procedure, private :: AssembleBudget2 procedure, private :: AssembleBudget3 - procedure, private :: AssembleExtraFields + procedure, private :: AssembleMCG + procedure, private :: restartMCG procedure, private :: getProductOfMeans ! procedure, private :: writeTimeSum @@ -66,12 +69,12 @@ module budgets_time_avg_deficit_compact_mod procedure, private :: ddx_R2R procedure, private :: ddy_R2R procedure, private :: ddz_R2R - procedure, private :: ddz_C2R + !procedure, private :: ddz_C2R procedure, private :: dealias procedure, private :: interp_Edge2Cell - procedure, private :: interp_Cell2Edge - procedure, private :: multiply_CellFieldsOnEdges - procedure, private :: multiply_edges_interp_cell + ! procedure, private :: interp_Cell2Edge + ! procedure, private :: multiply_CellFieldsOnEdges + ! procedure, private :: multiply_edges_interp_cell end type contains @@ -88,11 +91,11 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) real(rkind) :: time_budget_start = -1.0d0 logical :: use_time_weighted_average=.false. logical :: do_budgets = .false. - logical :: write_budget0=.false., write_budget1=.false., write_budget2=.false., write_budget3=.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, & - write_budget0, write_budget1, write_budget2, write_budget3 + do_budget0, do_budget1, do_budget2, do_budget3 ! STEP 1: Read in inputs, link pointers and allocate budget vectors ioUnit = 534 @@ -121,15 +124,10 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) !this%time_weighted_average = use_time_weighted_average this%time_weighted_average = .False. this%forceDump = .false. - this%write_budget0 = write_budget0 - this%write_budget1 = write_budget1 - this%write_budget2 = write_budget2 - this%write_budget3 = write_budget3 - - if(write_budget0)this%do_budget0=.true. - if(write_budget1)this%do_budget1=.true. - if(write_budget2)this%do_budget2=.true. - if(write_budget3)this%do_budget3=.true. + 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. @@ -138,7 +136,7 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) this%do_budget1=.true. this%do_budget2=.true. end if - if(this%do_budget2)this%doExtraFields = .true. + if(this%do_budget2) this%doMCG = .true. this%budgets_dir = budgets_dir if(this%do_budgets) then @@ -161,7 +159,7 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) end if if(this%do_budget2)then - this%size_budget_2 = 12 + this%size_budget_2 = 15 allocate(this%budget_2(this%nx,this%ny,this%nz,this%size_budget_2)) end if @@ -175,10 +173,7 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) allocate(this%delta_tauij(this%nx,this%ny,this%nz,6)) end if - if(this%doExtraFields)then - allocate(this%extraCellFields(this%nx,this%ny,this%nz,18)) - !allocate(this%extraEdgeFields(this%nxE,this%nyE,this%nzE,8)) - 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_budget%igrid_sim%outputDir @@ -246,7 +241,7 @@ subroutine updateBudget(this) ! this%weight = real(1., rkind) ! end if - if(this%doExtraFields) call this%AssembleExtraFields() + 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() @@ -262,7 +257,7 @@ subroutine DumpBudget(this) integer :: idx, budgetid, budgetsize real(rkind), dimension(:,:,:), pointer :: buffer real(rkind), dimension(:,:,:,:), pointer :: budget - logical :: writeBudget + logical :: doBudget ! if(this%time_weighted_average)then ! totalWeight = this%timeSum + 1.d-18 @@ -281,15 +276,12 @@ subroutine DumpBudget(this) 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%doExtraFields)then - this%extraCellFields = this%extraCellFields/totalWeight - !this%extraEdgeFields = this%extraEdgeFields/totalWeight - end if + 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%write_budget0)then + if(this%do_budget0)then budgetid = 0 do idx = 1, this%size_budget_0 if((idx.eq.15).or.(idx.eq.16))then @@ -302,23 +294,47 @@ subroutine DumpBudget(this) end do end if + ! Dealias budgets 1-3 as they hold product of multiple fields do budgetid=1,3 select case(budgetid) case(1) budget => this%budget_1 budgetsize = this%size_budget_1 - writeBudget = this%write_budget1 + doBudget = this%do_budget1 case(2) budget => this%budget_2 budgetsize = this%size_budget_2 - writeBudget = this%write_budget2 + doBudget = this%do_budget2 case(3) budget => this%budget_3 budgetsize = this%size_budget_3 - writeBudget = this%write_budget3 + doBudget = this%do_budget2 end select - if(writeBudget)then + if(doBudget)then + do idx = 1,budgetsize + call this%dealias(budget(:,:,:,idx)) + end do + end if + end do + + 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 @@ -328,7 +344,7 @@ subroutine DumpBudget(this) end if end if - ! Get the product of means + ! 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 @@ -340,82 +356,29 @@ subroutine DumpBudget(this) end if end do + ! MCG. Need to write it to be able to restart budgets + ! if(this%this%doMCG)then + ! do idx = 1, size(this%MCG, 4) + ! call this%dump_budget_field(this%MCG(:,:,:,idx), idx, 4) + ! 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 - if(this%doExtraFields)then - this%extraCellFields = this%extraCellFields*totalWeight - !this%extraEdgeFields = this%extraEdgeFields*totalWeight - end if + 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 - ! ---------------------- Extra Fields ------------------------ - subroutine AssembleExtraFields(this) - class(budgets_time_avg_deficit_compact), intent(inout), target :: this - !real(rkind), dimension(:,:,:,:), pointer :: prim_Cgrads, pre_Cgrads, prim_Egrads, pre_Egrads - - ! prim_Cgrads => this%prim_budget%igrid_sim%duidxjC - ! pre_Cgrads => this%pre_budget%igrid_sim%duidxjC - ! prim_Egrads => this%prim_budget%igrid_sim%duidxjE - ! pre_Egrads => this%pre_budget%igrid_sim%duidxjE - - this%extraCellFields(:,:,:,1:9) = this%extraCellFields(:,:,:,1:9) + this%prim_budget%igrid_sim%duidxjC(:,:,:,1:9) - this%pre_budget%igrid_sim%duidxjC(:,:,:,1:9) - this%extraCellFields(:,:,:,10:18) = this%extraCellFields(:,:,:,10:18) + this%pre_budget%igrid_sim%duidxjC(:,:,:,1:9) - - ! Cell fields - ! ---------------- - ! 1) dudx - ! this%extraCellFields(:,:,:,1) = this%extraCellFields(:,:,:,1) + prim_Cgrads(:,:,:,1) - pre_Cgrads(:,:,:,1) - - ! ! 2) dudy - ! this%extraCellFields(:,:,:,2) = this%extraCellFields(:,:,:,2) + prim_Cgrads(:,:,:,2) - pre_Cgrads(:,:,:,2) - - ! ! 3) dvdx - ! this%extraCellFields(:,:,:,3) = this%extraCellFields(:,:,:,3) + prim_Cgrads(:,:,:,4) - pre_Cgrads(:,:,:,4) - - ! ! 4) dvdy - ! this%extraCellFields(:,:,:,4) = this%extraCellFields(:,:,:,4) + prim_Cgrads(:,:,:,5) - pre_Cgrads(:,:,:,5) - - ! ! 5) dudz - ! this%extraCellFields(:,:,:,5) = this%extraCellFields(:,:,:,5) + prim_Cgrads(:,:,:,3) - pre_Cgrads(:,:,:,3) - - ! ! 6) dvdz - ! this%extraCellFields(:,:,:,6) = this%extraCellFields(:,:,:,6) + prim_Cgrads(:,:,:,6) - pre_Cgrads(:,:,:,6) - - - ! Edge fields - ! ---------------- - ! 1) delta u at edges - ! this%extraEdgeFields(:,:,:,1) = this%extraEdgeFields(:,:,:,1) + this%prim_budget%igrid_sim%uE - this%pre_budget%igrid_sim%uE - - ! ! 2) delta v at edges - ! this%extraEdgeFields(:,:,:,2) = this%extraEdgeFields(:,:,:,2) + this%prim_budget%igrid_sim%vE - this%pre_budget%igrid_sim%vE - - ! ! 3) delta w at edges - ! this%extraEdgeFields(:,:,:,3) = this%extraEdgeFields(:,:,:,3) + this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w - - ! ! 4) dudz at edges - ! this%extraEdgeFields(:,:,:,4) = this%extraEdgeFields(:,:,:,4) + prim_Egrads(:,:,:,3) - pre_Egrads(:,:,:,3) - - ! ! 5) dvdz at edges - ! this%extraEdgeFields(:,:,:,5) = this%extraEdgeFields(:,:,:,5) + prim_Egrads(:,:,:,6) - pre_Egrads(:,:,:,6) - - ! ! 6) dwdx at edges - ! this%extraEdgeFields(:,:,:,6) = this%extraEdgeFields(:,:,:,6) + prim_Egrads(:,:,:,7) - pre_Egrads(:,:,:,7) - - ! ! 7) dwdy at edges - ! this%extraEdgeFields(:,:,:,7) = this%extraEdgeFields(:,:,:,7) + prim_Egrads(:,:,:,8) - pre_Egrads(:,:,:,8) - - ! ! 8) dwdz at edges - ! this%extraEdgeFields(:,:,:,8) = this%extraEdgeFields(:,:,:,8) + prim_Egrads(:,:,:,9) - pre_Egrads(:,:,:,9) - - !nullify(prim_Cgrads, pre_Cgrads, prim_Egrads, prim_Egrads, pre_Egrads) - 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_budget%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) @@ -444,7 +407,7 @@ subroutine AssembleBudget0(this) cbuffyE1 = this%prim_budget%wb - this%pre_budget%wb call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) - call this%interp_Edge2Cell(rbuffxE1, rbuffxC1) + call this%interp_Edge2Cell(rbuffxE1, rbuffxC1, TBC_bottom, TBC_top) this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) + rbuffxC1 end if @@ -461,9 +424,10 @@ subroutine AssembleBudget0(this) call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) this%budget_0(:,:,:,13) = this%budget_0(:,:,:,13) + rbuffxC1 + ! wsgs is odd cbuffyE1 = this%pre_budget%wsgs - this%prim_budget%wsgs call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) - call this%interp_Edge2Cell(rbuffxE1, rbuffxC1) + call this%interp_Edge2Cell(rbuffxE1, rbuffxC1, -1, -1) this%budget_0(:,:,:,14) = this%budget_0(:,:,:,14) + rbuffxC1 ! Step 6: Coriolis @@ -500,9 +464,10 @@ subroutine AssembleBudget0(this) this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) + rbuffxC1 ! pz sign is reversed + ! pz is odd cbuffyE1 = this%pre_budget%pz - this%prim_budget%pz call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) - call this%interp_Edge2Cell(rbuffxE1, rbuffxC1) + call this%interp_Edge2Cell(rbuffxE1, rbuffxC1, -1, -1) this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) + rbuffxC1 ! Step 8: turbine forcing @@ -522,7 +487,7 @@ subroutine AssembleBudget0(this) ! ---------------------- 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 + real(rkind), dimension(:,:,:), pointer :: du, dv, dw, duE, dvE, dwE, buffer, buffE ! Cell x-pencil buffers du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) @@ -534,6 +499,7 @@ subroutine AssembleBudget1(this) duE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) dvE => this%prim_budget%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_budget%igrid_sim%u - this%pre_budget%igrid_sim%u @@ -546,11 +512,11 @@ subroutine AssembleBudget1(this) ! Reynolds stresses this%budget_1(:,:,:,1) = this%budget_1(:,:,:,1) + du * du - this%budget_1(:,:,:,2) = this%budget_1(:,:,:,2) + du * dv - buffer = this%multiply_Edges_interp_cell(duE, dwE) + 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 - buffer = this%multiply_Edges_interp_cell(dvE, dwE) + 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 @@ -558,61 +524,47 @@ subroutine AssembleBudget1(this) 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 - buffer = this%multiply_Edges_interp_cell(duE, this%pre_budget%igrid_sim%w) + + 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 - buffer = this%multiply_Edges_interp_cell(dwE, this%pre_budget%igrid_sim%uE) + 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 - buffer = this%multiply_Edges_interp_cell(dvE, this%pre_budget%igrid_sim%w) + 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 - buffer = this%multiply_Edges_interp_cell(dwE, this%pre_budget%igrid_sim%vE) + 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) + 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!, buffer - !real(rkind), dimension(:,:,:), pointer :: dwE, buffE, duE, dvE - real(rkind), dimension(:,:,:), pointer :: ubase, vbase, wbase !wbaseE, ubaseE, vbaseE + 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 - integer :: k ! Cell x-pencil buffers du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) buffC => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) - ! buffer => this%pre_budget%igrid_sim%rbuffxC(:,:,:,1) - ! dwE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) - ! buffE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,2) - ! duE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,1) - ! dvE => this%pre_budget%igrid_sim%rbuffxE(:,:,:,2) - + ! Perturbation fields du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC - ! duE = this%prim_budget%igrid_sim%uE - this%pre_budget%igrid_sim%uE - ! dvE = this%prim_budget%igrid_sim%vE - this%pre_budget%igrid_sim%vE - ! dwE = this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w ! Base-flow fields ubase => this%pre_budget%igrid_sim%u vbase => this%pre_budget%igrid_sim%v wbase => this%pre_budget%igrid_sim%wC - ! ubaseE => this%pre_budget%igrid_sim%uE - ! vbaseE => this%pre_budget%igrid_sim%vE - ! wbaseE=> this%pre_budget%igrid_sim%w - ! ----------------------------------------------------------- - ! + ! Primary simulation: - ! Cell gradients dudxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,1) dudyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,2) dudzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,3) @@ -623,16 +575,7 @@ subroutine AssembleBudget2(this) dwdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,8) dwdzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,9) - ! Edge gradients - ! dudzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,3) - ! dvdzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,6) - ! dwdxE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,7) - ! dwdyE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,8) - ! dwdzE_prim => this%prim_budget%igrid_sim%duidxjE(:,:,:,9) - ! ----------------------------------------------------------- - ! ! Precursor simulation: - ! Cell 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) @@ -643,44 +586,50 @@ subroutine AssembleBudget2(this) dwdyC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,8) dwdzC_pre => this%pre_budget%igrid_sim%duidxjC(:,:,:,9) - ! Edge gradients - ! dudzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,3) - ! dvdzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,6) - ! dwdxE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,7) - ! dwdyE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,8) - ! dwdzE_pre => this%pre_budget%igrid_sim%duidxjE(:,:,:,9) - ! ----------------------------------------------------------- - - do k=1, this%size_budget_2 - select case(k) - case(1) ! delta u_j d_j(delta u) - buffC = du * (dudxC_prim - dudxC_pre) + dv * (dudyC_prim - dudyC_pre) + dw * (dudzC_prim - dudzC_pre) - case(2) ! delta u_j d_j(delta v) - buffC = du * (dvdxC_prim - dvdxC_pre) + dv * (dvdyC_prim - dvdyC_pre) + dw * (dvdzC_prim - dvdzC_pre) - case(3) ! delta u_j d_j(delta w) - buffC = du * (dwdxC_prim - dwdxC_pre) + dv * (dwdyC_prim - dwdyC_pre) + dw * (dwdzC_prim - dwdzC_pre) - case(4) ! delta u_j d_j(base u) - buffC = du * dudxC_pre + dv * dudyC_pre + dw * dudzC_pre - case(5) ! delta u_j d_j(base v) - buffC = du * dvdxC_pre + dv * dvdyC_pre + dw * dvdzC_pre - case(6) ! delta u_j d_j(base w) - buffC = du * dwdxC_pre + dv * dwdyC_pre + dw * dwdzC_pre - case(7) ! base u_j d_j(delta u) - buffC = ubase * (dudxC_prim - dudxC_pre) + vbase * (dudyC_prim - dudyC_pre) + wbase * (dudzC_prim - dudzC_pre) - case(8) ! base u_j d_j(delta v) - buffC = ubase * (dvdxC_prim - dvdxC_pre) + vbase * (dvdyC_prim - dvdyC_pre) + wbase * (dvdzC_prim - dvdzC_pre) - case(9) ! base u_j d_j(delta w) - buffC = ubase * (dwdxC_prim - dwdxC_pre) + vbase * (dwdyC_prim - dwdyC_pre) + wbase * (dwdzC_prim - dwdzC_pre) - case(10) ! base u_j d_j(base u) - buffC = ubase * dudxC_pre + vbase * dudyC_pre + wbase * dudzC_pre - case(11) ! base u_j d_j(base v) - buffC = ubase * dvdxC_pre + vbase * dvdyC_pre + wbase * dvdzC_pre - case(12) ! base u_j d_j(base w) - buffC = ubase * dwdxC_pre + vbase * dwdyC_pre + wbase * dwdzC_pre - end select - call this%dealias(buffC) - this%budget_2(:,:,:,k) = this%budget_2(:,:,:,k) + buffC - end do + ! 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) @@ -694,23 +643,26 @@ subroutine AssembleBudget2(this) 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, wcbase - real(rkind), dimension(:,:,:), pointer :: rbuffxE1, buffer, bf + 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_budget%igrid_sim%rbuffxC(:,:,:,1) dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) - - buffer => this%pre_budget%igrid_sim%rbuffxC(:,:,:,1) - bf => this%pre_budget%igrid_sim%rbuffxC(:,:,:,2) - + buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + ! Cell y-pencil buffer cbuffyC1 => this%prim_budget%igrid_sim%cbuffyC(:,:,:,2) ! Edge x-pencil buffer rbuffxE1 => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) + rbuffxE2 => this%prim_budget%igrid_sim%rbuffxE(:,:,:,2) ! Edge y-pencil buffer cbuffyE1 => this%prim_budget%igrid_sim%cbuffyE(:,:,:,1) @@ -722,298 +674,210 @@ subroutine AssembleBudget3(this) ubase => this%pre_budget%igrid_sim%u vbase => this%pre_budget%igrid_sim%v - wcbase => this%pre_budget%igrid_sim%wC + wbase => this%pre_budget%igrid_sim%wC + + ! Primary simulation gradients: + dudxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,1) + dudyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,2) + dudzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,3) + dvdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,4) + dvdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,5) + dvdzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,6) + dwdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,7) + dwdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,8) + dwdzC_prim => this%prim_budget%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%prim_budget%px - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) - this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ bf * du - this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ bf * ubase + call this%prim_budget%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%prim_budget%py - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) - this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ bf * dv - this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ bf * vbase + call this%prim_budget%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%prim_budget%pz call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) - call this%interp_Edge2Cell(rbuffxE1, bf) - this%budget_3(:,:,:,1)=this%budget_3(:,:,:,1)+ bf * dw - this%budget_3(:,:,:,2)=this%budget_3(:,:,:,2)+ bf * wcbase + 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, bf) - this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- bf * du + 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, bf) - this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- bf * dv + 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, bf) - this%budget_3(:,:,:,3)=this%budget_3(:,:,:,3)- bf * dw + 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%prim_budget%usgs - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + bf * ubase - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + bf * du + call this%prim_budget%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%prim_budget%vsgs - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, bf) - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + bf * vbase - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + bf * dv + call this%prim_budget%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%prim_budget%wsgs call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) - call this%interp_Edge2Cell(rbuffxE1, bf) - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + bf * wcbase - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + bf * dw - - ! The remaining of B3(4) is exactly B3(7). Calculation is done once - ! Term 7: delta tau_ij' d_j(base u_i') [SGS dissipation] - ! Term 13: d_j(delta u_j' base u_i' base u_i')/2 [Turbulent transport of TKE] - ! Term 14: d_j(base u_j' base u_i' delta u_i') [Turbulent transport of TKE] - ! Term 15: d_j(delta u_j' base u_i' delta u_i') [Turbulent transport of TKE] - call this%ddx_R2R(ubase,bf) - buffer = bf * this%delta_tauij(:,:,:,1) ! i=1, j=1 - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer - this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - buffer = bf * du * ubase - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + buffer - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + buffer - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * du * du - - call this%ddy_R2R(ubase,bf) - buffer = bf * this%delta_tauij(:,:,:,2) ! i=1, j=2 - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer - this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * dv * ubase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * vbase * du - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dv * du - - call this%ddz_R2R(ubase,bf) - buffer = bf * this%delta_tauij(:,:,:,3) ! i=1, j=3 - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer - this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * dw * ubase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * wcbase * du - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dw * du - - call this%ddx_R2R(vbase,bf) - buffer = bf * this%delta_tauij(:,:,:,2) ! i=2, j=1 - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer - this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * du * vbase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * ubase * dv - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * du * dv - - call this%ddy_R2R(vbase,bf) - buffer = bf * this%delta_tauij(:,:,:,4) ! i=2, j=2 - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer - this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - buffer = bf * dv * vbase - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + buffer - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + buffer - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dv * dv - - call this%ddz_R2R(vbase,bf) - buffer = bf * this%delta_tauij(:,:,:,5) ! i=2, j=3 - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer - this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * dw * vbase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * wcbase * dv - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dw * dv - - call this%ddx_R2R(wcbase,bf) - buffer = bf * this%delta_tauij(:,:,:,3) ! i=3, j=1 - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer - this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * du * wcbase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * ubase * dw - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * du * dw - - call this%ddy_R2R(wcbase,bf) - buffer = bf * this%delta_tauij(:,:,:,5) ! i=3, j=2 - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer - this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + bf * dv * wcbase - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + bf * vbase * dw - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dv * dw - - call this%ddz_R2R(wcbase,bf) - buffer = bf * this%delta_tauij(:,:,:,6) ! i=3, j=3 - this%budget_3(:,:,:,4) = this%budget_3(:,:,:,4) + buffer - this%budget_3(:,:,:,7) = this%budget_3(:,:,:,7) + buffer - buffer = bf * dw * wcbase - this%budget_3(:,:,:,13) = this%budget_3(:,:,:,13) + buffer - this%budget_3(:,:,:,14) = this%budget_3(:,:,:,14) + buffer - this%budget_3(:,:,:,15) = this%budget_3(:,:,:,15) + bf * dw * dw + 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, bf) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - bf * du + 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, bf) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - bf * dv + 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, bf) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) - bf * dw - - ! The remaining of B3(5) is the exactly as B3(8) - ! Term 8: base tau_ij' * d_j(delta u_i') [SGS dissipation] - ! Do the rest of B3(6): d_j(delta u_i' * delta tau_ij') [SGS transport] - ! Term 9: delta tau_ij' * d_j(delta u_i') [SGS dissipation] - ! Term 14: d_j(base u_j' base u_i' delta u_i') [Turbulent transport of TKE] - ! Term 15: d_j(delta u_j' base u_i' delta u_i') [Turbulent transport of TKE] - ! Term 16: d_j(base u_j' delta u_i' delta u_i')/2 [Turbulent transport of TKE] - ! Term 17: d_j(delta u_j' delta u_i' delta u_i')/2 [Turbulent transport of TKE] - - call this%ddx_R2R(du, bf)! i=1, j=1 - buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,1) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer - this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = bf * this%delta_tauij(:,:,:,1) - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer - this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * ubase * ubase - buffer = bf * du * ubase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ buffer - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ buffer - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * du * du - - call this%ddy_R2R(du, bf)! i=1, j=2 - buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,2) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer - this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = bf * this%delta_tauij(:,:,:,2) - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer - this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * ubase * vbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * dv * ubase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * vbase * du - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dv * du - - call this%ddz_R2R(du, bf)! i=1, j=3 - buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,3) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer - this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = bf * this%delta_tauij(:,:,:,3) - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer - this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * ubase * wcbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * dw * ubase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * wcbase * du - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dw * du - - call this%ddx_R2R(dv, bf)! i=2, j=1 - buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,2) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer - this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = bf * this%delta_tauij(:,:,:,2) - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer - this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * vbase * ubase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * du * vbase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * ubase * dv - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * du * dv - - call this%ddy_R2R(dv, bf)! i=2, j=2 - buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,4) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer - this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = bf * this%delta_tauij(:,:,:,4) - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer - this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * vbase * vbase - buffer = bf * dv * vbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ buffer - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ buffer - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dv * dv - - call this%ddz_R2R(dv, bf)! i=2, j=3 - buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,5) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer - this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = bf * this%delta_tauij(:,:,:,5) - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer - this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * vbase * wcbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * dw * vbase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * wcbase * dv - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dw * dv - - call this%ddx_R2R(dw, bf)! i=3, j=1 - buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,3) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer - this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = bf * this%delta_tauij(:,:,:,3) - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer - this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * wcbase * ubase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * du * wcbase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * ubase * dw - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * du * dw - - call this%ddy_R2R(dw, bf)! i=3, j=2 - buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,5) + 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 - buffer = bf * this%delta_tauij(:,:,:,5) + + ! 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 - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * wcbase * vbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ bf * dv * wcbase - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ bf * vbase * dw - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dv * dw - - call this%ddz_R2R(dw, bf)! i=3, j=3 - buffer = bf * this%pre_budget%igrid_sim%tauSGS_ij(:,:,:,6) - this%budget_3(:,:,:,5) = this%budget_3(:,:,:,5) + buffer - this%budget_3(:,:,:,8) = this%budget_3(:,:,:,8) + buffer - buffer = bf * this%delta_tauij(:,:,:,6) - this%budget_3(:,:,:,6) = this%budget_3(:,:,:,6) + buffer - this%budget_3(:,:,:,9) = this%budget_3(:,:,:,9) + buffer - this%budget_3(:,:,:,14)= this%budget_3(:,:,:,14)+ bf * wcbase * wcbase - buffer = bf * dw * wcbase - this%budget_3(:,:,:,15)= this%budget_3(:,:,:,15)+ buffer - this%budget_3(:,:,:,16)= this%budget_3(:,:,:,16)+ buffer - this%budget_3(:,:,:,17)= this%budget_3(:,:,:,17)+ bf * dw * dw ! 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%prim_budget%wb - this%pre_budget%wb call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) - call this%interp_Edge2Cell(rbuffxE1, buffer) - this%budget_3(:,:,:,10) = this%budget_3(:,:,:,10) + dw * buffer - this%budget_3(:,:,:,12) = this%budget_3(:,:,:,12) + wcbase * buffer + + rbuffxE2 = rbuffxE1 * (this%prim_budget%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) - call this%interp_Edge2Cell(rbuffxE1, buffer) - this%budget_3(:,:,:,11) = this%budget_3(:,:,:,11) + dw * buffer + rbuffxE2 = (this%prim_budget%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%prim_budget%uturb - this%pre_budget%uturb call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) - this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + du * buffer - this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + ubase * buffer + this%budget_3(:,:,:,20) = this%budget_3(:,:,:,20) + du * buffer + this%budget_3(:,:,:,21) = this%budget_3(:,:,:,21) + ubase * buffer cbuffyC1 = this%prim_budget%vturb - this%pre_budget%vturb call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) - this%budget_3(:,:,:,18) = this%budget_3(:,:,:,18) + dv * buffer - this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + vbase * 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, buffer, bf, cbuffyE1, cbuffyC1, ubase, vbase, wcbase) + 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) @@ -1064,220 +928,160 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) else if(budgetid.eq.2)then select case(idx) case(1) - buffer = this%budget_0(:,:,:,1)*this%extraCellFields(:,:,:,1) + & - this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,2) + & - this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,3) + 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%extraCellFields(:,:,:,4) + & - this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,5) + & - this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,6) + 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%extraCellFields(:,:,:,7) + & - this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,8) + & - this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,9) + 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%extraCellFields(:,:,:,1) + & - this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,2) + & - this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,3) + 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%extraCellFields(:,:,:,4) + & - this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,5) + & - this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,6) + 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%extraCellFields(:,:,:,7) + & - this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,8) + & - this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,9) + 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%extraCellFields(:,:,:,10) + & - this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,11) + & - this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,12) + 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%extraCellFields(:,:,:,13) + & - this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,14) + & - this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,15) + 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%extraCellFields(:,:,:,16) + & - this%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,17) + & - this%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,18) + 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%extraCellFields(:,:,:,10) + & - this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,11) + & - this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,12) + 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%extraCellFields(:,:,:,13) + & - this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,14) + & - this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,15) + 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%extraCellFields(:,:,:,16) + & - this%pre_budget%budget_0(:,:,:,2)*this%extraCellFields(:,:,:,17) + & - this%pre_budget%budget_0(:,:,:,3)*this%extraCellFields(:,:,:,18) + 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 - call this%dealias(buffer) else if(budgetid.eq.3)then select case(idx) - case(1) ! d_j(delta u_j' delta p') - buffer = buffer + this%budget_0(:,:,:,1)*this%budget_0(:,:,:,18) - buffer = buffer + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,19) - buffer = buffer + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,20) - case(2) ! d_j(base u_j' delta p') - buffer = buffer + this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,18) - buffer = buffer + this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,19) - buffer = buffer + this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,20) - - case(3) ! d_j(delta u_j' base p') + 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 = buffer - this%budget_0(:,:,:,1)*this%pre_budget%budget_1(:,:,:,2) - buffer = buffer - this%budget_0(:,:,:,2)*this%pre_budget%budget_1(:,:,:,6) - buffer = buffer - this%budget_0(:,:,:,3)*this%pre_budget%budget_1(:,:,:,9) + 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 = buffer + this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,12) - buffer = buffer + this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,13) - buffer = buffer + this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,14) - - ! The rest of the term is the same as that of B3(7) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1),bf) - buffer=buffer + bf * this%budget_0(:,:,:,6) ! i=1, j=1 - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1),bf) - buffer=buffer + bf * this%budget_0(:,:,:,7) ! i=1, j=2 - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1),bf) - buffer=buffer + bf * this%budget_0(:,:,:,8) ! i=1, j=3 - - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2),bf) - buffer=buffer + bf * this%budget_0(:,:,:,7) ! i=2, j=1 - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2),bf) - buffer=buffer + bf * this%budget_0(:,:,:,9) ! i=2, j=2 - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2),bf) - buffer=buffer + bf * this%budget_0(:,:,:,10) ! i=2, j=3 - - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3),bf) - buffer=buffer + bf * this%budget_0(:,:,:,8) ! i=3, j=1 - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3),bf) - buffer=buffer + bf * this%budget_0(:,:,:,10) ! i=3, j=2 - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3),bf) - buffer=buffer + bf * this%budget_0(:,:,:,11) ! i=3, j=3 + 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 = buffer - this%budget_0(:,:,:,1)*this%pre_budget%budget_1(:,:,:,3) - buffer = buffer - this%budget_0(:,:,:,2)*this%pre_budget%budget_1(:,:,:,7) - buffer = buffer - this%budget_0(:,:,:,3)*this%pre_budget%budget_1(:,:,:,10) - - ! The rest of this term is the same as B3(8) - call this%ddx_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,11) ! i=1, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,12) ! i=1, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,13) ! i=1, j=3 - - call this%ddx_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,12) ! i=2, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,14) ! i=2, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,15) ! i=2, j=3 - - call this%ddx_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,13) ! i=3, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,15) ! i=3, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,16) ! i=3, j=3 - + 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 = buffer + this%budget_0(:,:,:,1)*this%budget_0(:,:,:,12) - buffer = buffer + this%budget_0(:,:,:,2)*this%budget_0(:,:,:,13) - buffer = buffer + this%budget_0(:,:,:,3)*this%budget_0(:,:,:,14) - - ! The rest of this term is the same as B3(9) - call this%ddx_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%budget_0(:,:,:,6) ! i=1, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%budget_0(:,:,:,7) ! i=1, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%budget_0(:,:,:,8) ! i=1, j=3 - - call this%ddx_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%budget_0(:,:,:,7) ! i=2, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%budget_0(:,:,:,9) ! i=2, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%budget_0(:,:,:,10) ! i=2, j=3 - - call this%ddx_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%budget_0(:,:,:,8) ! i=3, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%budget_0(:,:,:,10) ! i=3, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%budget_0(:,:,:,11) ! i=3, j=3 + 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] - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1),bf) - buffer=buffer + bf * this%budget_0(:,:,:,6) ! i=1, j=1 - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1),bf) - buffer=buffer + bf * this%budget_0(:,:,:,7) ! i=1, j=2 - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1),bf) - buffer=buffer + bf * this%budget_0(:,:,:,8) ! i=1, j=3 - - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2),bf) - buffer=buffer + bf * this%budget_0(:,:,:,7) ! i=2, j=1 - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2),bf) - buffer=buffer + bf * this%budget_0(:,:,:,9) ! i=2, j=2 - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2),bf) - buffer=buffer + bf * this%budget_0(:,:,:,10) ! i=2, j=3 - - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3),bf) - buffer=buffer + bf * this%budget_0(:,:,:,8) ! i=3, j=1 - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3),bf) - buffer=buffer + bf * this%budget_0(:,:,:,10) ! i=3, j=2 - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3),bf) - buffer=buffer + bf * this%budget_0(:,:,:,11) ! i=3, j=3 + 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] - call this%ddx_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,11) ! i=1, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,12) ! i=1, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,13) ! i=1, j=3 - - call this%ddx_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,12) ! i=2, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,14) ! i=2, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,15) ! i=2, j=3 - - call this%ddx_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,13) ! i=3, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,15) ! i=3, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%pre_budget%budget_0(:,:,:,16) ! i=3, j=3 + 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] - call this%ddx_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%budget_0(:,:,:,6) ! i=1, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%budget_0(:,:,:,7) ! i=1, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,1),bf) - buffer=buffer+bf*this%budget_0(:,:,:,8) ! i=1, j=3 - - call this%ddx_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%budget_0(:,:,:,7) ! i=2, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%budget_0(:,:,:,9) ! i=2, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,2),bf) - buffer=buffer+bf*this%budget_0(:,:,:,10) ! i=2, j=3 - - call this%ddx_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%budget_0(:,:,:,8) ! i=3, j=1 - call this%ddy_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%budget_0(:,:,:,10) ! i=3, j=2 - call this%ddz_R2R(this%budget_0(:,:,:,3),bf) - buffer=buffer+bf*this%budget_0(:,:,:,11) ! i=3, j=3 + 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) @@ -1288,154 +1092,148 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) case(12) ! base u_3' delta wb' buffer = this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,17) - case(13) ! d_j(delta u_j' base u_i' base u_i')/2 [Turbulent transport of TKE] - bf = 0.5d0*(this%pre_budget%budget_0(:,:,:,4) + this%pre_budget%budget_0(:,:,:,7) + this%pre_budget%budget_0(:,:,:,9)) & - - (this%pre_budget%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,1) + & - this%pre_budget%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,2) + & - this%pre_budget%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,3)) + 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); buffer = buffer + this%budget_0(:,:,:,3)*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%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)) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,7) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,9) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,11) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,8) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,12) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,14) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,10) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,13) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,15) - - case(14) ! d_j(base u_j' base u_i' delta u_i') [Turbulent transport of TKE] - bf = this%budget_1(:,:,:,7) + this%budget_1(:,:,:,12) + this%budget_1(:,:,:,15) - & - 2.d0 * (this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) + & - this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,2) + & - this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,3)) - 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 - call this%ddz_R2R(bf, bf2); buffer = buffer + this%pre_budget%budget_0(:,:,:,3)*bf2 - - buffer = buffer + this%pre_budget%budget_0(:,:,:,1)*this%budget_2(:,:,:,7) + & - this%pre_budget%budget_0(:,:,:,2)*this%budget_2(:,:,:,8) + & - this%pre_budget%budget_0(:,:,:,3)*this%budget_2(:,:,:,9) - - call this%ddx_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,4) - call this%ddy_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,5) - call this%ddz_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,6) - call this%ddx_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,5) - call this%ddy_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,7) - call this%ddz_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,8) - call this%ddx_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,6) - call this%ddy_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,8) - call this%ddz_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%pre_budget%budget_0(:,:,:,9) + 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) - - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,7) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,8) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,10) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,9) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,12) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,13) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,11) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,14) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,15) + 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(15) ! d_j(delta u_j' base u_i' delta u_i') [Turbulent transport of TKE] - bf = this%budget_1(:,:,:,7) + this%budget_1(:,:,:,12) + this%budget_1(:,:,:,15) - & - 2.d0 * (this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) + & - this%pre_budget%budget_0(:,:,:,2)*this%budget_0(:,:,:,2) + & - this%pre_budget%budget_0(:,:,:,3)*this%budget_0(:,:,:,3)) - 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); buffer = buffer + this%budget_0(:,:,:,3)*bf2 - - buffer = buffer + 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) - call this%ddx_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,7) - call this%ddy_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,9) - call this%ddz_R2R(this%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,11) - call this%ddx_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,8) - call this%ddy_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,12) - call this%ddz_R2R(this%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,14) - call this%ddx_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,10) - call this%ddy_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,13) - call this%ddz_R2R(this%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,15) - - buffer = buffer + this%budget_0(:,:,:,1)*this%budget_2(:,:,:,4) + & - this%budget_0(:,:,:,2)*this%budget_2(:,:,:,5) + & - this%budget_0(:,:,:,3)*this%budget_2(:,:,:,6) - - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,1) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,2) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,1), bf); buffer = buffer + bf*this%budget_1(:,:,:,3) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,2) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,4) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,2), bf); buffer = buffer + bf*this%budget_1(:,:,:,5) - call this%ddx_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,3) - call this%ddy_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,5) - call this%ddz_R2R(this%pre_budget%budget_0(:,:,:,3), bf); buffer = buffer + bf*this%budget_1(:,:,:,6) - - case(16) ! d_j(base u_j' delta u_i' delta u_i')/2 [Turbulent transport of TKE] - bf = 0.5d0*(this%budget_1(:,:,:,1) + this%budget_1(:,:,:,4) + this%budget_1(:,:,:,6)) & - - (this%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) + & - this%budget_0(:,:,:,2)*this%budget_0(:,:,:,2) + & - this%budget_0(:,:,:,3)*this%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 - call this%ddz_R2R(bf, bf2); buffer = buffer + this%pre_budget%budget_0(:,:,:,3)*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) - - call this%ddx_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,7) - call this%ddy_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,8) - call this%ddz_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,10) - call this%ddx_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,9) - call this%ddy_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,12) - call this%ddz_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,13) - call this%ddx_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,11) - call this%ddy_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,14) - call this%ddz_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,15) - - case(17) ! d_j(delta u_j' delta u_i' delta u_i')/2 [Turbulent transport of TKE] - bf = 0.5d0*(this%budget_1(:,:,:,1) + this%budget_1(:,:,:,4) + this%budget_1(:,:,:,6)) & - - (this%budget_0(:,:,:,1)*this%budget_0(:,:,:,1) + & - this%budget_0(:,:,:,2)*this%budget_0(:,:,:,2) + & - this%budget_0(:,:,:,3)*this%budget_0(:,:,:,3)) + 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 - call this%ddz_R2R(bf, bf2); buffer = buffer + this%budget_0(:,:,:,3)*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) - - call this%ddx_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,1) - call this%ddy_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,2) - call this%ddz_R2R(this%budget_0(:,:,:,1),bf); buffer=buffer+bf*this%budget_1(:,:,:,3) - call this%ddx_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,2) - call this%ddy_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,4) - call this%ddz_R2R(this%budget_0(:,:,:,2),bf); buffer=buffer+bf*this%budget_1(:,:,:,5) - call this%ddx_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,3) - call this%ddy_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,5) - call this%ddz_R2R(this%budget_0(:,:,:,3),bf); buffer=buffer+bf*this%budget_1(:,:,:,6) - - case(18) + 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(19) + 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 @@ -1572,9 +1370,64 @@ subroutine RestartBudget(this, dir, rid, tid, cid) 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 @@ -1585,8 +1438,7 @@ subroutine ResetBudget(this) 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%extraCellFields)) this%extraCellFields = zero - if(allocated(this%extraEdgeFields)) this%extraEdgeFields = zero + if(allocated(this%MCG)) this%MCG = zero end subroutine subroutine destroy(this) @@ -1599,7 +1451,7 @@ subroutine destroy(this) 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%extraCellFields)) deallocate(this%extraCellFields) + if(allocated(this%MCG)) deallocate(this%MCG) end if end subroutine @@ -1617,97 +1469,131 @@ 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_budget%igrid_sim%cbuffyC(:,:,:,1) - call this%prim_budget%igrid_sim%spectC%fft(f,this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%prim_budget%igrid_sim%spectC%mtimes_ik1_ip(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdx) + call this%prim_budget%igrid_sim%spectC%fft(f, cbuffyC) + call this%prim_budget%igrid_sim%spectC%mtimes_ik1_ip(cbuffyC) + call this%prim_budget%igrid_sim%spectC%dealias(cbuffyC) + call this%prim_budget%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_budget%igrid_sim%cbuffyC(:,:,:,1) - call this%prim_budget%igrid_sim%spectC%fft(f,this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%prim_budget%igrid_sim%spectC%mtimes_ik2_ip(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdy) + call this%prim_budget%igrid_sim%spectC%fft(f, cbuffyC) + call this%prim_budget%igrid_sim%spectC%mtimes_ik2_ip(cbuffyC) + call this%prim_budget%igrid_sim%spectC%dealias(cbuffyC) + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC, dfdy) + + nullify(cbuffyC) end subroutine - subroutine ddz_R2R(this, f, dfdz) - class(budgets_time_avg_deficit_compact), intent(inout) :: this + 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 - call this%prim_budget%igrid_sim%spectC%fft(f,this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%ddz_C2R(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdz) + cbuffyC => this%prim_budget%igrid_sim%cbuffyC(:,:,:,1) + cbuffzC1 => this%prim_budget%igrid_sim%cbuffzC(:,:,:,1) + cbuffzC2 => this%prim_budget%igrid_sim%cbuffzC(:,:,:,2) + + call this%prim_budget%igrid_sim%spectC%fft(f, cbuffyC) + call transpose_y_to_z(cbuffyC, cbuffzC1, this%prim_budget%igrid_sim%sp_gpC) + call this%prim_budget%igrid_sim%Pade6opZ%ddz_C2C(cbuffzC1, cbuffzC2, n1, n2) + call transpose_z_to_y(cbuffzC2, cbuffyC, this%prim_budget%igrid_sim%sp_gpC) + call this%prim_budget%igrid_sim%spectC%dealias(cbuffyC) + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC, dfdz) + + nullify(cbuffyC, cbuffzC1, cbuffzC2) end subroutine - subroutine ddz_C2R(this, fhat, dfdz) - class(budgets_time_avg_deficit_compact), intent(inout) :: this - complex(rkind), dimension(this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(1),this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(2),this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(3)), intent(in) :: fhat - real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: dfdz + ! subroutine ddz_C2R(this, fhat, dfdz, n1, n2) + ! class(budgets_time_avg_deficit_compact), intent(inout) :: this + ! complex(rkind), dimension(this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(1),this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(2),this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(3)), intent(in) :: fhat + ! real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: dfdz + ! integer, intent(in) :: n1, n2 - call transpose_y_to_z(fhat,this%prim_budget%igrid_sim%cbuffzC(:,:,:,1),this%prim_budget%igrid_sim%sp_gpC) - call this%prim_budget%igrid_sim%Pade6opZ%ddz_C2C(this%prim_budget%igrid_sim%cbuffzC(:,:,:,1),this%prim_budget%igrid_sim%cbuffzC(:,:,:,2),0,0) - call transpose_z_to_y(this%prim_budget%igrid_sim%cbuffzC(:,:,:,2),this%prim_budget%igrid_sim%cbuffyC(:,:,:,1),this%prim_budget%igrid_sim%sp_gpC) - call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdz) - end subroutine + ! call transpose_y_to_z(fhat,this%prim_budget%igrid_sim%cbuffzC(:,:,:,1),this%prim_budget%igrid_sim%sp_gpC) + ! call this%prim_budget%igrid_sim%Pade6opZ%ddz_C2C(this%prim_budget%igrid_sim%cbuffzC(:,:,:,1),this%prim_budget%igrid_sim%cbuffzC(:,:,:,2),n1,n2) + ! call transpose_z_to_y(this%prim_budget%igrid_sim%cbuffzC(:,:,:,2),this%prim_budget%igrid_sim%cbuffyC(:,:,:,1),this%prim_budget%igrid_sim%sp_gpC) + ! call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) + ! call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdz) + ! end subroutine - subroutine interp_Edge2Cell(this, fE, fC) - class(budgets_time_avg_deficit_compact), intent(inout) :: this + subroutine interp_Edge2Cell(this, fE, fC, n1, n2) + class(budgets_time_avg_deficit_compact), intent(inout), target :: this real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%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_budget%igrid_sim%rbuffyE(:,:,:,1) + rbuffzE => this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) + rbuffzC => this%prim_budget%igrid_sim%rbuffzC(:,:,:,2) + rbuffyC => this%prim_budget%igrid_sim%rbuffyC(:,:,:,1) + + call transpose_x_to_y(fE, rbuffyE, this%prim_budget%igrid_sim%gpE) + call transpose_y_to_z(rbuffyE, rbuffzE, this%prim_budget%igrid_sim%gpE) + call this%prim_budget%igrid_sim%Pade6opZ%interpz_E2C(rbuffzE, rbuffzC, n1, n2) + call transpose_z_to_y(rbuffzC, rbuffyC, this%prim_budget%igrid_sim%gpC) + call transpose_y_to_x(rbuffyC, fC, this%prim_budget%igrid_sim%gpC) - call transpose_x_to_y(fE,this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),this%prim_budget%igrid_sim%gpE) - call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%gpE) - call this%prim_budget%igrid_sim%Pade6opZ%interpz_E2C(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,2),0,0) - call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzC(:,:,:,2),this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),fC,this%prim_budget%igrid_sim%gpC) + nullify(rbuffyE, rbuffzE, rbuffzC, rbuffyC) end subroutine - subroutine interp_Cell2Edge(this, fC, fE) - class(budgets_time_avg_deficit_compact), intent(inout) :: this - real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: fC - real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(out) :: fE - - call transpose_x_to_y(fC,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),0,0) - call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),this%prim_budget%igrid_sim%gpE) - call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),fE,this%prim_budget%igrid_sim%gpE) - end subroutine + ! subroutine interp_Cell2Edge(this, fC, fE, n1, n2) + ! class(budgets_time_avg_deficit_compact), intent(inout) :: this + ! real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: fC + ! real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(out) :: fE + + ! call transpose_x_to_y(fC,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + ! call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + ! call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),n1,n2) + ! call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),this%prim_budget%igrid_sim%gpE) + ! call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),fE,this%prim_budget%igrid_sim%gpE) + ! end subroutine - subroutine multiply_CellFieldsOnEdges(this, f1C, f2C, fmultC) - class(budgets_time_avg_deficit_compact), intent(inout) :: this - real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: f1C,f2C - real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: fmultC - - ! interpolate 1st Cell field - call transpose_x_to_y(f1C,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),0,0) - - ! interpolate 2nd Cell field - call transpose_x_to_y(f2C,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,2),0,0) - - ! multiply on Edges and interpolate back to Cells - this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) = this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) * this%prim_budget%igrid_sim%rbuffzE(:,:,:,2) - call this%prim_budget%igrid_sim%Pade6opZ%interpz_E2C(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),0,0) - call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),fmultC,this%prim_budget%igrid_sim%gpC) - end subroutine + ! subroutine multiply_CellFieldsOnEdges(this, f1C, f2C, fmultC, n1, n2) + ! class(budgets_time_avg_deficit_compact), intent(inout) :: this + ! real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: f1C,f2C + ! real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: fmultC + ! integer, intent(in) :: n1, n2 + + ! ! interpolate 1st Cell field + ! call transpose_x_to_y(f1C,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + ! call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + ! call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),n1,n2) + + ! ! interpolate 2nd Cell field + ! call transpose_x_to_y(f2C,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + ! call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + ! call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,2),n1,n2) + + ! ! multiply on Edges and interpolate back to Cells + ! this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) = this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) * this%prim_budget%igrid_sim%rbuffzE(:,:,:,2) + ! call this%prim_budget%igrid_sim%Pade6opZ%interpz_E2C(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),n1,n2) + ! call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) + ! call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),fmultC,this%prim_budget%igrid_sim%gpC) + ! end subroutine ! multiply on edge cells and interpolate to cell centers to reduce aliasing issues - function multiply_Edges_interp_cell(this, f1E, f2E) result(fmultC) - class(budgets_time_avg_deficit_compact), intent(inout) :: this - real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(in) :: f1E,f2E - real(rkind), dimension(this%prim_budget%igrid_sim%gpC%xsz(1),this%prim_budget%igrid_sim%gpC%xsz(2),this%prim_budget%igrid_sim%gpC%xsz(3)) :: fmultC - - call this%interp_Edge2Cell(f1E * f2E, fmultC) - end function -end module \ No newline at end of file + ! function multiply_Edges_interp_cell(this, f1E, f2E, n1, n2) result(fmultC) + ! class(budgets_time_avg_deficit_compact), intent(inout) :: this + ! real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(in) :: f1E,f2E + ! real(rkind), dimension(this%prim_budget%igrid_sim%gpC%xsz(1),this%prim_budget%igrid_sim%gpC%xsz(2),this%prim_budget%igrid_sim%gpC%xsz(3)) :: fmultC + ! integer, intent(in) :: n1, n2 + + ! call this%interp_Edge2Cell(f1E * f2E, fmultC, n1, n2) + ! end function +end module diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index 0300ee0d..c9d7fd12 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -32,7 +32,10 @@ module IncompressibleGrid external :: MPI_BCAST, MPI_RECV, MPI_SEND, MPI_REDUCE 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 From 495d00a2b183dc0ef7baa11a435b7be4af2d0607 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 4 Feb 2026 15:12:59 -0500 Subject: [PATCH 023/114] fix size of budget 3 --- .../budget_time_avg_deficit_compact.F90 | 75 +++++++------------ 1 file changed, 25 insertions(+), 50 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index d13c1920..61c2b568 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -165,9 +165,9 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) if(this%do_budget3)then if(this%useWindTurbines)then - this%size_budget_3 = 19 + this%size_budget_3 = 21 else - this%size_budget_3 = 17 + 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)) @@ -234,13 +234,6 @@ subroutine updateBudget(this) call this%prim_budget%igrid_sim%sgsmodel%populate_tauij_E_to_C() this%delta_tauij = this%prim_budget%igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij - ! To be multiplied by every term added to the sum - ! if(this%time_weighted_average)then - ! this%weight = this%prim_budget%igrid_sim%dt - ! else - ! this%weight = real(1., rkind) - ! end if - if(this%doMCG) call this%AssembleMCG() if(this%do_budget0) call this%AssembleBudget0() if(this%do_budget1) call this%AssembleBudget1() @@ -248,7 +241,6 @@ subroutine updateBudget(this) if(this%do_budget3) call this%AssembleBudget3() this%counter = this%counter + 1 - ! this%timeSum = this%timeSum + this%prim_budget%igrid_sim%dt end subroutine subroutine DumpBudget(this) @@ -259,12 +251,6 @@ subroutine DumpBudget(this) real(rkind), dimension(:,:,:,:), pointer :: budget logical :: doBudget - ! if(this%time_weighted_average)then - ! totalWeight = this%timeSum + 1.d-18 - ! call this%writeTimeSum() - ! else - ! totalWeight = real(this%counter,rkind) + 1.d-18 - ! end if totalWeight = real(this%counter,rkind) + 1.d-18 ! Cell x-pencil buffers @@ -295,28 +281,21 @@ subroutine DumpBudget(this) end if ! Dealias budgets 1-3 as they hold product of multiple fields - 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_budget2 - end select - - if(doBudget)then - do idx = 1,budgetsize - call this%dealias(budget(:,:,:,idx)) - end do - end if - end do + 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) @@ -356,13 +335,6 @@ subroutine DumpBudget(this) end if end do - ! MCG. Need to write it to be able to restart budgets - ! if(this%this%doMCG)then - ! do idx = 1, size(this%MCG, 4) - ! call this%dump_budget_field(this%MCG(:,:,:,idx), idx, 4) - ! 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 @@ -658,7 +630,7 @@ subroutine AssembleBudget3(this) buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) ! Cell y-pencil buffer - cbuffyC1 => this%prim_budget%igrid_sim%cbuffyC(:,:,:,2) + cbuffyC1 => this%prim_budget%igrid_sim%cbuffyC(:,:,:,2) ! 1 is used in ddx, ddy, ddz routines ! Edge x-pencil buffer rbuffxE1 => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) @@ -1457,12 +1429,15 @@ subroutine destroy(this) ! ----------------------private derivative operators ------------------------ subroutine dealias(this, f) - class(budgets_time_avg_deficit_compact), intent(inout) :: this + 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_budget%igrid_sim%cbuffyC(:,:,:,1) - call this%prim_budget%igrid_sim%spectC%fft(f,this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), f) + call this%prim_budget%igrid_sim%spectC%fft(f, cbuffyC) + call this%prim_budget%igrid_sim%spectC%dealias(cbuffyC) + call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC, f) end subroutine subroutine ddx_R2R(this, f, dfdx) From 0b42c7a0013ee03e1d92344abfdda23b73c578fd Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 4 Feb 2026 17:45:08 -0500 Subject: [PATCH 024/114] comment out the turbine forcing covariance (small and very local) --- .../budget_time_avg_deficit_compact.F90 | 32 +++++++++---------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index 61c2b568..c4fb8098 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -165,9 +165,9 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) if(this%do_budget3)then if(this%useWindTurbines)then - this%size_budget_3 = 21 - else this%size_budget_3 = 19 + else + this%size_budget_3 = 17 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)) @@ -834,17 +834,17 @@ subroutine AssembleBudget3(this) 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%prim_budget%uturb - this%pre_budget%uturb - call this%prim_budget%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 + ! if (this%useWindTurbines)then + ! cbuffyC1 = this%prim_budget%uturb - this%pre_budget%uturb + ! call this%prim_budget%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%prim_budget%vturb - this%pre_budget%vturb - call this%prim_budget%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 + ! cbuffyC1 = this%prim_budget%vturb - this%pre_budget%vturb + ! call this%prim_budget%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) @@ -1195,10 +1195,10 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) 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) + ! 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 From 02291f5f5c9e90a15e8dac28f58c0ddfb999f23a Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 10 Feb 2026 15:25:01 -0500 Subject: [PATCH 025/114] comment out turbine forcing from TKE budget --- .../budget_time_avg_deficit_compact.F90 | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index c4fb8098..9d317df4 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -117,7 +117,7 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) this%tidx_compute = tidx_compute this%tidx_budget_start = tidx_budget_start this%time_budget_start = time_budget_start - this%useWindTurbines = this%prim_budget%igrid_sim%useWindTurbines + !this%useWindTurbines = this%prim_budget%igrid_sim%useWindTurbines this%isStratified = this%prim_budget%igrid_sim%isStratified this%useCoriolis = this%prim_budget%igrid_sim%useCoriolis ! Deactivate time-weighted sum till time-averaged budgets are weighted similarily @@ -165,9 +165,9 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) if(this%do_budget3)then if(this%useWindTurbines)then - this%size_budget_3 = 19 + this%size_budget_3 = 21 else - this%size_budget_3 = 17 + 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)) @@ -1153,6 +1153,7 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) 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)) @@ -1272,15 +1273,7 @@ subroutine RestartBudget(this, dir, rid, tid, cid) ! Cell x-pencil buffers buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) - this%counter = cid - - ! if(this%time_weighted_average)then - ! ! If this is time-weighted averaging, we should read the sum of times - ! call this%readTimeSum(trim(dir),rid,tid,cid) - ! totalWeight = this%timeSum + 1.d-18 - ! else - ! totalWeight = real(this%counter,rkind) + 1.d-18 - ! end if + this%counter = cid totalWeight = real(this%counter,rkind) + 1.d-18 ! I assume here that this%pre_budget%budget_0 and From 04cd7ab602a1c83974344417ed306f4c41de1849 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 10 Feb 2026 16:06:33 -0500 Subject: [PATCH 026/114] update temperature initialization --- .../gablsdyn_igrid_files/initialize.F90 | 43 ++++++++--------- .../initialize.F90 | 46 +++++++++---------- 2 files changed, 40 insertions(+), 49 deletions(-) diff --git a/problems/incompressible/gablsdyn_igrid_files/initialize.F90 b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 index 2ce2af55..7b16b9ab 100644 --- a/problems/incompressible/gablsdyn_igrid_files/initialize.F90 +++ b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 @@ -81,10 +81,10 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) real(rkind), dimension(:,:,:), allocatable :: ybuffC, ybuffE, zbuffC, zbuffE integer :: nz, nzE, k real(rkind) :: sig - real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = zero, Tsurf0 = one, dTsurf_dt = -0.05d0, z0init = 1.d-4, frameAngle = -26.d0, z_Tref = zero, T_inv = zero, dTdz = zero + 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, z0init, frameAngle, z_Tref, T_inv, dTdz + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -104,21 +104,19 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) u = one v = zero wC = zero - ! Added to account for frame angle - !u = u * cos(frameAngle * pi / 180.d0) - !v = v * sin(frameAngle * pi / 180.d0) allocate(Tpurt(decompC%xsz(1),decompC%xsz(2),decompC%xsz(3))) - T = dTdz*(z - z_Tref) + Tsurf0 + T_inv - where(z < z_Tref) - T = Tsurf0 + 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) @@ -163,8 +161,8 @@ subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) 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, z0init = 1.d-4, dTsurf_dt, z_Tref, T_inv, dTdz - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, z_Tref, T_inv, dTdz + 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 + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -182,9 +180,9 @@ subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) 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, z0init = 1.d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz - + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) @@ -253,11 +251,9 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) 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, z0init = 1.d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz - !real(rkind) :: beta, sigma, phi_ref - !integer :: z_ref - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz - + 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 + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) @@ -303,12 +299,9 @@ subroutine set_Reference_Temperature(inputfile, Thetaref) 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, z0init = 2.5d-4, frameAngle = 0.d0, z_Tref, T_inv, dTdz - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle, z_Tref, T_inv, dTdz - !real(rkind) :: beta, sigma, phi_ref - !integer :: z_ref - !namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, z0init, frameAngle!, beta, sigma, phi_ref, z_ref - + 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 + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) diff --git a/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 index fe6c4b6d..ce02db50 100644 --- a/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 +++ b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 @@ -78,15 +78,15 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) 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 + real(rkind), dimension(:,:,:), allocatable :: ybuffC, ybuffE, zbuffC, zbuffE 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) :: 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 + ! 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') @@ -103,12 +103,12 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) 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 + 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 @@ -121,12 +121,12 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) end do deallocate(randArr) - where (ztmp > 50.d0) + where (z > 50.d0/xdim) Tpurt = zero end where T = T + Tpurt - deallocate(ztmp, Tpurt) + deallocate(Tpurt) !!!!!!!!!!!!!!!!!!!!! DON'T CHANGE ANYTHING UNDER THIS !!!!!!!!!!!!!!!!!!!!!! ! Interpolate wC to w @@ -159,8 +159,8 @@ subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) 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 + 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 + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -178,9 +178,9 @@ subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) 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 - + real(rkind) :: Lx = one, Ly = one, Lz = one, Tref = one, Tsurf0 = one, inv_height = zero, lapse_rate = zero, inv_thickness = one, inv_strength = zero + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) @@ -249,11 +249,9 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) 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 - + 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 + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) @@ -299,9 +297,9 @@ subroutine set_Reference_Temperature(inputfile, Thetaref) 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 - + 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 + namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') read(unit=ioUnit, NML=PROBLEM_INPUT) From 7b5e8cafcbb36b358dd7a22c3ea389225ea64b5c Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sun, 15 Feb 2026 13:55:42 -0500 Subject: [PATCH 027/114] Fatal error when any pencil thickness = 1 and turbines are used --- src/incompressible/igrid.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index c9d7fd12..3e24c7c7 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -548,6 +548,11 @@ 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 From 4e78d0897171850d4cb5b23b89bafa1a93aabdd2 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sun, 15 Feb 2026 13:56:49 -0500 Subject: [PATCH 028/114] some cleanup --- problems/turbines/pre_conc_compact_budgets.F90 | 5 ----- .../turbines/pre_conc_compact_budgets_files/initialize.F90 | 6 +++--- 2 files changed, 3 insertions(+), 8 deletions(-) diff --git a/problems/turbines/pre_conc_compact_budgets.F90 b/problems/turbines/pre_conc_compact_budgets.F90 index 1bdff60b..e6b5b857 100644 --- a/problems/turbines/pre_conc_compact_budgets.F90 +++ b/problems/turbines/pre_conc_compact_budgets.F90 @@ -11,7 +11,6 @@ program pre_conc_compactbudgets 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 budgets_time_avg_deficit_compact_mod, only: budgets_time_avg_deficit_compact use exits, only: message, gracefulExit @@ -21,7 +20,6 @@ program pre_conc_compactbudgets 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 type(budgets_time_avg_deficit_compact) :: budg_tavg_deficit_compact real(rkind) :: dt1, dt2, dt logical :: synchronize_RK_fringe = .true., do_deficit_budgets = .false. @@ -73,7 +71,6 @@ program pre_conc_compactbudgets 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) call budg_tavg_deficit_compact%init(pre_budg_tavg, primary_inputfile, budg_tavg) end if @@ -117,7 +114,6 @@ program pre_conc_compactbudgets call budg_tavg%doBudgets() call pre_budg_tavg%doBudgets() - !if (do_deficit_budgets) call budg_tavg_deficit%doBudgets() if (do_deficit_budgets) call budg_tavg_deficit_compact%doBudgets() call doTemporalStuff(primary, 1) @@ -130,7 +126,6 @@ program pre_conc_compactbudgets 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() if (do_deficit_budgets) call budg_tavg_deficit_compact%destroy() call precursor%finalize_io() diff --git a/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 index ce02db50..cf2272b6 100644 --- a/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 +++ b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 @@ -68,7 +68,7 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) use random, only: gaussian_random use decomp_2d use reductions, only: p_maxval - use pre_conc_compact_budgets_parameters, only: xdim, seedu, message + use pre_conc_compact_budgets_parameters implicit none type(decomp_info), intent(in) :: decompC type(decomp_info), intent(in) :: decompE @@ -172,7 +172,7 @@ subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) use kind_parameters, only: rkind - use pre_conc_compact_budgets_parameters, only: timeDim + use pre_conc_compact_budgets_parameters use constants, only: one, zero implicit none real(rkind), intent(out) :: Tsurf, dTsurf_dt @@ -237,7 +237,7 @@ subroutine hook_probes(inputfile, probe_locs) subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) - use pre_conc_compact_budgets_parameters, only: nxg, nyg, nzg + use pre_conc_compact_budgets_parameters use kind_parameters, only: rkind use constants, only: zero, one, two use decomp_2d, only: decomp_info From bd90b96b4e0745134e3324489f97e1f5a9f9dee8 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 16 Feb 2026 16:32:23 -0500 Subject: [PATCH 029/114] A program to compute derivatives offline --- problems/postprocessing_igrid/Derivatives.F90 | 242 ++++++++++++++++++ .../Derivatives_files/input_derivatives.dat | 18 ++ 2 files changed, 260 insertions(+) create mode 100644 problems/postprocessing_igrid/Derivatives.F90 create mode 100644 problems/postprocessing_igrid/Derivatives_files/input_derivatives.dat diff --git a/problems/postprocessing_igrid/Derivatives.F90 b/problems/postprocessing_igrid/Derivatives.F90 new file mode 100644 index 00000000..b0bcb1b5 --- /dev/null +++ b/problems/postprocessing_igrid/Derivatives.F90 @@ -0,0 +1,242 @@ +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 + 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 + +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() + + namelist /INPUT/ inputdir, outputdir, nx, ny, nz, Lx, Ly, Lz, prow, pcol, filename, derivative_type, & + 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 + + ! Read input + tmpname = trim(inputdir)//"/"//trim(filename) + 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) + + ! Derivative selection + select case (derivative_type) + 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_type. Must be 'x', 'y', or 'z'.", 103) + end select + + ! Write output + outfile = trim(outputdir)//"/"//trim(tag)//"_"//trim(filename) + call message(1, 'Writing '//trim(outfile)) + call decomp_2d_write_one(1, deriv, trim(outfile), gp) + + ! 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 From 4f1c312edda369c114ddad0360a6dacfbb476169 Mon Sep 17 00:00:00 2001 From: Kirby Heck Date: Mon, 3 Nov 2025 10:46:49 -0500 Subject: [PATCH 030/114] Adding dx, dy, dz to turbine init in case the processor grid only has 1 grid point --- src/incompressible/actuatorDisk_CT.F90 | 9 +++++---- src/incompressible/actuatorDisk_filtered.F90 | 9 +++++---- src/incompressible/turbineMod.F90 | 4 ++-- 3 files changed, 12 insertions(+), 10 deletions(-) diff --git a/src/incompressible/actuatorDisk_CT.F90 b/src/incompressible/actuatorDisk_CT.F90 index 26047581..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 diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index c635499c..e058e1fa 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -69,9 +69,10 @@ 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 @@ -97,9 +98,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; this%tilt = tilt diff --git a/src/incompressible/turbineMod.F90 b/src/incompressible/turbineMod.F90 index 14899be2..a12ce231 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 From 8320ed3dbff60b6a8240bfc966648769079e66cd Mon Sep 17 00:00:00 2001 From: Kirby Heck Date: Tue, 12 Aug 2025 09:30:36 -0500 Subject: [PATCH 031/114] small bug fix to read_2d_ascii --- src/io/basic_io.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io/basic_io.F90 b/src/io/basic_io.F90 index 626e0349..080462ec 100644 --- a/src/io/basic_io.F90 +++ b/src/io/basic_io.F90 @@ -56,7 +56,7 @@ subroutine read_2d_ascii(data2read,filename) nc = 0 do i = 1,len(columncount) - if (columncount(i:i) == 'e') nc = nc +1 + if (columncount(i:i) == 'E' .or. columncount(i:i) == 'e') nc = nc +1 end do nr = 0 From 22716f788856cc4f74192c2347a5de1a4db7db83 Mon Sep 17 00:00:00 2001 From: Kirby Heck Date: Tue, 12 Aug 2025 09:30:59 -0500 Subject: [PATCH 032/114] Added read arbitrary inflow to get_u --- .../AD_coriolis_shear_files/initialize.F90 | 66 +++++++++++++---- problems/turbines/HIT_AD_deficit.F90 | 9 ++- .../turbines/HIT_shear_files/initialize.F90 | 71 +++++++++++++++---- 3 files changed, 115 insertions(+), 31 deletions(-) diff --git a/problems/turbines/AD_coriolis_shear_files/initialize.F90 b/problems/turbines/AD_coriolis_shear_files/initialize.F90 index 9b4101e6..e16a716b 100644 --- a/problems/turbines/AD_coriolis_shear_files/initialize.F90 +++ b/problems/turbines/AD_coriolis_shear_files/initialize.F90 @@ -3,6 +3,7 @@ module AD_Coriolis_parameters use exits, only: message use kind_parameters, only: rkind use constants, only: kappa, pi + use basic_io, only: read_2d_ascii implicit none integer :: seedu = 321341 integer :: seedv = 423424 @@ -16,7 +17,7 @@ module AD_Coriolis_parameters subroutine init_fringe_targets(inputfile, mesh) use exits, only: message - use kind_parameters, only: rkind + use kind_parameters, only: rkind, clen use constants, only: zero, one, two, pi, half use gridtools, only: alloc_buffs use random, only: gaussian_random @@ -31,10 +32,10 @@ subroutine init_fringe_targets(inputfile, mesh) real(rkind) :: InflowProfileAmplit, InflowProfileThick, zmid=-1 integer :: ioUnit integer :: InflowProfileType - logical :: useGeostrophicForcing + character(len=clen) :: fname_inflow namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -50,15 +51,15 @@ subroutine init_fringe_targets(inputfile, mesh) zMid = Lz / two end if z => mesh(:,:,:,3) - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, utarget, vtarget) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, utarget, vtarget, fname_inflow) ! The velocity profile in z needs to go to slip wall at the top ! Both u and v need slip conditions end subroutine - subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v) - use kind_parameters, only: rkind + subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v, fname_inflow) + use kind_parameters, only: rkind, clen use constants, only: zero, one, two, pi, half implicit none @@ -70,8 +71,20 @@ subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, z real(rkind) :: a_max, g_min, g_max real(rkind), dimension(size(u,1), size(u,2), size(u,3)) :: alpha, g real(rkind) :: buffer=8.0d-1 ! buffer value = 1 - umin + character(len=clen) :: fname_inflow + real(rkind), dimension(:,:), allocatable :: inflow_arr + real(rkind), dimension(size(z,3)) :: z1d, u1d, v1d select case(InflowProfileType) + case(-1) + ! read inflow from ASCII files - look for inflow_data.txt with columns + ! z | u | v | k + call read_2d_ascii(inflow_arr, trim(fname_inflow)) + z1d = z(1,1,:) + u1d = interp1d(z1d, inflow_arr(:,1), inflow_arr(:,2)) + v1d = interp1d(z1d, inflow_arr(:,1), inflow_arr(:,3)) + u = spread(spread(u1d, dim=1, ncopies=size(z, 1)), dim=2, ncopies=size(z, 2)) + v = spread(spread(v1d, dim=1, ncopies=size(z, 1)), dim=2, ncopies=size(z, 2)) case(0) u = uInflow v = zero @@ -145,11 +158,38 @@ subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, z end subroutine +! interpolation function + function interp1d(x, xp, yp) result(y) + implicit none + real(rkind), intent(in) :: x(:) ! query points, arbitrary dimensions + real(rkind), intent(in) :: xp(:), yp(:) ! x, y coordinates of data points (x must be sorted) + real(rkind) :: y(size(x)) + integer :: i, j + + do i = 1, size(x) + ! check if out of bounds - if so, then clip to boundary values + if (x(i) <= xp(1)) then + y(i) = yp(1) + else if (x(i) >= xp(size(xp))) then + y(i) = yp(size(yp)) + else + ! find interval xp(j) <= x(i) < xp(j+1) + do j = 1, size(xp) - 1 + if (x(i) >= xp(j) .and. x(i) < xp(j+1)) then + y(i) = yp(j) + ( (yp(j+1) - yp(j)) / (xp(j+1) - xp(j)) ) * (x(i) - xp(j)) + exit + end if + end do + end if + end do + + end function interp1d + end module subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) use AD_Coriolis_parameters - use kind_parameters, only: rkind + use kind_parameters, only: rkind, clen use constants, only: one,two use decomp_2d, only: decomp_info implicit none @@ -163,9 +203,10 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) real(rkind) :: Lx = one, Ly = one, Lz = one, yaw real(rkind) :: uInflow, vInflow, zmid real(rkind) :: InflowProfileAmplit, InflowProfileThick + character(len=clen) :: fname_inflow integer :: InflowProfileType namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -207,7 +248,7 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) use AD_Coriolis_parameters - use kind_parameters, only: rkind + use kind_parameters, only: rkind, clen use constants, only: zero, one, two, pi, half use gridtools, only: alloc_buffs use random, only: gaussian_random @@ -225,13 +266,14 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) real(rkind), dimension(:,:,:), pointer :: u, v, w, wC, x, y, z real(rkind), dimension(:,:,:), allocatable :: randArr, ybuffC, ybuffE, zbuffC, zbuffE integer :: nz, nzE - real(rkind) :: Lx = one, Ly = one, Lz = one, G_alpha, yaw + real(rkind) :: Lx = one, Ly = one, Lz = one, yaw real(rkind) :: uInflow, vInflow real(rkind) :: InflowProfileAmplit, InflowProfileThick, zmid=-1 integer :: InflowProfileType + character(len=clen) :: fname_inflow namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -254,7 +296,7 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) end if ! initialize inflow profile - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v, fname_inflow) !allocate(randArr(size(u,1),size(u,2),size(u,3))) !call gaussian_random(randArr,-one,one,seedu + 10*nrank) diff --git a/problems/turbines/HIT_AD_deficit.F90 b/problems/turbines/HIT_AD_deficit.F90 index fc32e250..3764f915 100644 --- a/problems/turbines/HIT_AD_deficit.F90 +++ b/problems/turbines/HIT_AD_deficit.F90 @@ -95,9 +95,7 @@ program HIT_deficit call hit%start_io(.true.) call hit%printDivergence() call message("Initialized CONCURRENT HIT simulation") - if (freeze_HIT) then - call message(1, "HIT targets are FROZEN") - end if + if (freeze_HIT) call message(1, "HIT targets are FROZEN") ! For anisotropic PRIMARY and EMPTY domains, we will need to declare an anisotropy factor in x aniso_x = nint(adsim%dx / hit%dx) @@ -165,7 +163,7 @@ program HIT_deficit ! phaseshift turbulent fringe targets using the laminar fringe targets if (control_TI) call update_TI_fact(emptysim, .true.) ! update TI based on the EMPTY simulation - call do_phaseshifting() !hit, adsim, utarget, vtarget, wtarget) + call do_phaseshifting() ! initialize budgets call budg_tavg%init(AD_Inputfile, adsim) !<-- Budget class initialization @@ -262,7 +260,7 @@ program HIT_deficit deallocate(hit, adsim) -! deallocate fringe targets + ! deallocate fringe targets deallocate(utarget0, vtarget0, wtarget0) deallocate(utarget, vtarget, wtarget) deallocate(utarget_1d, vtarget_1d) @@ -283,6 +281,7 @@ subroutine do_phaseshifting() x_shift_z = adsim%tsim * utarget_1d(1, 1,:) y_shift_z = adsim%tsim * vtarget_1d(1, 1,:) + ! if sheared, then advect the HIT flow with different freestream velocity as a function of z call hit%spectC%bandpassFilter_and_phaseshift_z(hit%whatC, hit%rbuffxC(:,:,:,1), x_shift_z, y_shift_z) call hit%interpolate_cellField_to_edgeField(hit%rbuffxC(:,:,:,1), hit%rbuffxE(:,:,:,1),0,0) call hit%spectC%bandpassFilter_and_phaseshift_z(hit%uhat, hit%rbuffxC(:,:,:,1), x_shift_z, y_shift_z) diff --git a/problems/turbines/HIT_shear_files/initialize.F90 b/problems/turbines/HIT_shear_files/initialize.F90 index 9b27d18d..d7006cc8 100644 --- a/problems/turbines/HIT_shear_files/initialize.F90 +++ b/problems/turbines/HIT_shear_files/initialize.F90 @@ -3,9 +3,11 @@ module HIT_shear_parameters use exits, only: message use kind_parameters, only: rkind use constants, only: kappa, zero + use basic_io, only: read_2d_ascii, write_2d_ascii implicit none - ! I realize it is probably bad practice to store information here, but it is the easiest way I've found + ! I realize it is probably bad practice to store information in the shared + ! module parameters, but it is the least invasive way I've found to modify the code. ! -KSH 10/02/2024 integer :: simulationID = 0 @@ -17,29 +19,41 @@ module HIT_shear_parameters contains ! build the velocity profiles - subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v) - use kind_parameters, only: rkind + subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v, fname_inflow) + use kind_parameters, only: rkind, clen use constants, only: zero, one, two, pi, half use exits, only: gracefulExit implicit none real(rkind), dimension(:,:,:), intent(inout) :: u, v real(rkind), dimension(:,:,:), intent(in) :: z + real(rkind), dimension(size(z,3)) :: z1d, u1d, v1d real(rkind), intent(in) :: InflowProfileAmplit, InflowProfileThick, zMid, uInflow, vInflow, yaw integer, intent(in) :: InflowProfileType integer:: i real(rkind) :: a_max, g_min, g_max real(rkind), dimension(size(u,1), size(u,2), size(u,3)) :: alpha, g real(rkind) :: buffer=8.0d-1 ! buffer value = 1 - umin + character(len=clen) :: fname_inflow + real(rkind), dimension(:,:), allocatable :: inflow_arr select case(InflowProfileType) + case(-1) + ! read inflow from ASCII files - look for inflow_data.txt with columns + ! z | u | v | k + call read_2d_ascii(inflow_arr, trim(fname_inflow)) + z1d = z(1,1,:) + u1d = interp1d(z1d, inflow_arr(:,1), inflow_arr(:,2)) + v1d = interp1d(z1d, inflow_arr(:,1), inflow_arr(:,3)) + u = spread(spread(u1d, dim=1, ncopies=size(z, 1)), dim=2, ncopies=size(z, 2)) + v = spread(spread(v1d, dim=1, ncopies=size(z, 1)), dim=2, ncopies=size(z, 2)) case(0) u = uInflow v = zero - case(1) ! tanh shear and veer + case(1) ! tanh veer only u = uInflow v = uInflow * buffer * tanh(vinflow * InflowProfileAmplit * (z-zMid) / buffer) - case(2) + case(2) ! tanh shear and veer u = uInflow*(one + buffer * tanh(InflowProfileAmplit * (z-zMid) / buffer)) v = uInflow * buffer * tanh(vinflow * InflowProfileAmplit * (z-zMid) / buffer) case(3) ! veer only, linear |u| @@ -113,6 +127,33 @@ subroutine make_global_zaxis(adsim) wtarget_1d = zero end subroutine +! interpolation function + function interp1d(x, xp, yp) result(y) + implicit none + real(rkind), intent(in) :: x(:) ! query points, arbitrary dimensions + real(rkind), intent(in) :: xp(:), yp(:) ! x, y coordinates of data points (x must be sorted) + real(rkind) :: y(size(x)) + integer :: i, j + + do i = 1, size(x) + ! check if out of bounds - if so, then clip to boundary values + if (x(i) <= xp(1)) then + y(i) = yp(1) + else if (x(i) >= xp(size(xp))) then + y(i) = yp(size(yp)) + else + ! find interval xp(j) <= x(i) < xp(j+1) + do j = 1, size(xp) - 1 + if (x(i) >= xp(j) .and. x(i) < xp(j+1)) then + y(i) = yp(j) + ( (yp(j+1) - yp(j)) / (xp(j+1) - xp(j)) ) * (x(i) - xp(j)) + exit + end if + end do + end if + end do + + end function interp1d + ! fringe function pure subroutine Sfunc(x, val) real(rkind), dimension(:,:,:), intent(in) :: x @@ -132,7 +173,7 @@ pure subroutine Sfunc(x, val) ! initialize fringe targets with (laminar) flow subroutine init_fringe_targets(inputfile, mesh) use exits, only: message - use kind_parameters, only: rkind + use kind_parameters, only: rkind, clen use constants, only: zero, one, two, pi, half use random, only: gaussian_random @@ -144,9 +185,10 @@ subroutine init_fringe_targets(inputfile, mesh) real(rkind) :: Lx, Ly, Lz, uInflow = one, vInflow = zero, yaw = zero real(rkind) :: InflowProfileAmplit = one, InflowProfileThick = zero, zmid=-1 integer :: InflowProfileType = 1 + character(len=clen) :: fname_inflow namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -159,8 +201,8 @@ subroutine init_fringe_targets(inputfile, mesh) zMid = Lz / two end if z => mesh(:,:,:,3) - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, utarget0, vtarget0) - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z_global, zMid, InflowProfileType, yaw, utarget_1d, vtarget_1d) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, utarget0, vtarget0, fname_inflow) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z_global, zMid, InflowProfileType, yaw, utarget_1d, vtarget_1d, fname_inflow) InflowSpeed = uInflow ! set the "linear advection" velocity if ((InflowProfileType .ne. 0) .and. (advect_shear)) then @@ -195,14 +237,14 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) real(rkind) :: InflowProfileAmplit, InflowProfileThick, zmid=-1 integer :: InflowProfileType ! HIT stuff - character(len=clen) :: ufname, vfname, wfname + character(len=clen) :: ufname, vfname, wfname, fname_inflow real(rkind) :: TI, uadv, kleft, kright, u_init! Lx, Ly, Lz, - already assigned above integer :: inittype logical :: BandpassFilterFields ! AD Coriolis input NML: namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow ! HIT periodic input NML: namelist /HIT_PeriodicINPUT/ ufname, vfname, wfname, TI, uadv, kleft, kright, BandpassFilterFields, Lx, Ly, Lz, initType, u_init @@ -266,7 +308,7 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) use HIT_shear_parameters - use kind_parameters, only: rkind + use kind_parameters, only: rkind, clen use constants, only: zero, one, two, pi, half use gridtools, only: alloc_buffs use random, only: gaussian_random @@ -286,9 +328,10 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) real(rkind) :: Lx, Ly, Lz, uInflow = one, vInflow = zero, yaw = zero real(rkind) :: InflowProfileAmplit = zero, InflowProfileThick = zero, zmid=-1 integer :: InflowProfileType = 0 + character(len=clen) :: fname_inflow namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow if (simulationID == 1) then ! for adsim only @@ -312,7 +355,7 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) end if ! initialize velocity fields - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v, fname_inflow) wC= zero w = zero From 8187f62b75352ae7036ade05df99c75bb8305ce6 Mon Sep 17 00:00:00 2001 From: Kirby Heck Date: Wed, 13 Aug 2025 13:58:09 -0500 Subject: [PATCH 033/114] new, fast implementation for ADM type 5 (TESTED) Rebase to latest igridSGS-KSH --- src/incompressible/actuatorDisk_filtered.F90 | 56 ++++++++++++++++---- 1 file changed, 47 insertions(+), 9 deletions(-) diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index e058e1fa..23a65db5 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -240,8 +240,11 @@ subroutine get_R2(this, ys, zs, R2) 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(int(this%npts)) :: xi, yi, zi - integer :: k + real(rkind), dimension(this%npts) :: xi, yi, zi + ! 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) @@ -261,13 +264,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 - 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) + + ! 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 + ! 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() From 52e1f14845aedad4608b3af549d1467d426c66a7 Mon Sep 17 00:00:00 2001 From: Kirby Heck Date: Mon, 18 Aug 2025 16:19:21 -0500 Subject: [PATCH 034/114] Revert extraneous commits from other features not part of the ADM improvements This reverts commit 554b65b02ee40e8dcc0175ec1cfb52a630be332e. --- .../AD_coriolis_shear_files/initialize.F90 | 66 ++++------------- problems/turbines/HIT_AD_deficit.F90 | 9 +-- .../turbines/HIT_shear_files/initialize.F90 | 71 ++++--------------- 3 files changed, 31 insertions(+), 115 deletions(-) diff --git a/problems/turbines/AD_coriolis_shear_files/initialize.F90 b/problems/turbines/AD_coriolis_shear_files/initialize.F90 index e16a716b..9b4101e6 100644 --- a/problems/turbines/AD_coriolis_shear_files/initialize.F90 +++ b/problems/turbines/AD_coriolis_shear_files/initialize.F90 @@ -3,7 +3,6 @@ module AD_Coriolis_parameters use exits, only: message use kind_parameters, only: rkind use constants, only: kappa, pi - use basic_io, only: read_2d_ascii implicit none integer :: seedu = 321341 integer :: seedv = 423424 @@ -17,7 +16,7 @@ module AD_Coriolis_parameters subroutine init_fringe_targets(inputfile, mesh) use exits, only: message - use kind_parameters, only: rkind, clen + use kind_parameters, only: rkind use constants, only: zero, one, two, pi, half use gridtools, only: alloc_buffs use random, only: gaussian_random @@ -32,10 +31,10 @@ subroutine init_fringe_targets(inputfile, mesh) real(rkind) :: InflowProfileAmplit, InflowProfileThick, zmid=-1 integer :: ioUnit integer :: InflowProfileType - character(len=clen) :: fname_inflow + logical :: useGeostrophicForcing namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -51,15 +50,15 @@ subroutine init_fringe_targets(inputfile, mesh) zMid = Lz / two end if z => mesh(:,:,:,3) - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, utarget, vtarget, fname_inflow) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, utarget, vtarget) ! The velocity profile in z needs to go to slip wall at the top ! Both u and v need slip conditions end subroutine - subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v, fname_inflow) - use kind_parameters, only: rkind, clen + subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v) + use kind_parameters, only: rkind use constants, only: zero, one, two, pi, half implicit none @@ -71,20 +70,8 @@ subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, z real(rkind) :: a_max, g_min, g_max real(rkind), dimension(size(u,1), size(u,2), size(u,3)) :: alpha, g real(rkind) :: buffer=8.0d-1 ! buffer value = 1 - umin - character(len=clen) :: fname_inflow - real(rkind), dimension(:,:), allocatable :: inflow_arr - real(rkind), dimension(size(z,3)) :: z1d, u1d, v1d select case(InflowProfileType) - case(-1) - ! read inflow from ASCII files - look for inflow_data.txt with columns - ! z | u | v | k - call read_2d_ascii(inflow_arr, trim(fname_inflow)) - z1d = z(1,1,:) - u1d = interp1d(z1d, inflow_arr(:,1), inflow_arr(:,2)) - v1d = interp1d(z1d, inflow_arr(:,1), inflow_arr(:,3)) - u = spread(spread(u1d, dim=1, ncopies=size(z, 1)), dim=2, ncopies=size(z, 2)) - v = spread(spread(v1d, dim=1, ncopies=size(z, 1)), dim=2, ncopies=size(z, 2)) case(0) u = uInflow v = zero @@ -158,38 +145,11 @@ subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, z end subroutine -! interpolation function - function interp1d(x, xp, yp) result(y) - implicit none - real(rkind), intent(in) :: x(:) ! query points, arbitrary dimensions - real(rkind), intent(in) :: xp(:), yp(:) ! x, y coordinates of data points (x must be sorted) - real(rkind) :: y(size(x)) - integer :: i, j - - do i = 1, size(x) - ! check if out of bounds - if so, then clip to boundary values - if (x(i) <= xp(1)) then - y(i) = yp(1) - else if (x(i) >= xp(size(xp))) then - y(i) = yp(size(yp)) - else - ! find interval xp(j) <= x(i) < xp(j+1) - do j = 1, size(xp) - 1 - if (x(i) >= xp(j) .and. x(i) < xp(j+1)) then - y(i) = yp(j) + ( (yp(j+1) - yp(j)) / (xp(j+1) - xp(j)) ) * (x(i) - xp(j)) - exit - end if - end do - end if - end do - - end function interp1d - end module subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) use AD_Coriolis_parameters - use kind_parameters, only: rkind, clen + use kind_parameters, only: rkind use constants, only: one,two use decomp_2d, only: decomp_info implicit none @@ -203,10 +163,9 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) real(rkind) :: Lx = one, Ly = one, Lz = one, yaw real(rkind) :: uInflow, vInflow, zmid real(rkind) :: InflowProfileAmplit, InflowProfileThick - character(len=clen) :: fname_inflow integer :: InflowProfileType namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -248,7 +207,7 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) use AD_Coriolis_parameters - use kind_parameters, only: rkind, clen + use kind_parameters, only: rkind use constants, only: zero, one, two, pi, half use gridtools, only: alloc_buffs use random, only: gaussian_random @@ -266,14 +225,13 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) real(rkind), dimension(:,:,:), pointer :: u, v, w, wC, x, y, z real(rkind), dimension(:,:,:), allocatable :: randArr, ybuffC, ybuffE, zbuffC, zbuffE integer :: nz, nzE - real(rkind) :: Lx = one, Ly = one, Lz = one, yaw + real(rkind) :: Lx = one, Ly = one, Lz = one, G_alpha, yaw real(rkind) :: uInflow, vInflow real(rkind) :: InflowProfileAmplit, InflowProfileThick, zmid=-1 integer :: InflowProfileType - character(len=clen) :: fname_inflow namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -296,7 +254,7 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) end if ! initialize inflow profile - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v, fname_inflow) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v) !allocate(randArr(size(u,1),size(u,2),size(u,3))) !call gaussian_random(randArr,-one,one,seedu + 10*nrank) diff --git a/problems/turbines/HIT_AD_deficit.F90 b/problems/turbines/HIT_AD_deficit.F90 index 3764f915..fc32e250 100644 --- a/problems/turbines/HIT_AD_deficit.F90 +++ b/problems/turbines/HIT_AD_deficit.F90 @@ -95,7 +95,9 @@ program HIT_deficit call hit%start_io(.true.) call hit%printDivergence() call message("Initialized CONCURRENT HIT simulation") - if (freeze_HIT) call message(1, "HIT targets are FROZEN") + if (freeze_HIT) then + call message(1, "HIT targets are FROZEN") + end if ! For anisotropic PRIMARY and EMPTY domains, we will need to declare an anisotropy factor in x aniso_x = nint(adsim%dx / hit%dx) @@ -163,7 +165,7 @@ program HIT_deficit ! phaseshift turbulent fringe targets using the laminar fringe targets if (control_TI) call update_TI_fact(emptysim, .true.) ! update TI based on the EMPTY simulation - call do_phaseshifting() + call do_phaseshifting() !hit, adsim, utarget, vtarget, wtarget) ! initialize budgets call budg_tavg%init(AD_Inputfile, adsim) !<-- Budget class initialization @@ -260,7 +262,7 @@ program HIT_deficit deallocate(hit, adsim) - ! deallocate fringe targets +! deallocate fringe targets deallocate(utarget0, vtarget0, wtarget0) deallocate(utarget, vtarget, wtarget) deallocate(utarget_1d, vtarget_1d) @@ -281,7 +283,6 @@ subroutine do_phaseshifting() x_shift_z = adsim%tsim * utarget_1d(1, 1,:) y_shift_z = adsim%tsim * vtarget_1d(1, 1,:) - ! if sheared, then advect the HIT flow with different freestream velocity as a function of z call hit%spectC%bandpassFilter_and_phaseshift_z(hit%whatC, hit%rbuffxC(:,:,:,1), x_shift_z, y_shift_z) call hit%interpolate_cellField_to_edgeField(hit%rbuffxC(:,:,:,1), hit%rbuffxE(:,:,:,1),0,0) call hit%spectC%bandpassFilter_and_phaseshift_z(hit%uhat, hit%rbuffxC(:,:,:,1), x_shift_z, y_shift_z) diff --git a/problems/turbines/HIT_shear_files/initialize.F90 b/problems/turbines/HIT_shear_files/initialize.F90 index d7006cc8..9b27d18d 100644 --- a/problems/turbines/HIT_shear_files/initialize.F90 +++ b/problems/turbines/HIT_shear_files/initialize.F90 @@ -3,11 +3,9 @@ module HIT_shear_parameters use exits, only: message use kind_parameters, only: rkind use constants, only: kappa, zero - use basic_io, only: read_2d_ascii, write_2d_ascii implicit none - ! I realize it is probably bad practice to store information in the shared - ! module parameters, but it is the least invasive way I've found to modify the code. + ! I realize it is probably bad practice to store information here, but it is the easiest way I've found ! -KSH 10/02/2024 integer :: simulationID = 0 @@ -19,41 +17,29 @@ module HIT_shear_parameters contains ! build the velocity profiles - subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v, fname_inflow) - use kind_parameters, only: rkind, clen + subroutine get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v) + use kind_parameters, only: rkind use constants, only: zero, one, two, pi, half use exits, only: gracefulExit implicit none real(rkind), dimension(:,:,:), intent(inout) :: u, v real(rkind), dimension(:,:,:), intent(in) :: z - real(rkind), dimension(size(z,3)) :: z1d, u1d, v1d real(rkind), intent(in) :: InflowProfileAmplit, InflowProfileThick, zMid, uInflow, vInflow, yaw integer, intent(in) :: InflowProfileType integer:: i real(rkind) :: a_max, g_min, g_max real(rkind), dimension(size(u,1), size(u,2), size(u,3)) :: alpha, g real(rkind) :: buffer=8.0d-1 ! buffer value = 1 - umin - character(len=clen) :: fname_inflow - real(rkind), dimension(:,:), allocatable :: inflow_arr select case(InflowProfileType) - case(-1) - ! read inflow from ASCII files - look for inflow_data.txt with columns - ! z | u | v | k - call read_2d_ascii(inflow_arr, trim(fname_inflow)) - z1d = z(1,1,:) - u1d = interp1d(z1d, inflow_arr(:,1), inflow_arr(:,2)) - v1d = interp1d(z1d, inflow_arr(:,1), inflow_arr(:,3)) - u = spread(spread(u1d, dim=1, ncopies=size(z, 1)), dim=2, ncopies=size(z, 2)) - v = spread(spread(v1d, dim=1, ncopies=size(z, 1)), dim=2, ncopies=size(z, 2)) case(0) u = uInflow v = zero - case(1) ! tanh veer only + case(1) ! tanh shear and veer u = uInflow v = uInflow * buffer * tanh(vinflow * InflowProfileAmplit * (z-zMid) / buffer) - case(2) ! tanh shear and veer + case(2) u = uInflow*(one + buffer * tanh(InflowProfileAmplit * (z-zMid) / buffer)) v = uInflow * buffer * tanh(vinflow * InflowProfileAmplit * (z-zMid) / buffer) case(3) ! veer only, linear |u| @@ -127,33 +113,6 @@ subroutine make_global_zaxis(adsim) wtarget_1d = zero end subroutine -! interpolation function - function interp1d(x, xp, yp) result(y) - implicit none - real(rkind), intent(in) :: x(:) ! query points, arbitrary dimensions - real(rkind), intent(in) :: xp(:), yp(:) ! x, y coordinates of data points (x must be sorted) - real(rkind) :: y(size(x)) - integer :: i, j - - do i = 1, size(x) - ! check if out of bounds - if so, then clip to boundary values - if (x(i) <= xp(1)) then - y(i) = yp(1) - else if (x(i) >= xp(size(xp))) then - y(i) = yp(size(yp)) - else - ! find interval xp(j) <= x(i) < xp(j+1) - do j = 1, size(xp) - 1 - if (x(i) >= xp(j) .and. x(i) < xp(j+1)) then - y(i) = yp(j) + ( (yp(j+1) - yp(j)) / (xp(j+1) - xp(j)) ) * (x(i) - xp(j)) - exit - end if - end do - end if - end do - - end function interp1d - ! fringe function pure subroutine Sfunc(x, val) real(rkind), dimension(:,:,:), intent(in) :: x @@ -173,7 +132,7 @@ pure subroutine Sfunc(x, val) ! initialize fringe targets with (laminar) flow subroutine init_fringe_targets(inputfile, mesh) use exits, only: message - use kind_parameters, only: rkind, clen + use kind_parameters, only: rkind use constants, only: zero, one, two, pi, half use random, only: gaussian_random @@ -185,10 +144,9 @@ subroutine init_fringe_targets(inputfile, mesh) real(rkind) :: Lx, Ly, Lz, uInflow = one, vInflow = zero, yaw = zero real(rkind) :: InflowProfileAmplit = one, InflowProfileThick = zero, zmid=-1 integer :: InflowProfileType = 1 - character(len=clen) :: fname_inflow namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') @@ -201,8 +159,8 @@ subroutine init_fringe_targets(inputfile, mesh) zMid = Lz / two end if z => mesh(:,:,:,3) - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, utarget0, vtarget0, fname_inflow) - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z_global, zMid, InflowProfileType, yaw, utarget_1d, vtarget_1d, fname_inflow) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, utarget0, vtarget0) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z_global, zMid, InflowProfileType, yaw, utarget_1d, vtarget_1d) InflowSpeed = uInflow ! set the "linear advection" velocity if ((InflowProfileType .ne. 0) .and. (advect_shear)) then @@ -237,14 +195,14 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) real(rkind) :: InflowProfileAmplit, InflowProfileThick, zmid=-1 integer :: InflowProfileType ! HIT stuff - character(len=clen) :: ufname, vfname, wfname, fname_inflow + character(len=clen) :: ufname, vfname, wfname real(rkind) :: TI, uadv, kleft, kright, u_init! Lx, Ly, Lz, - already assigned above integer :: inittype logical :: BandpassFilterFields ! AD Coriolis input NML: namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw ! HIT periodic input NML: namelist /HIT_PeriodicINPUT/ ufname, vfname, wfname, TI, uadv, kleft, kright, BandpassFilterFields, Lx, Ly, Lz, initType, u_init @@ -308,7 +266,7 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) use HIT_shear_parameters - use kind_parameters, only: rkind, clen + use kind_parameters, only: rkind use constants, only: zero, one, two, pi, half use gridtools, only: alloc_buffs use random, only: gaussian_random @@ -328,10 +286,9 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) real(rkind) :: Lx, Ly, Lz, uInflow = one, vInflow = zero, yaw = zero real(rkind) :: InflowProfileAmplit = zero, InflowProfileThick = zero, zmid=-1 integer :: InflowProfileType = 0 - character(len=clen) :: fname_inflow namelist /AD_CoriolisINPUT/ Lx, Ly, Lz, uInflow, vInflow, zmid, & - InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw, fname_inflow + InflowProfileAmplit, InflowProfileThick, InflowProfileType, yaw if (simulationID == 1) then ! for adsim only @@ -355,7 +312,7 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) end if ! initialize velocity fields - call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v, fname_inflow) + call get_u(uInflow, vInflow, InflowProfileAmplit, InflowProfileThick, z, zMid, InflowProfileType, yaw, u, v) wC= zero w = zero From e9ba0238b1e27e63304bd6daa43d429985ede43c Mon Sep 17 00:00:00 2001 From: Kirby Heck Date: Mon, 18 Aug 2025 16:19:47 -0500 Subject: [PATCH 035/114] Revert "small bug fix to read_2d_ascii" This reverts commit 8bee8efea18d29369817bb4910490f0373c6c43f. --- src/io/basic_io.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/io/basic_io.F90 b/src/io/basic_io.F90 index 080462ec..626e0349 100644 --- a/src/io/basic_io.F90 +++ b/src/io/basic_io.F90 @@ -56,7 +56,7 @@ subroutine read_2d_ascii(data2read,filename) nc = 0 do i = 1,len(columncount) - if (columncount(i:i) == 'E' .or. columncount(i:i) == 'e') nc = nc +1 + if (columncount(i:i) == 'e') nc = nc +1 end do nr = 0 From 35b3fa073b923f6f7dbffd9038928ead7f9189e8 Mon Sep 17 00:00:00 2001 From: Kirby Heck Date: Sat, 7 Feb 2026 21:13:56 -0600 Subject: [PATCH 036/114] Increasing ADM sampling resolution parameter to fix kernel bug --- src/incompressible/actuatorDisk_filtered.F90 | 37 +++++++++----------- 1 file changed, 16 insertions(+), 21 deletions(-) diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index 23a65db5..f9610f6a 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,7 +30,7 @@ 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(:,:,:), pointer :: xG, yG, zG @@ -77,7 +77,7 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) 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. @@ -105,6 +105,7 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, 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 @@ -159,7 +160,7 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) 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))) @@ -177,7 +178,7 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) call message(2, "Using Dynamic Yaw") else call message(2, "Using static turbine.") - call this%redraw() ! get_weights(this) + call this%get_weights() end if call message(2, "Smearing grid parameter, Delta", this%delta) @@ -348,10 +349,10 @@ subroutine get_weights(this) 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 @@ -359,7 +360,8 @@ subroutine sample_on_circle(diam, xcen, ycen, xloc, yloc, dx, dy) integer :: idx, i, j, 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 @@ -370,19 +372,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) @@ -555,7 +550,7 @@ subroutine redraw(this) class(actuatordisk_filtered), intent(inout) :: this ! (re)sample points, this is quick - 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) this%xs = this%xloc From a111f38aec39420ae24935e3f23708e1de7cb0be Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Thu, 8 Jan 2026 12:27:40 -0600 Subject: [PATCH 037/114] Attempt at fixing double power output --- setup/SetupEnv_Stampede3.sh | 4 +-- src/incompressible/actuatorDisk_filtered.F90 | 10 ++++-- .../igrid_files/timestepping_stuff.F90 | 31 +++++++++---------- 3 files changed, 25 insertions(+), 20 deletions(-) diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh index c2b4dd73..a7d5b3a5 100644 --- a/setup/SetupEnv_Stampede3.sh +++ b/setup/SetupEnv_Stampede3.sh @@ -1,6 +1,6 @@ #!/bin/bash -module load cmake +module load cmake/3.31.9 module load intel impi module load fftw3/3.3.10 @@ -14,4 +14,4 @@ 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/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index f9610f6a..09769965 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -404,10 +404,13 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals) 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, 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 @@ -456,8 +459,11 @@ 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 + ! 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 this%powerTime(this%tInd) = this%get_power() this%uTime(this%tInd) = this%ut this%vTime(this%tInd) = vface diff --git a/src/incompressible/igrid_files/timestepping_stuff.F90 b/src/incompressible/igrid_files/timestepping_stuff.F90 index aa69b66e..6385cb2f 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 (forceWrite) then + call message(0,"Performing a forced visualization dump.") + 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. 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() + + else if (this%vizDump_Schedule /= 1 .and. mod(this%step, this%t_dataDump) == 0) + + call message(0,"Scheduled visualization dump.") + call this%dump_visualization_files() + + end if if (this%initspinup) then if (this%tsim > this%Tstop_initspinup) then From fb5e5b13aafd2538cd7b9dc99fd7c2c705dbd11c Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Thu, 8 Jan 2026 14:30:01 -0600 Subject: [PATCH 038/114] Remove repreated turbine values written to .pow and .vel files with budget on --- src/incompressible/actuatorDisk_filtered.F90 | 2 +- src/incompressible/igrid_files/timestepping_stuff.F90 | 2 +- src/incompressible/turbineMod.F90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index 09769965..00697300 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -400,7 +400,7 @@ subroutine sample_on_circle(diam, xcen, ycen, xloc, yloc, dx, dy, upsample_fact) 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 diff --git a/src/incompressible/igrid_files/timestepping_stuff.F90 b/src/incompressible/igrid_files/timestepping_stuff.F90 index 6385cb2f..92468f88 100644 --- a/src/incompressible/igrid_files/timestepping_stuff.F90 +++ b/src/incompressible/igrid_files/timestepping_stuff.F90 @@ -551,7 +551,7 @@ subroutine wrapup_timestep(this) call message(2,"This time step used a deltaT:",this%dt) call this%dump_visualization_files() - else if (this%vizDump_Schedule /= 1 .and. mod(this%step, this%t_dataDump) == 0) + 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() diff --git a/src/incompressible/turbineMod.F90 b/src/incompressible/turbineMod.F90 index a12ce231..36e12f35 100644 --- a/src/incompressible/turbineMod.F90 +++ b/src/incompressible/turbineMod.F90 @@ -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 From c6de9abaae8cabb6e3deb037909069812bab3c86 Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Thu, 8 Jan 2026 14:39:11 -0600 Subject: [PATCH 039/114] Reorganize dump_visualization_files block --- .../igrid_files/timestepping_stuff.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/incompressible/igrid_files/timestepping_stuff.F90 b/src/incompressible/igrid_files/timestepping_stuff.F90 index 92468f88..b42d9439 100644 --- a/src/incompressible/igrid_files/timestepping_stuff.F90 +++ b/src/incompressible/igrid_files/timestepping_stuff.F90 @@ -540,12 +540,7 @@ subroutine wrapup_timestep(this) end if end if - if (forceWrite) then - - call message(0,"Performing a forced visualization dump.") - call this%dump_visualization_files() - - else if (this%vizDump_Schedule == 1 .and. this%DumpThisStep) then + 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) @@ -555,6 +550,11 @@ subroutine wrapup_timestep(this) 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 From 27524954cd9822c359ac13580c9466ff188ca9a6 Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Fri, 9 Jan 2026 11:38:45 -0600 Subject: [PATCH 040/114] Reset setup file --- setup/SetupEnv_Stampede3.sh | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh index a7d5b3a5..d5a6cf76 100644 --- a/setup/SetupEnv_Stampede3.sh +++ b/setup/SetupEnv_Stampede3.sh @@ -1,17 +1,16 @@ #!/bin/bash -module load cmake/3.31.9 +module load cmake 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=$TACC_FFTW3_DIR +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.14.3/build export FFTPACK_PATH=${CWD}/dependencies/fftpack -export ARCH_OPT_FLAG="-xCORE-AVX512" \ No newline at end of file +export ARCH_OPT_FLAG="-xCORE-AVX512" From 768ac123ea2a2becca09f48b28a711d1b3a983e1 Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Wed, 8 Oct 2025 16:35:02 -0500 Subject: [PATCH 041/114] Decrease allocations for time budgets --- src/incompressible/budget_time_avg.F90 | 72 +++++++++++++------------- 1 file changed, 37 insertions(+), 35 deletions(-) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index c5ea50e6..840589bf 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -283,33 +283,38 @@ subroutine init(this, inputfile, igrid_sim) this%HaveScalars = this%igrid_sim%useScalars - if(this%do_budgets) then - - 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%isStratified) then - ! Always assume that you are stratified + 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%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 3 + 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))) @@ -322,16 +327,17 @@ subroutine init(this, inputfile, igrid_sim) 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 +347,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 +376,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 +391,7 @@ subroutine init(this, inputfile, igrid_sim) this%runningSum_sc_turb = zero this%runningSum_turb = zero endif - end if - end subroutine From 38461553197f50c8e8b677ad5ae71c4223dae8d4 Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Wed, 8 Oct 2025 16:45:43 -0500 Subject: [PATCH 042/114] Update cmake version --- setup/SetupEnv_Stampede3.sh | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh index d5a6cf76..880a8e4e 100644 --- a/setup/SetupEnv_Stampede3.sh +++ b/setup/SetupEnv_Stampede3.sh @@ -1,7 +1,9 @@ #!/bin/bash -module load cmake +module purge +module load cmake/3.31.5 module load intel impi +module load fftw3/3.3.10 CWD=`pwd` export COMPILER_ID=Intel From f9dbad27ff1e4728fb725930e72c025d5ac47d07 Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Wed, 8 Oct 2025 17:08:00 -0500 Subject: [PATCH 043/114] Further memory cleanup in budgets --- setup/SetupEnv_Stampede3.sh | 7 +- src/incompressible/budget_time_avg.F90 | 14 +-- .../budget_time_avg_deficit.F90 | 95 ++++++++++--------- src/incompressible/budget_xy_avg.F90 | 21 ++-- 4 files changed, 74 insertions(+), 63 deletions(-) diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh index 880a8e4e..5141946b 100644 --- a/setup/SetupEnv_Stampede3.sh +++ b/setup/SetupEnv_Stampede3.sh @@ -1,7 +1,6 @@ #!/bin/bash - module purge -module load cmake/3.31.5 +module load cmake/3.31.9 module load intel impi module load fftw3/3.3.10 @@ -10,9 +9,9 @@ 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/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 840589bf..9594bdec 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -294,7 +294,7 @@ subroutine init(this, inputfile, igrid_sim) 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 + ! 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)) end if @@ -306,7 +306,7 @@ subroutine init(this, inputfile, igrid_sim) 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 3 + ! 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)) @@ -316,12 +316,12 @@ subroutine init(this, inputfile, igrid_sim) 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))) diff --git a/src/incompressible/budget_time_avg_deficit.F90 b/src/incompressible/budget_time_avg_deficit.F90 index 48477a6e..55044d4b 100644 --- a/src/incompressible/budget_time_avg_deficit.F90 +++ b/src/incompressible/budget_time_avg_deficit.F90 @@ -304,58 +304,61 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) this%HaveScalars = this%prim_budget%igrid_sim%useScalars if(this%do_budgets) then - 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%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 diff --git a/src/incompressible/budget_xy_avg.F90 b/src/incompressible/budget_xy_avg.F90 index 54297899..ed7c5f1c 100644 --- a/src/incompressible/budget_xy_avg.F90 +++ b/src/incompressible/budget_xy_avg.F90 @@ -203,22 +203,31 @@ subroutine init(this, inputfile, igrid_sim) this%avgFact = 1.d0/(real(igrid_sim%nx,rkind)*real(igrid_sim%ny,rkind)) if(this%do_budgets) then - 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 - 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 From 4fa823aadb889e89efc1cd72e2d9b3872b67d449 Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Sat, 18 Oct 2025 09:14:09 -0500 Subject: [PATCH 044/114] Update destroy code --- src/incompressible/budget_time_avg.F90 | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 9594bdec..dd9f883a 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -2467,9 +2467,25 @@ subroutine destroy(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%budget_0) + if (this%budgetType>0) then + deallocate(this%budget_1) + end + if (this%budgetType>1) then + deallocate(this%budget_2) + end + if (this%budgetType>2) then + deallocate(this%budget_3) + end + 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 + deallocate(this%runningSum_sc) if(this%useWindTurbines) then deallocate(this%runningSum_sc_turb) deallocate(this%runningSum_turb) From ea4417cbc426337d7110c673bc51f53929294853 Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Sat, 18 Oct 2025 09:43:41 -0500 Subject: [PATCH 045/114] Update destroy budget call --- setup/SetupEnv_Stampede3.sh | 2 +- src/incompressible/budget_time_avg.F90 | 14 ++++++-------- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh index 5141946b..65b71cbe 100644 --- a/setup/SetupEnv_Stampede3.sh +++ b/setup/SetupEnv_Stampede3.sh @@ -1,6 +1,6 @@ #!/bin/bash module purge -module load cmake/3.31.9 +module load cmake/3.31.5 module load intel impi module load fftw3/3.3.10 diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index dd9f883a..1622f4d9 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -2463,36 +2463,34 @@ 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) if (this%budgetType>0) then deallocate(this%budget_1) - end + end if if (this%budgetType>1) then deallocate(this%budget_2) - end + end if if (this%budgetType>2) then deallocate(this%budget_3) - end + 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 + 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) From 1aebac6547fdd9f6a6cff661b133d32b03eb0efb Mon Sep 17 00:00:00 2001 From: Skylar Gering Date: Sun, 19 Oct 2025 12:50:14 -0500 Subject: [PATCH 046/114] Update destroy methods --- .../budget_time_avg_deficit.F90 | 18 +++++++++++++++++- src/incompressible/budget_xy_avg.F90 | 19 ++++++++++++++++++- 2 files changed, 35 insertions(+), 2 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit.F90 b/src/incompressible/budget_time_avg_deficit.F90 index 55044d4b..d72aa46d 100644 --- a/src/incompressible/budget_time_avg_deficit.F90 +++ b/src/incompressible/budget_time_avg_deficit.F90 @@ -2103,7 +2103,23 @@ subroutine destroy(this) nullify(this%prim_budget%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%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_xy_avg.F90 b/src/incompressible/budget_xy_avg.F90 index ed7c5f1c..a5cd9c89 100644 --- a/src/incompressible/budget_xy_avg.F90 +++ b/src/incompressible/budget_xy_avg.F90 @@ -371,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) From 0b5d165a340be10a642c7a77ee32ec6c0822abc4 Mon Sep 17 00:00:00 2001 From: Kirby Heck Date: Sun, 8 Feb 2026 02:01:10 -0600 Subject: [PATCH 047/114] Restoring local FFTW path and updating cmake to 3.31.9 on Stampede3 --- setup/SetupEnv_Stampede3.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh index 65b71cbe..e1988f99 100644 --- a/setup/SetupEnv_Stampede3.sh +++ b/setup/SetupEnv_Stampede3.sh @@ -1,6 +1,6 @@ #!/bin/bash module purge -module load cmake/3.31.5 +module load cmake/3.31.9 module load intel impi module load fftw3/3.3.10 @@ -9,7 +9,7 @@ export COMPILER_ID=Intel export FC=mpiifort export CC=mpiicc export CXX=mpiicpc -export FFTW_PATH=$TACC_FFTW3_DIR +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.14.3/build From 507e860eae9b1ed730e3a5e1e55c75dd22c21b3e Mon Sep 17 00:00:00 2001 From: Kirby Heck Date: Sun, 8 Feb 2026 02:01:40 -0600 Subject: [PATCH 048/114] small updates in destroy to release correct allocated memory --- problems/turbines/neutral_pbl_concurrent.F90 | 1 + src/incompressible/budget_time_avg.F90 | 8 +++++++- src/incompressible/budget_time_avg_deficit.F90 | 2 +- 3 files changed, 9 insertions(+), 2 deletions(-) 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/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 1622f4d9..9f436272 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -2465,7 +2465,13 @@ 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%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) diff --git a/src/incompressible/budget_time_avg_deficit.F90 b/src/incompressible/budget_time_avg_deficit.F90 index d72aa46d..0246cd76 100644 --- a/src/incompressible/budget_time_avg_deficit.F90 +++ b/src/incompressible/budget_time_avg_deficit.F90 @@ -2100,7 +2100,7 @@ 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) From df8b9388da47f066a55dc7b9ad3f085afa2467cc Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 18 Sep 2025 18:11:17 -0500 Subject: [PATCH 049/114] use local fftw3 on Stampede3 --- setup/SetupEnv_Stampede3.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh index e1988f99..5141946b 100644 --- a/setup/SetupEnv_Stampede3.sh +++ b/setup/SetupEnv_Stampede3.sh @@ -9,7 +9,7 @@ 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 From 0119297cb553bb3f9e8257fdb9e639bcae713199 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 27 Oct 2025 21:10:49 +0000 Subject: [PATCH 050/114] changes to make code compile on AMD machine with GNU Rebase to latest igridSGS-KSH --- CMakeLists.txt | 11 + problems/incompressible/refine_fields.F90 | 774 ++++++++++ .../refine_fields_files/input.dat | 0 .../ConstructDeficitBudgets.F90 | 1324 +++++++++++++++++ .../input_budgets.dat | 35 + src/CMakeLists.txt | 8 + 6 files changed, 2152 insertions(+) create mode 100644 problems/incompressible/refine_fields.F90 create mode 100644 problems/incompressible/refine_fields_files/input.dat create mode 100644 problems/postprocessing_igrid/ConstructDeficitBudgets.F90 create mode 100644 problems/postprocessing_igrid/ConstructDeficitBudgets_files/input_budgets.dat diff --git a/CMakeLists.txt b/CMakeLists.txt index e4c9972e..ce7c14b6 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -64,6 +64,7 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU_OSX") # Standard GNU compilers elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") if ( CMAKE_BUILD_TYPE MATCHES "Release" ) +<<<<<<< HEAD if ($ENV{ARCH_OPT_FLAG}) # set(OPTFLAG "-march=native") set(OPTFLAG $ENV{ARCH_OPT_FLAG}) @@ -73,6 +74,16 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O3 -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 -ffree-form -ffree-line-length-none -fcheck=all -fbounds-check -ffpe-trap=zero,overflow -Wall -Wconversion -Wextra -Waliasing -Wsurprising -fallow-argument-mismatch -finit-integer=0 -finit-real=zero") +======= + 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 -fallow-argument-mismatch -finit-integer=0 -finit-real=zero") + elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) + 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") +>>>>>>> 4af35cc4 (changes to make code compile on AMD machine with GNU) endif() elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "Cray") diff --git a/problems/incompressible/refine_fields.F90 b/problems/incompressible/refine_fields.F90 new file mode 100644 index 00000000..1a6271e5 --- /dev/null +++ b/problems/incompressible/refine_fields.F90 @@ -0,0 +1,774 @@ +!=============================================================================== +! 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 + 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), 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) + + ! 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) + + ! 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) + 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 + + ! 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) + + type(decomp_info) :: decomp_inter + integer :: nxc_g, nyc_g, nxf_g, nyf_g, nzc_g + integer :: nxc_hat + !real(rkind) :: scale + + 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 + + ! Initialize Intermediate Decomposition (Coarse X_hat, Fine Y, Coarse Z) + call decomp_info_init(nxc_hat, nyf_g, nzc_g, decomp_inter) + + !=============================================================== + ! 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) + + ! Non-negative block includes Nyquist + hat_i_yp(:, 1:nyc_g/2+1, :) = hat_c_yp(:, 1:nyc_g/2+1, :) + + ! Strictly negative modes only (length = nyc/2 - 1) + hat_i_yp(:, nyf_g-(nyc_g/2-1)+1:nyf_g, :) = hat_c_yp(:, nyc_g/2+2: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) + allocate(hat_f_xp(spect_f%spectdecomp%xsz(1), spect_f%spectdecomp%xsz(2), spect_f%spectdecomp%xsz(3))) + hat_f_xp = (zero, zero) + hat_f_xp(1:nxc_hat, :, :) = hat_i_xp(1:nxc_hat, :, :) + + ! 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) + call decomp_info_finalize(decomp_inter) + + 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) + + ! 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),gpCsp_gpC_XY_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) + + 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/postprocessing_igrid/ConstructDeficitBudgets.F90 b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 new file mode 100644 index 00000000..d1d659da --- /dev/null +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 @@ -0,0 +1,1324 @@ +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 + + 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(:) + + 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) + continue + case(3) + !call compute_Z_budget_component(idx, buffer) + continue + case(4) + call compute_TKE_budget_component(idx, buffer) + additional = '4' + end select + + ! Average this budget term across the box + 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)then + ! X 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_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 + call intersectBoxAndMesh() + call message(0,'Control volume box intersected with the mesh') + + ! 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) + deallocate(rbuffxC, cbuffyC, cbuffzC) + deallocate(profiles, 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 + + namelist /INPUT/ inputdir, outputdir, nx, ny, nz, Lx, Ly, Lz, prow, pcol, RID, & + BRID, budgettype, writeDependentVariables, startIDX, endIDX, tag + 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') + read(unit=ioUnit, NML=INPUT) + read(unit=ioUnit, NML=NUMERICS) + read(unit=ioUnit, NML=BCs) + read(unit=ioUnit, NML=BOX) + 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)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/src/CMakeLists.txt b/src/CMakeLists.txt index e5da4f25..9ed68b16 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -26,16 +26,24 @@ 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() # Replace $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a with local library if needed +<<<<<<< HEAD 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}) +======= + target_link_libraries(PadeOps fftw3 2decomp_fft $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a ${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}) +>>>>>>> 4af35cc4 (changes to make code compile on AMD machine with GNU) endif() if ( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) target_link_libraries(PadeOps fftw3 2decomp_fft ${MPI_LIBRARIES}) elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") # Replace $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a with local library if needed +<<<<<<< HEAD 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}) +======= + target_link_libraries(PadeOps fftw3 2decomp_fft $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ${MPI_LIBRARIES}) +>>>>>>> 4af35cc4 (changes to make code compile on AMD machine with GNU) elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU_OSX") target_link_libraries(PadeOps fftw3 2decomp_fft blas lapack ${MPI_LIBRARIES}) endif() From 30b3b4099c5425d1f146853d7f1b1d37e98c96fa Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 10 Nov 2025 18:07:14 +0000 Subject: [PATCH 051/114] fix release run on AMD using GNU Rebase to igridSGS-KSH --- CMakeLists.txt | 14 +++----------- src/CMakeLists.txt | 9 --------- 2 files changed, 3 insertions(+), 20 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ce7c14b6..e79e7910 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -24,6 +24,9 @@ set(DECOMP_INCLUDE_PATH "${DECOMP_PATH}/include") # 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}) @@ -64,26 +67,15 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU_OSX") # Standard GNU compilers elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") if ( CMAKE_BUILD_TYPE MATCHES "Release" ) -<<<<<<< HEAD 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} -O3 -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 -ffree-form -ffree-line-length-none -fcheck=all -fbounds-check -ffpe-trap=zero,overflow -Wall -Wconversion -Wextra -Waliasing -Wsurprising -fallow-argument-mismatch -finit-integer=0 -finit-real=zero") -======= - 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 -fallow-argument-mismatch -finit-integer=0 -finit-real=zero") elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) 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") ->>>>>>> 4af35cc4 (changes to make code compile on AMD machine with GNU) endif() elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "Cray") diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9ed68b16..0af533b3 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -26,24 +26,15 @@ 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() # Replace $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a with local library if needed -<<<<<<< HEAD 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}) -======= - target_link_libraries(PadeOps fftw3 2decomp_fft $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a ${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}) ->>>>>>> 4af35cc4 (changes to make code compile on AMD machine with GNU) -endif() if ( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) target_link_libraries(PadeOps fftw3 2decomp_fft ${MPI_LIBRARIES}) elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") # Replace $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a with local library if needed -<<<<<<< HEAD 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}) -======= - target_link_libraries(PadeOps fftw3 2decomp_fft $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu.a ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ${MPI_LIBRARIES}) ->>>>>>> 4af35cc4 (changes to make code compile on AMD machine with GNU) elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU_OSX") target_link_libraries(PadeOps fftw3 2decomp_fft blas lapack ${MPI_LIBRARIES}) endif() From 23da9d222c87a806a1616ad4328b3c87582f4da0 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 19 Feb 2026 14:55:24 -0500 Subject: [PATCH 052/114] missing endif() from merging during rebase --- src/CMakeLists.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 0af533b3..e5da4f25 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -27,6 +27,7 @@ elseif( CMAKE_Fortran_COMPILER_ID MATCHES "Cray" ) else() # 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 ${MPI_LIBRARIES}) From e708588efa14c434166889c3160f25e1b360f11c Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sun, 22 Feb 2026 13:31:04 -0500 Subject: [PATCH 053/114] make deficit budgets not dependent on time-avg budgets of full flow --- .../turbines/pre_conc_compact_budgets.F90 | 8 +- .../budget_time_avg_deficit_compact.F90 | 444 ++++++++---------- src/incompressible/igrid.F90 | 1 + .../igrid_files/budgets_stuff.F90 | 74 +++ 4 files changed, 283 insertions(+), 244 deletions(-) diff --git a/problems/turbines/pre_conc_compact_budgets.F90 b/problems/turbines/pre_conc_compact_budgets.F90 index e6b5b857..1ee991e4 100644 --- a/problems/turbines/pre_conc_compact_budgets.F90 +++ b/problems/turbines/pre_conc_compact_budgets.F90 @@ -19,7 +19,7 @@ program pre_conc_compactbudgets 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) :: 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. @@ -68,10 +68,9 @@ program pre_conc_compactbudgets 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_compact%init(pre_budg_tavg, primary_inputfile, budg_tavg) + call budg_tavg_deficit_compact%init(pre_budg_tavg, primary_inputfile, primary) end if if (primary%useWindTurbines) then @@ -112,7 +111,7 @@ program pre_conc_compactbudgets call precursor%timeAdvance(dt) end if - call budg_tavg%doBudgets() + call MPI_BARRIER(MPI_COMM_WORLD, ierr) call pre_budg_tavg%doBudgets() if (do_deficit_budgets) call budg_tavg_deficit_compact%doBudgets() @@ -124,7 +123,6 @@ program pre_conc_compactbudgets ! Here include an option to expand the last written frame of budgets ! // - call budg_tavg%destroy() !<-- release memory taken by the budget classes call pre_budg_tavg%destroy() if (do_deficit_budgets) call budg_tavg_deficit_compact%destroy() diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index 9d317df4..fe1a3f65 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -5,9 +5,10 @@ module budgets_time_avg_deficit_compact_mod use exits, only: message, GracefulExit use constants, only: zero, half, two use mpi - use incompressibleGrid, only : 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 + 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 @@ -21,8 +22,11 @@ module budgets_time_avg_deficit_compact_mod integer :: run_id, nx, ny, nz logical :: do_budget0=.false., do_budget1=.false., do_budget2=.false., do_budget3=.false. - type(budgets_time_avg), pointer :: pre_budget, prim_budget - + 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 @@ -60,29 +64,22 @@ module budgets_time_avg_deficit_compact_mod procedure, private :: AssembleBudget2 procedure, private :: AssembleBudget3 procedure, private :: AssembleMCG - procedure, private :: restartMCG - + procedure, private :: restartMCG procedure, private :: getProductOfMeans - ! procedure, private :: writeTimeSum - ! procedure, private :: readTimeSum - procedure, private :: ddx_R2R procedure, private :: ddy_R2R procedure, private :: ddz_R2R - !procedure, private :: ddz_C2R procedure, private :: dealias procedure, private :: interp_Edge2Cell - ! procedure, private :: interp_Cell2Edge - ! procedure, private :: multiply_CellFieldsOnEdges - ! procedure, private :: multiply_edges_interp_cell end type contains - subroutine init(this, pre_budget, primary_inputfile, prim_budget) + 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, prim_budget + 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 @@ -104,22 +101,19 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) close(ioUnit) this%pre_budget => pre_budget - this%prim_budget => prim_budget - this%run_id = this%prim_budget%igrid_sim%runid - this%nx = this%prim_budget%igrid_sim%gpC%xsz(1) - this%ny = this%prim_budget%igrid_sim%gpC%xsz(2) - this%nz = this%prim_budget%igrid_sim%gpC%xsz(3) ! centered grid x, y, z - ! this%nxE = this%prim_budget%igrid_sim%gpE%xsz(1) - ! this%nyE = this%prim_budget%igrid_sim%gpE%xsz(2) - ! this%nzE = this%prim_budget%igrid_sim%gpE%xsz(3) + 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_budget%igrid_sim%useWindTurbines - this%isStratified = this%prim_budget%igrid_sim%isStratified - this%useCoriolis = this%prim_budget%igrid_sim%useCoriolis + !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. @@ -176,7 +170,7 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) 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_budget%igrid_sim%outputDir + this%budgets_dir = this%prim_igrid_sim%outputDir end if if ((trim(restart_dir) .eq. "null") .or.(trim(restart_dir) .eq. "NULL")) then @@ -189,6 +183,36 @@ subroutine init(this, pre_budget, primary_inputfile, prim_budget) 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 @@ -200,19 +224,19 @@ subroutine doBudgets(this, forceDump) this%forceDump = forceDump endif - if(this%prim_budget%igrid_sim%tsim > this%prim_budget%igrid_sim%tstop) then + 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_budget%igrid_sim%step>this%tidx_budget_start) ) .or. & - ( (this%time_budget_start>0) .and. (this%prim_budget%igrid_sim%tsim>this%time_budget_start) ) ) 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_budget%igrid_sim%step,this%tidx_compute) .eq. 0) then + if (mod(this%prim_igrid_sim%step,this%tidx_compute) .eq. 0) then call this%updateBudget() end if - if ((mod(this%prim_budget%igrid_sim%step,this%tidx_dump) .eq. 0) .or. this%forceDump) then + 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 @@ -226,13 +250,13 @@ 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_budget%igrid_sim%getMomentumTerms() + 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_budget%igrid_sim%sgsmodel%populate_tauij_E_to_C() - this%delta_tauij = this%prim_budget%igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij + 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() @@ -255,7 +279,7 @@ subroutine DumpBudget(this) ! Cell x-pencil buffers ! Buffers 1 and 2 are used locally inside getProductOfMeans - buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + 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 @@ -348,7 +372,7 @@ subroutine DumpBudget(this) ! ---------------------- 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_budget%igrid_sim%duidxjC(:,:,:,1:9) - this%pre_budget%igrid_sim%duidxjC(:,:,:,1:9) + 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 @@ -359,26 +383,26 @@ subroutine AssembleBudget0(this) complex(rkind), dimension(:,:,:), pointer :: cbuffyE1, cbuffyC1 ! Link pointers - cbuffyE1 => this%prim_budget%igrid_sim%cbuffyE(:,:,:,1) - cbuffyC1 => this%prim_budget%igrid_sim%cbuffyC(:,:,:,2) ! 1 is used in ddx, ddy, ddz routines - rbuffxE1 => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) - rbuffxC1 => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) - rbuffxC2 => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) + 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_budget%igrid_sim%u - this%pre_budget%igrid_sim%u) - this%budget_0(:,:,:,2) = this%budget_0(:,:,:,2) + (this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v) - this%budget_0(:,:,:,3) = this%budget_0(:,:,:,3) + (this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC) + 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_budget%igrid_sim%pressure - this%pre_budget%igrid_sim%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_budget%igrid_sim%T - this%pre_budget%igrid_sim%T) + this%budget_0(:,:,:,5) = this%budget_0(:,:,:,5) + (this%prim_igrid_sim%T - this%pre_budget%igrid_sim%T) - cbuffyE1 = this%prim_budget%wb - this%pre_budget%wb - call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + 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 @@ -388,17 +412,17 @@ subroutine AssembleBudget0(this) ! Step 5: SGS stress gradients ! Reverse signs of usgs, vsgs, wsgs - cbuffyC1 = this%pre_budget%usgs - this%prim_budget%usgs - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + 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%prim_budget%vsgs - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, 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%prim_budget%wsgs - call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + 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 @@ -409,47 +433,47 @@ subroutine AssembleBudget0(this) this%budget_0(:,:,:,15) = this%budget_0(:,:,:,15) + rbuffxC1 this%budget_0(:,:,:,16) = this%budget_0(:,:,:,16) + rbuffxC2 - call this%prim_budget%igrid_sim%get_geostrophic_forcing(rbuffxC1, 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%prim_budget%ucor - this%pre_budget%ucor - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + 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%prim_budget%vcor - this%pre_budget%vcor - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + 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%prim_budget%px - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + 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%prim_budget%py - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + 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%prim_budget%pz - call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + 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%prim_budget%uturb - this%pre_budget%uturb - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, rbuffxC1) + 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%prim_budget%vturb - this%pre_budget%vturb - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, 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 @@ -462,25 +486,25 @@ subroutine AssembleBudget1(this) real(rkind), dimension(:,:,:), pointer :: du, dv, dw, duE, dvE, dwE, buffer, buffE ! Cell x-pencil buffers - du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) - dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) - dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) - buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + 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_budget%igrid_sim%rbuffxE(:,:,:,1) - dvE => this%prim_budget%igrid_sim%rbuffxE(:,:,:,2) + 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_budget%igrid_sim%u - this%pre_budget%igrid_sim%u - dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v - dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC + 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_budget%igrid_sim%uE - this%pre_budget%igrid_sim%uE - dvE = this%prim_budget%igrid_sim%vE - this%pre_budget%igrid_sim%vE - dwE = this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w + 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 @@ -521,15 +545,15 @@ subroutine AssembleBudget2(this) real(rkind), dimension(:,:,:), pointer :: dwdxC_prim, dwdyC_prim, dwdzC_prim, dwdxC_pre, dwdyC_pre, dwdzC_pre ! Cell x-pencil buffers - du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) - dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) - dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) - buffC => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + 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_budget%igrid_sim%u - this%pre_budget%igrid_sim%u - dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v - dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC + 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 @@ -537,15 +561,15 @@ subroutine AssembleBudget2(this) wbase => this%pre_budget%igrid_sim%wC ! Primary simulation: - dudxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,1) - dudyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,2) - dudzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,3) - dvdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,4) - dvdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,5) - dvdzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,6) - dwdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,7) - dwdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,8) - dwdzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,9) + 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) @@ -624,40 +648,40 @@ subroutine AssembleBudget3(this) real(rkind), dimension(:,:,:,:), pointer :: base_tauij ! Cell x-pencil buffers - du => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) - dv => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) - dw => this%prim_budget%igrid_sim%rbuffxC(:,:,:,3) - buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + 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_budget%igrid_sim%cbuffyC(:,:,:,2) ! 1 is used in ddx, ddy, ddz routines + cbuffyC1 => this%prim_igrid_sim%cbuffyC(:,:,:,2) ! 1 is used in ddx, ddy, ddz routines ! Edge x-pencil buffer - rbuffxE1 => this%prim_budget%igrid_sim%rbuffxE(:,:,:,1) - rbuffxE2 => this%prim_budget%igrid_sim%rbuffxE(:,:,:,2) + rbuffxE1 => this%prim_igrid_sim%rbuffxE(:,:,:,1) + rbuffxE2 => this%prim_igrid_sim%rbuffxE(:,:,:,2) ! Edge y-pencil buffer - cbuffyE1 => this%prim_budget%igrid_sim%cbuffyE(:,:,:,1) + cbuffyE1 => this%prim_igrid_sim%cbuffyE(:,:,:,1) ! Perturbation fields - du = this%prim_budget%igrid_sim%u - this%pre_budget%igrid_sim%u - dv = this%prim_budget%igrid_sim%v - this%pre_budget%igrid_sim%v - dw = this%prim_budget%igrid_sim%wC - this%pre_budget%igrid_sim%wC + 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_budget%igrid_sim%duidxjC(:,:,:,1) - dudyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,2) - dudzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,3) - dvdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,4) - dvdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,5) - dvdzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,6) - dwdxC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,7) - dwdyC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,8) - dwdzC_prim => this%prim_budget%igrid_sim%duidxjC(:,:,:,9) + 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) @@ -674,19 +698,19 @@ subroutine AssembleBudget3(this) ! 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%prim_budget%px - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) + 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%prim_budget%py - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) + 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%prim_budget%pz - call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + 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 @@ -707,19 +731,19 @@ subroutine AssembleBudget3(this) ! 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%prim_budget%usgs - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) + 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%prim_budget%vsgs - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) + 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%prim_budget%wsgs - call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + 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 @@ -769,10 +793,10 @@ subroutine AssembleBudget3(this) ! Term 12: base u_3' delta wb' ! Multiply on edges if(this%isStratified)then - cbuffyE1 = this%prim_budget%wb - this%pre_budget%wb - call this%prim_budget%igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) + cbuffyE1 = this%wb - this%pre_budget%wb + call this%prim_igrid_sim%spectE%ifft(cbuffyE1, rbuffxE1) - rbuffxE2 = rbuffxE1 * (this%prim_budget%igrid_sim%w - this%pre_budget%igrid_sim%w) + 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 @@ -781,7 +805,7 @@ subroutine AssembleBudget3(this) 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_budget%igrid_sim%w - this%pre_budget%igrid_sim%w) * 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 @@ -835,13 +859,13 @@ subroutine AssembleBudget3(this) this%budget_3(:,:,:,19) = this%budget_3(:,:,:,19) + dw * buffer ! if (this%useWindTurbines)then - ! cbuffyC1 = this%prim_budget%uturb - this%pre_budget%uturb - ! call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, buffer) + ! 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%prim_budget%vturb - this%pre_budget%vturb - ! call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC1, 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 @@ -859,8 +883,8 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) real(rkind), dimension(:,:,:), pointer :: bf, bf2 ! Cell x-pencil buffers - bf => this%prim_budget%igrid_sim%rbuffxC(:,:,:,1) - bf2 => this%prim_budget%igrid_sim%rbuffxC(:,:,:,2) + bf => this%prim_igrid_sim%rbuffxC(:,:,:,1) + bf2 => this%prim_igrid_sim%rbuffxC(:,:,:,2) buffer = 0.d0 if(budgetid.eq.1)then @@ -1216,7 +1240,7 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) ! 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_budget%igrid_sim%step,"_n",this%counter,".txt" + ! 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 @@ -1244,10 +1268,10 @@ subroutine dump_budget_field(this, field, fieldID, BudgetID) 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_budget%igrid_sim%step,"_n",this%counter,".s3D" + 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_budget%igrid_sim%gpC) + 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) @@ -1260,7 +1284,7 @@ subroutine restart_budget_field(this, field, dir, runID, timeID, counterID, budg 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_budget%igrid_sim%gpC) + call decomp_2d_read_one(1,field,fname, this%prim_igrid_sim%gpC) end subroutine subroutine RestartBudget(this, dir, rid, tid, cid) @@ -1272,7 +1296,7 @@ subroutine RestartBudget(this, dir, rid, tid, cid) real(rkind) :: totalWeight ! Cell x-pencil buffers - buffer => this%prim_budget%igrid_sim%rbuffxC(:,:,:,4) + buffer => this%prim_igrid_sim%rbuffxC(:,:,:,4) this%counter = cid totalWeight = real(this%counter,rkind) + 1.d-18 @@ -1409,7 +1433,7 @@ subroutine ResetBudget(this) subroutine destroy(this) class(budgets_time_avg_deficit_compact), intent(inout) :: this - nullify(this%prim_budget, this%pre_budget) + 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) @@ -1426,11 +1450,11 @@ subroutine dealias(this, f) real(rkind), dimension(this%nx,this%ny,this%nz), intent(inout) :: f complex(rkind), dimension(:,:,:), pointer :: cbuffyC - cbuffyC => this%prim_budget%igrid_sim%cbuffyC(:,:,:,1) + cbuffyC => this%prim_igrid_sim%cbuffyC(:,:,:,1) - call this%prim_budget%igrid_sim%spectC%fft(f, cbuffyC) - call this%prim_budget%igrid_sim%spectC%dealias(cbuffyC) - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC, f) + 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) @@ -1439,12 +1463,12 @@ subroutine ddx_R2R(this, f, dfdx) real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: dfdx complex(rkind), dimension(:,:,:), pointer :: cbuffyC - cbuffyC => this%prim_budget%igrid_sim%cbuffyC(:,:,:,1) + cbuffyC => this%prim_igrid_sim%cbuffyC(:,:,:,1) - call this%prim_budget%igrid_sim%spectC%fft(f, cbuffyC) - call this%prim_budget%igrid_sim%spectC%mtimes_ik1_ip(cbuffyC) - call this%prim_budget%igrid_sim%spectC%dealias(cbuffyC) - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC, dfdx) + 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 @@ -1455,12 +1479,12 @@ subroutine ddy_R2R(this, f, dfdy) real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: dfdy complex(rkind), dimension(:,:,:), pointer :: cbuffyC - cbuffyC => this%prim_budget%igrid_sim%cbuffyC(:,:,:,1) + cbuffyC => this%prim_igrid_sim%cbuffyC(:,:,:,1) - call this%prim_budget%igrid_sim%spectC%fft(f, cbuffyC) - call this%prim_budget%igrid_sim%spectC%mtimes_ik2_ip(cbuffyC) - call this%prim_budget%igrid_sim%spectC%dealias(cbuffyC) - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC, dfdy) + 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 @@ -1472,96 +1496,38 @@ subroutine ddz_R2R(this, f, dfdz, n1, n2) integer, intent(in) :: n1, n2 complex(rkind), dimension(:,:,:), pointer :: cbuffyC, cbuffzC1, cbuffzC2 - cbuffyC => this%prim_budget%igrid_sim%cbuffyC(:,:,:,1) - cbuffzC1 => this%prim_budget%igrid_sim%cbuffzC(:,:,:,1) - cbuffzC2 => this%prim_budget%igrid_sim%cbuffzC(:,:,:,2) + cbuffyC => this%prim_igrid_sim%cbuffyC(:,:,:,1) + cbuffzC1 => this%prim_igrid_sim%cbuffzC(:,:,:,1) + cbuffzC2 => this%prim_igrid_sim%cbuffzC(:,:,:,2) - call this%prim_budget%igrid_sim%spectC%fft(f, cbuffyC) - call transpose_y_to_z(cbuffyC, cbuffzC1, this%prim_budget%igrid_sim%sp_gpC) - call this%prim_budget%igrid_sim%Pade6opZ%ddz_C2C(cbuffzC1, cbuffzC2, n1, n2) - call transpose_z_to_y(cbuffzC2, cbuffyC, this%prim_budget%igrid_sim%sp_gpC) - call this%prim_budget%igrid_sim%spectC%dealias(cbuffyC) - call this%prim_budget%igrid_sim%spectC%ifft(cbuffyC, dfdz) + 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 ddz_C2R(this, fhat, dfdz, n1, n2) - ! class(budgets_time_avg_deficit_compact), intent(inout) :: this - ! complex(rkind), dimension(this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(1),this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(2),this%prim_budget%igrid_sim%spectC%spectdecomp%ysz(3)), intent(in) :: fhat - ! real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: dfdz - ! integer, intent(in) :: n1, n2 - - ! call transpose_y_to_z(fhat,this%prim_budget%igrid_sim%cbuffzC(:,:,:,1),this%prim_budget%igrid_sim%sp_gpC) - ! call this%prim_budget%igrid_sim%Pade6opZ%ddz_C2C(this%prim_budget%igrid_sim%cbuffzC(:,:,:,1),this%prim_budget%igrid_sim%cbuffzC(:,:,:,2),n1,n2) - ! call transpose_z_to_y(this%prim_budget%igrid_sim%cbuffzC(:,:,:,2),this%prim_budget%igrid_sim%cbuffyC(:,:,:,1),this%prim_budget%igrid_sim%sp_gpC) - ! call this%prim_budget%igrid_sim%spectC%dealias(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1)) - ! call this%prim_budget%igrid_sim%spectC%ifft(this%prim_budget%igrid_sim%cbuffyC(:,:,:,1), dfdz) - ! 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_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(in) :: fE + 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_budget%igrid_sim%rbuffyE(:,:,:,1) - rbuffzE => this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) - rbuffzC => this%prim_budget%igrid_sim%rbuffzC(:,:,:,2) - rbuffyC => this%prim_budget%igrid_sim%rbuffyC(:,:,:,1) + 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_budget%igrid_sim%gpE) - call transpose_y_to_z(rbuffyE, rbuffzE, this%prim_budget%igrid_sim%gpE) - call this%prim_budget%igrid_sim%Pade6opZ%interpz_E2C(rbuffzE, rbuffzC, n1, n2) - call transpose_z_to_y(rbuffzC, rbuffyC, this%prim_budget%igrid_sim%gpC) - call transpose_y_to_x(rbuffyC, fC, this%prim_budget%igrid_sim%gpC) + 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 - - ! subroutine interp_Cell2Edge(this, fC, fE, n1, n2) - ! class(budgets_time_avg_deficit_compact), intent(inout) :: this - ! real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: fC - ! real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(out) :: fE - - ! call transpose_x_to_y(fC,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - ! call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - ! call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),n1,n2) - ! call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),this%prim_budget%igrid_sim%gpE) - ! call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyE(:,:,:,1),fE,this%prim_budget%igrid_sim%gpE) - ! end subroutine - - ! subroutine multiply_CellFieldsOnEdges(this, f1C, f2C, fmultC, n1, n2) - ! class(budgets_time_avg_deficit_compact), intent(inout) :: this - ! real(rkind), dimension(this%nx,this%ny,this%nz), intent(in) :: f1C,f2C - ! real(rkind), dimension(this%nx,this%ny,this%nz), intent(out) :: fmultC - ! integer, intent(in) :: n1, n2 - - ! ! interpolate 1st Cell field - ! call transpose_x_to_y(f1C,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - ! call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - ! call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),n1,n2) - - ! ! interpolate 2nd Cell field - ! call transpose_x_to_y(f2C,this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - ! call transpose_y_to_z(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - ! call this%prim_budget%igrid_sim%Pade6opZ%interpz_C2E(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffzE(:,:,:,2),n1,n2) - - ! ! multiply on Edges and interpolate back to Cells - ! this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) = this%prim_budget%igrid_sim%rbuffzE(:,:,:,1) * this%prim_budget%igrid_sim%rbuffzE(:,:,:,2) - ! call this%prim_budget%igrid_sim%Pade6opZ%interpz_E2C(this%prim_budget%igrid_sim%rbuffzE(:,:,:,1),this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),n1,n2) - ! call transpose_z_to_y(this%prim_budget%igrid_sim%rbuffzC(:,:,:,1),this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),this%prim_budget%igrid_sim%gpC) - ! call transpose_y_to_x(this%prim_budget%igrid_sim%rbuffyC(:,:,:,1),fmultC,this%prim_budget%igrid_sim%gpC) - ! end subroutine - - ! multiply on edge cells and interpolate to cell centers to reduce aliasing issues - ! function multiply_Edges_interp_cell(this, f1E, f2E, n1, n2) result(fmultC) - ! class(budgets_time_avg_deficit_compact), intent(inout) :: this - ! real(rkind), dimension(this%prim_budget%igrid_sim%gpE%xsz(1),this%prim_budget%igrid_sim%gpE%xsz(2),this%prim_budget%igrid_sim%gpE%xsz(3)), intent(in) :: f1E,f2E - ! real(rkind), dimension(this%prim_budget%igrid_sim%gpC%xsz(1),this%prim_budget%igrid_sim%gpC%xsz(2),this%prim_budget%igrid_sim%gpC%xsz(3)) :: fmultC - ! integer, intent(in) :: n1, n2 - - ! call this%interp_Edge2Cell(f1E * f2E, fmultC, n1, n2) - ! end function end module diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index 3e24c7c7..269b6b90 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -380,6 +380,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 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 From 1202ce120e25c05cd968c2d2ef76118c7ef9aacd Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sun, 22 Feb 2026 13:32:02 -0500 Subject: [PATCH 054/114] add option to squeeze time-avg budget 0when it runs with deficit budgets --- src/incompressible/budget_time_avg.F90 | 78 +++++++++++++++----------- 1 file changed, 45 insertions(+), 33 deletions(-) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 9f436272..490c68cd 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 @@ -560,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 @@ -647,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 From a51b85a209234531bad0a5c09ed120ddc7f5c353 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sun, 22 Feb 2026 13:32:42 -0500 Subject: [PATCH 055/114] add option to skip box averaging of budgets in ConstructDeficitBudgets --- .../ConstructDeficitBudgets.F90 | 23 ++++++++++++------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 index d1d659da..9b15c785 100644 --- a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 @@ -41,6 +41,7 @@ module constructDeficitBudgets_mod 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 @@ -146,7 +147,7 @@ subroutine compute_budgets(key, stamp) end select ! Average this budget term across the box - call integrate_box_yz(buffer, profiles(:,idx)) + 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 @@ -1185,8 +1186,10 @@ subroutine initializeEverything() call message(0,'Identified boundary condition stenciles') ! Intersect the box with the mesh - call intersectBoxAndMesh() - call message(0,'Control volume box intersected 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) @@ -1230,9 +1233,12 @@ subroutine release_memory() deallocate(mesh, duidxj, duidxj_base, Budget0, Budget1, Budget2, baseBudget0) if(allocated(Budget3)) deallocate(Budget3) - deallocate(rbuffxC, cbuffyC, cbuffzC) - deallocate(profiles, xstations) - + 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) @@ -1255,7 +1261,8 @@ program constructDeficitBudgets character(len=clen) :: inputfile namelist /INPUT/ inputdir, outputdir, nx, ny, nz, Lx, Ly, Lz, prow, pcol, RID, & - BRID, budgettype, writeDependentVariables, startIDX, endIDX, tag + 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 @@ -1308,7 +1315,7 @@ program constructDeficitBudgets call compute_budgets(trim(sorted_keys(k)), trim(sorted_stamps(k))) ! Export profiles - if(nrank == 0)then + if((nrank == 0) .and. do_box_averaging)then call export_csv(trim(sorted_keys(k)), trim(sorted_stamps(k))) end if From 5ababb2073b523389f4d6c4acf65f511fc21e927 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 23 Feb 2026 20:53:35 -0500 Subject: [PATCH 056/114] include squeez option for restart of time-averaged budget 0 --- src/incompressible/budget_time_avg.F90 | 53 +++++++++++++++----------- 1 file changed, 31 insertions(+), 22 deletions(-) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 490c68cd..25fda7da 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -2191,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 @@ -2225,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) From 525ca7276babddb0322ed9dd3d134374cbb1a835 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 24 Feb 2026 12:15:48 -0500 Subject: [PATCH 057/114] Used ChatGPT to replace MPI_SEND & MPI_REC with MPI_GATHER in io_start to avoid deadlock that occasionally happens --- src/incompressible/igrid_files/io_stuff.F90 | 289 +++++++++++++------- 1 file changed, 192 insertions(+), 97 deletions(-) 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 From 86f45b2b03e65c46f88701f169555ed111232f28 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 24 Feb 2026 12:24:09 -0500 Subject: [PATCH 058/114] Add MPI_GATHER in the list of 'external' rouines in igrid.F90 --- src/incompressible/igrid.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index 269b6b90..6b472762 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -29,7 +29,7 @@ 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 From 55cc56156732bddccc388735f2258ac39e7d7160 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 24 Feb 2026 13:06:15 -0500 Subject: [PATCH 059/114] Add external statement for MPI_ALLREDUCE --- problems/postprocessing_igrid/ConstructDeficitBudgets.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 index 9b15c785..2a836130 100644 --- a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 @@ -11,6 +11,8 @@ module constructDeficitBudgets_mod 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 From 47639ed18188a03c751ed060175cbf735c5dd29d Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 2 Mar 2026 10:46:44 -0500 Subject: [PATCH 060/114] Cleanup MPI stuff in actuator disk module --- src/incompressible/actuatorDisk_filtered.F90 | 238 +++++++++++++++---- src/utilities/reductions.F90 | 14 +- 2 files changed, 208 insertions(+), 44 deletions(-) diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index 00697300..e1a70cae 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -81,7 +81,15 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) 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 @@ -93,7 +101,8 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) 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() @@ -119,28 +128,6 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) 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 @@ -159,6 +146,88 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) 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 + 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)) + 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, this%upsample_fact) this%npts = size(this%ys,1) @@ -178,7 +247,7 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) call message(2, "Using Dynamic Yaw") else call message(2, "Using static turbine.") - call this%get_weights() + if(this%Am_I_Active) call this%get_weights() end if call message(2, "Smearing grid parameter, Delta", this%delta) @@ -187,16 +256,84 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) 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) + if(allocated(this%yline)) deallocate(this%yline) + if(allocated(this%zline)) deallocate(this%zline) + 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) + if(allocated(this%yLine)) deallocate(this%yLine) + if(allocated(this%zLine)) deallocate(this%zLine) + + ! 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) @@ -301,8 +438,8 @@ subroutine get_R(this) 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%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 @@ -317,7 +454,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 @@ -340,12 +479,21 @@ 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 @@ -357,7 +505,7 @@ subroutine sample_on_circle(diam, xcen, ycen, xloc, yloc, dx, dy, upsample_fact) 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 dxi = min(dx, dy) / upsample_fact ! upsample the resolution of the LES grid @@ -397,6 +545,7 @@ subroutine sample_on_circle(diam, xcen, ycen, xloc, yloc, dx, dy, upsample_fact) 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 @@ -417,6 +566,7 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals, budgetCall) ! 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 @@ -438,18 +588,20 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals, budgetCall) ! 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 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 From b1dd2c5b6eae6e6d3d288638b7fe6c058c7a4adf Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 2 Mar 2026 10:47:26 -0500 Subject: [PATCH 061/114] add deallocation of extra arrays in destroy --- .../budget_time_avg_deficit_compact.F90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index fe1a3f65..22dc76b9 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -1442,6 +1442,22 @@ subroutine destroy(this) 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 ------------------------ From d9435a2f5b75dc030fa5b72ed514ed0e5c689389 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 2 Mar 2026 15:30:24 -0500 Subject: [PATCH 062/114] Add y and z momentum budgets --- .../ConstructDeficitBudgets.F90 | 190 +++++++++++++++++- 1 file changed, 184 insertions(+), 6 deletions(-) diff --git a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 index 2a836130..8079f5a7 100644 --- a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 @@ -138,11 +138,11 @@ subroutine compute_budgets(key, stamp) call compute_X_budget_component(idx, buffer) additional = '5' case(2) - !call compute_Y_budget_component(idx, buffer) - continue + call compute_Y_budget_component(idx, buffer) + additional = '6' case(3) - !call compute_Z_budget_component(idx, buffer) - continue + call compute_Z_budget_component(idx, buffer) + additional = '7' case(4) call compute_TKE_budget_component(idx, buffer) additional = '4' @@ -167,8 +167,8 @@ function depedent_variable(idx) logical :: depedent_variable depedent_variable = .false. - if(budgettype == 1)then - ! X momentum equation + 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 @@ -265,6 +265,184 @@ subroutine compute_X_budget_component(idx, buffer) 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 From f56788f203faa9669cf08c2778d941d8dadc6a81 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 3 Mar 2026 10:34:44 -0500 Subject: [PATCH 063/114] add iostat to reading namelists in constructdeficitbudgets --- problems/postprocessing_igrid/ConstructDeficitBudgets.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 index 8079f5a7..6cc08f5f 100644 --- a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 @@ -1454,10 +1454,10 @@ program constructDeficitBudgets ! Do file IO - input file ioUnit = 11 open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') - read(unit=ioUnit, NML=INPUT) - read(unit=ioUnit, NML=NUMERICS) - read(unit=ioUnit, NML=BCs) - read(unit=ioUnit, NML=BOX) + read(unit=ioUnit, NML=INPUT, IOSTAT=ierr); if (ierr/=0)call gracefulExit("Reading failed for INPUT",101) + read(unit=ioUnit, NML=NUMERICS, IOSTAT=ierr); if (ierr/=0)call gracefulExit("Reading failed for NUMERICS",102) + read(unit=ioUnit, NML=BCs, IOSTAT=ierr); if (ierr/=0)call gracefulExit("Reading failed for BCs",103) + read(unit=ioUnit, NML=BOX, IOSTAT=ierr); if (ierr/=0)call gracefulExit("Reading failed for BOX",104) close(ioUnit) periodicbcs(1) = .true.; periodicbcs(2) = .true.; periodicbcs(3) = .false. From 3089da53ddf88fa740d2cc845720ad3d97b260d2 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 3 Mar 2026 10:48:20 -0500 Subject: [PATCH 064/114] fix typo in refine_fields --- problems/incompressible/refine_fields.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/problems/incompressible/refine_fields.F90 b/problems/incompressible/refine_fields.F90 index 1a6271e5..c40ba880 100644 --- a/problems/incompressible/refine_fields.F90 +++ b/problems/incompressible/refine_fields.F90 @@ -602,7 +602,7 @@ subroutine initializeEverything(Lx, Ly, Lz, nx, ny, nz, p_row, p_col, & ! 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),gpCsp_gpC_XY_XY%ysz(2),sp_gpC_XY%ysz(3))) + 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))) From 7f553a69ad3bafc588608f557f687e71f771b8a3 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 5 Mar 2026 14:16:13 -0500 Subject: [PATCH 065/114] add some error messages to constrcutDeficitBudget --- .../ConstructDeficitBudgets.F90 | 28 +++++++++++++++---- 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 index 6cc08f5f..78d62471 100644 --- a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 @@ -1438,7 +1438,7 @@ program constructDeficitBudgets implicit none integer :: ioUnit, ierr, k logical :: periodicbcs(3) - character(len=clen) :: inputfile + character(len=clen) :: inputfile, ers namelist /INPUT/ inputdir, outputdir, nx, ny, nz, Lx, Ly, Lz, prow, pcol, RID, & BRID, budgettype, writeDependentVariables, startIDX, endIDX, tag, & @@ -1453,11 +1453,27 @@ program constructDeficitBudgets ! Do file IO - input file ioUnit = 11 - open(unit=ioUnit, file=trim(inputfile), form='FORMATTED') - read(unit=ioUnit, NML=INPUT, IOSTAT=ierr); if (ierr/=0)call gracefulExit("Reading failed for INPUT",101) - read(unit=ioUnit, NML=NUMERICS, IOSTAT=ierr); if (ierr/=0)call gracefulExit("Reading failed for NUMERICS",102) - read(unit=ioUnit, NML=BCs, IOSTAT=ierr); if (ierr/=0)call gracefulExit("Reading failed for BCs",103) - read(unit=ioUnit, NML=BOX, IOSTAT=ierr); if (ierr/=0)call gracefulExit("Reading failed for BOX",104) + 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. From 5bb4ce889f55533832630bde1cec057832663352 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 5 Mar 2026 14:21:30 -0500 Subject: [PATCH 066/114] Fix zero-padding + move decomp_inter to module level --- problems/incompressible/refine_fields.F90 | 59 +++++++++++++++-------- 1 file changed, 40 insertions(+), 19 deletions(-) diff --git a/problems/incompressible/refine_fields.F90 b/problems/incompressible/refine_fields.F90 index c40ba880..2ed4b7dd 100644 --- a/problems/incompressible/refine_fields.F90 +++ b/problems/incompressible/refine_fields.F90 @@ -20,7 +20,7 @@ module refine_fields_mod use spectralMod, only: spectral use decomp_2d use decomp_2d_io - use constants, only: zero + use constants, only: zero, half implicit none type(Pade6stagg) :: Pade6opZ @@ -37,6 +37,9 @@ module refine_fields_mod 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 @@ -187,7 +190,7 @@ subroutine refine_single_field(field_c, field_f, dz, n1, n2) 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) + 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 @@ -213,7 +216,7 @@ subroutine refine_single_fieldE(field_c, field_f, dz, n1, n2, n3, n4) 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) + 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 @@ -228,7 +231,7 @@ subroutine refine_single_fieldE(field_c, field_f, dz, n1, n2, n3, n4) end subroutine refine_single_fieldE - subroutine refine_horizontally(field_c, field_f, spect_c, spect_f) + subroutine refine_horizontally(field_c, field_f, spect_c, spect_f, decomp_inter) implicit none ! Arguments @@ -236,6 +239,7 @@ subroutine refine_horizontally(field_c, field_f, spect_c, spect_f) 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 @@ -244,18 +248,15 @@ subroutine refine_horizontally(field_c, field_f, spect_c, spect_f) 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) - type(decomp_info) :: decomp_inter integer :: nxc_g, nyc_g, nxf_g, nyf_g, nzc_g integer :: nxc_hat - !real(rkind) :: scale - + 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 - ! Initialize Intermediate Decomposition (Coarse X_hat, Fine Y, Coarse Z) - call decomp_info_init(nxc_hat, nyf_g, nzc_g, decomp_inter) - !=============================================================== ! SAFEGUARDS (single place, integer-only checks) !=============================================================== @@ -327,24 +328,36 @@ subroutine refine_horizontally(field_c, field_f, spect_c, spect_f) 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) - ! Non-negative block includes Nyquist - hat_i_yp(:, 1:nyc_g/2+1, :) = hat_c_yp(:, 1:nyc_g/2+1, :) + 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, :) - ! Strictly negative modes only (length = nyc/2 - 1) - hat_i_yp(:, nyf_g-(nyc_g/2-1)+1:nyf_g, :) = hat_c_yp(:, nyc_g/2+2:nyc_g, :) + ! 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) - hat_f_xp(1:nxc_hat, :, :) = hat_i_xp(1:nxc_hat, :, :) + 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 + 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))) @@ -355,8 +368,7 @@ subroutine refine_horizontally(field_c, field_f, spect_c, spect_f) ! Cleanup deallocate(hat_c_yp, hat_i_yp, hat_i_xp, hat_f_xp, hat_f_yp) - call decomp_info_finalize(decomp_inter) - + end subroutine refine_horizontally subroutine refine_z_physical(field_c, field_f, dz_c, staggered, bottom_flag, top_flag, n3, n4) @@ -579,6 +591,10 @@ subroutine initializeEverything(Lx, Ly, Lz, nx, ny, nz, p_row, p_col, & 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.) @@ -676,6 +692,11 @@ subroutine cleanup() 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 From ff5d0bdba6fe0114324bad6a291ffe2dde1481d0 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 11 Mar 2026 15:07:54 -0400 Subject: [PATCH 067/114] deallocate ktmp at end of fft init --- src/derivatives/ffts.F90 | 1 + 1 file changed, 1 insertion(+) 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) From aa03265de8eb80741045ec6bc4ff526a9c4e1354 Mon Sep 17 00:00:00 2001 From: karimali Date: Mon, 16 Mar 2026 18:44:22 -0400 Subject: [PATCH 068/114] fix build on PadeOps --- setup/SetupEnv_Engaging_Intel.sh | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) 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 From fc4393acfbbf10a739249200026162c7fe15d0f7 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 26 Mar 2026 17:03:36 -0400 Subject: [PATCH 069/114] Add specific height to pertub T below instead of using xdim in case Ro is very high by design --- .../gablsdyn_igrid_files/initialize.F90 | 29 ++++++++++++------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/problems/incompressible/gablsdyn_igrid_files/initialize.F90 b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 index 7b16b9ab..c2b4bd07 100644 --- a/problems/incompressible/gablsdyn_igrid_files/initialize.F90 +++ b/problems/incompressible/gablsdyn_igrid_files/initialize.F90 @@ -80,11 +80,11 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) 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 + 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 + 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') @@ -123,7 +123,14 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) end do if(allocated(randArr)) deallocate(randArr) - where (z > 50.d0/xdim) + 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 @@ -161,8 +168,8 @@ subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) 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 - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + 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') @@ -180,8 +187,8 @@ subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) 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 - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + 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') @@ -251,8 +258,8 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) 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 - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + 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') @@ -299,8 +306,8 @@ subroutine set_Reference_Temperature(inputfile, Thetaref) 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 - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + 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') From 78007036f46a70d84358f664d61c30ca74ef0d55 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 26 Mar 2026 17:09:23 -0400 Subject: [PATCH 070/114] add hpert to pre_conc_compact_budget --- .../initialize.F90 | 29 ++++++++++++------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 index cf2272b6..ca3396a7 100644 --- a/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 +++ b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 @@ -80,10 +80,10 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) 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 + 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 + 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 @@ -121,7 +121,14 @@ subroutine initfields_wallM(decompC, decompE, inputfile, mesh, fieldsC, fieldsE) end do deallocate(randArr) - where (z > 50.d0/xdim) + 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 @@ -159,8 +166,8 @@ subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) 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 - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + 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') @@ -178,8 +185,8 @@ subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) 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 - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + 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') @@ -249,8 +256,8 @@ subroutine meshgen_wallM(decomp, dx, dy, dz, mesh, inputfile) 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 - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + 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') @@ -297,8 +304,8 @@ subroutine set_Reference_Temperature(inputfile, Thetaref) 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 - namelist /PROBLEM_INPUT/ Lx, Ly, Lz, Tref, Tsurf0, dTsurf_dt, inv_height, inv_thickness, inv_strength, lapse_rate + 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') From 9bb2046acc3f0d72185631204742e5871ecea5e2 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 26 Mar 2026 17:27:21 -0400 Subject: [PATCH 071/114] Add a fringe method to damp advection of vertical momentum --- src/incompressible/fringeADmethod.F90 | 110 +++++++++++++++++++ src/incompressible/igrid.F90 | 34 +++++- src/incompressible/igrid_files/rhs_stuff.F90 | 49 +++++++-- 3 files changed, 183 insertions(+), 10 deletions(-) create mode 100644 src/incompressible/fringeADmethod.F90 diff --git a/src/incompressible/fringeADmethod.F90 b/src/incompressible/fringeADmethod.F90 new file mode 100644 index 00000000..2fa7fd0d --- /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(len=clen), 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 \ No newline at end of file diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index 6b472762..f25c3516 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 @@ -268,6 +269,10 @@ 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 @@ -425,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. @@ -442,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, & @@ -452,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, & @@ -498,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 @@ -687,7 +695,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)) @@ -1182,6 +1194,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 diff --git a/src/incompressible/igrid_files/rhs_stuff.F90 b/src/incompressible/igrid_files/rhs_stuff.F90 index ee803913..f0d9e441 100644 --- a/src/incompressible/igrid_files/rhs_stuff.F90 +++ b/src/incompressible/igrid_files/rhs_stuff.F90 @@ -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 From 15df3195d97ea300efdbb0972da273b061474289 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 2 Apr 2026 23:54:48 -0400 Subject: [PATCH 072/114] fix inputfile length in declaration --- src/incompressible/fringeADmethod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/incompressible/fringeADmethod.F90 b/src/incompressible/fringeADmethod.F90 index 2fa7fd0d..b7e9812b 100644 --- a/src/incompressible/fringeADmethod.F90 +++ b/src/incompressible/fringeADmethod.F90 @@ -24,7 +24,7 @@ subroutine destroy(this) subroutine init(this, inputfile, nx, ny, nz, x, z, Lx, dz) class(fringeAD), intent(inout) :: this - character(len=clen), intent(in) :: inputfile + character(*), intent(in) :: inputfile integer, intent(in) :: nx, ny, nz real(rkind), intent(in) :: x(nx), z(nz), dz, Lx integer :: k, ioUnit, ierr @@ -107,4 +107,4 @@ subroutine S_fringe(this, x, output) end if end do end subroutine -end module fringeADMethod \ No newline at end of file +end module fringeADMethod From 39a16124ecd84413563d69718c89ac030671b21c Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 7 Apr 2026 17:39:05 -0400 Subject: [PATCH 073/114] safeguard actuatordisk_filtered aganst single-cell slabs --- src/incompressible/actuatorDisk_filtered.F90 | 41 +++++++++++--------- src/incompressible/igrid.F90 | 11 +++--- 2 files changed, 28 insertions(+), 24 deletions(-) diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index e1a70cae..34c42743 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -32,7 +32,7 @@ module actuatorDisk_FilteredMod ! Grid Info 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 @@ -119,20 +119,14 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) 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,:) + ! 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 @@ -214,9 +208,12 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) ! 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%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)) this%scalarsource = zero @@ -262,8 +259,6 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) if(allocated(this%ys)) deallocate(this%ys) if(allocated(this%zs)) deallocate(this%zs) if(allocated(this%xline)) deallocate(this%xline) - if(allocated(this%yline)) deallocate(this%yline) - if(allocated(this%zline)) deallocate(this%zline) nullify(this%xG, this%yG, this%zG) end if call toc(MPI_COMM_WORLD, time2initialize) @@ -321,8 +316,6 @@ subroutine destroy(this) if(allocated(this%ys)) deallocate(this%ys) if(allocated(this%zs)) deallocate(this%zs) if(allocated(this%xLine)) deallocate(this%xLine) - if(allocated(this%yLine)) deallocate(this%yLine) - if(allocated(this%zLine)) deallocate(this%zLine) ! Free communicator if (this%myComm /= MPI_COMM_NULL .and. & @@ -616,10 +609,14 @@ subroutine get_RHS(this, u, v, w, rhsxvals, rhsyvals, rhszvals, budgetCall) if (present(budgetCall)) writeTurbineVals = (.not. budgetCall) if ((writeTurbineVals) .and. (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 + 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 @@ -707,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 + 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/igrid.F90 b/src/incompressible/igrid.F90 index f25c3516..ccd37bcc 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -557,11 +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 + ! 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 From 218f6e24b9ac8b22bbe1ee8a9f9b41030788372d Mon Sep 17 00:00:00 2001 From: Karim Ali <41688083+karimali5@users.noreply.github.com> Date: Tue, 7 Apr 2026 23:38:42 -0400 Subject: [PATCH 074/114] Use correct decomp_info object for edge transpose in buoyancy term --- src/incompressible/igrid_files/rhs_stuff.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incompressible/igrid_files/rhs_stuff.F90 b/src/incompressible/igrid_files/rhs_stuff.F90 index f0d9e441..550b96b3 100644 --- a/src/incompressible/igrid_files/rhs_stuff.F90 +++ b/src/incompressible/igrid_files/rhs_stuff.F90 @@ -432,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 From d833d7af3c97f58896be820b3095b250e05d4f06 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 15 Apr 2026 16:22:49 -0400 Subject: [PATCH 075/114] Add setup file for Anvil --- setup/SetupEnv_Anvil.sh | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 setup/SetupEnv_Anvil.sh diff --git a/setup/SetupEnv_Anvil.sh b/setup/SetupEnv_Anvil.sh new file mode 100644 index 00000000..47af4f6e --- /dev/null +++ b/setup/SetupEnv_Anvil.sh @@ -0,0 +1,18 @@ +#!/bin/bash +module purge +module load intel +module load cmake +module load impi +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" From 006b4de62fcf66a37229d18ccb04b290e560340a Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 17 Apr 2026 15:20:35 -0400 Subject: [PATCH 076/114] specify versions of loaded modules --- setup/SetupEnv_Anvil.sh | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/setup/SetupEnv_Anvil.sh b/setup/SetupEnv_Anvil.sh index 47af4f6e..53254c8f 100644 --- a/setup/SetupEnv_Anvil.sh +++ b/setup/SetupEnv_Anvil.sh @@ -1,9 +1,9 @@ #!/bin/bash module purge -module load intel -module load cmake -module load impi -module load intel-mkl +module load intel/2024.1 +module load cmake/3.20.0 +module load impi/2021.12 +module load intel-mkl/2020.4.304 module list export COMPILER_ID=Intel From 2ed516553665fd71b04144567db7e2f67cb2bb81 Mon Sep 17 00:00:00 2001 From: Karim Ali <41688083+karimali5@users.noreply.github.com> Date: Mon, 4 May 2026 16:02:16 -0400 Subject: [PATCH 077/114] Refactor min/max calculations in doTemporalStuff Refactor min/max calculations for velocity and scalars to avoid deadlock when called as arguments of a message subroutine --- .../temporalHook.F90 | 35 ++++++++++++++----- 1 file changed, 27 insertions(+), 8 deletions(-) diff --git a/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 b/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 index de9f0e46..5eb63c5f 100644 --- a/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 +++ b/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 @@ -20,6 +20,7 @@ module temporalHook 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) @@ -36,9 +37,19 @@ subroutine doTemporalStuff(gp, simid) 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))) + + 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) @@ -57,12 +68,20 @@ subroutine doTemporalStuff(gp, simid) 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))) + 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 (p_maxval(maxval(gp%u))>4.) then + 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") @@ -81,4 +100,4 @@ subroutine doTemporalStuff(gp, simid) -end module \ No newline at end of file +end module From 01d6762c3f79409bb0155183b02907f5990451bb Mon Sep 17 00:00:00 2001 From: Karim Ali <41688083+karimali5@users.noreply.github.com> Date: Mon, 4 May 2026 16:08:58 -0400 Subject: [PATCH 078/114] Fringe: Compute reduced min/max outside function/subroutine arguments --- src/incompressible/fringemethod.F90 | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) 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 From 5b57391e90eb7a75ea8cb50bfbc924e0b440ab78 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 4 May 2026 15:41:05 -0500 Subject: [PATCH 079/114] fix typo in latest commit of temporalHook --- .../pre_conc_compact_budgets_files/temporalHook.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 b/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 index 5eb63c5f..784529eb 100644 --- a/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 +++ b/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 @@ -69,15 +69,15 @@ subroutine doTemporalStuff(gp, simid) 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))) + 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))) + 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))) + global_max = p_maxval(maxval(gp%scalars(3)%F)) call message_min_max(1,"Bounds for SCALAR 3:", global_min, global_max) end if From 0886d5255cd1f4e922609590f19c3da2c0400247 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 4 May 2026 17:32:00 -0400 Subject: [PATCH 080/114] Derivative of multiple files in the same call --- problems/postprocessing_igrid/Derivatives.F90 | 180 ++++++++++++++---- setup/SetupEnv_Anvil.sh | 8 +- 2 files changed, 151 insertions(+), 37 deletions(-) diff --git a/problems/postprocessing_igrid/Derivatives.F90 b/problems/postprocessing_igrid/Derivatives.F90 index b0bcb1b5..502f8b78 100644 --- a/problems/postprocessing_igrid/Derivatives.F90 +++ b/problems/postprocessing_igrid/Derivatives.F90 @@ -10,7 +10,7 @@ module derivatives_mod implicit none integer :: myrank, nprocs - character(len=clen) :: inputdir, outputdir, filename + 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 @@ -125,6 +125,84 @@ subroutine ddz_Edge(f, dfdz, n1, n2, n3, n4) 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 @@ -139,9 +217,15 @@ program derivatives 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, & - is_staggered, bottom_BC, top_BC, NumericalSchemeVert + mapfile, is_staggered, bottom_BC, top_BC, NumericalSchemeVert call MPI_Init(ierr) call MPI_Comm_rank(MPI_COMM_WORLD, myrank, ierr) @@ -195,39 +279,69 @@ program derivatives ddy_ptr => ddy_Cell end if - ! Read input - tmpname = trim(inputdir)//"/"//trim(filename) - 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) + ! 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 - call message(1, 'Reading '//trim(tmpname)) - call decomp_2d_read_one(1, buffer, trim(tmpname), gp) - - ! Derivative selection - select case (derivative_type) - 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) + + ! 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 - tag = "ddz" - case default - call gracefulExit("Invalid derivative_type. Must be 'x', 'y', or 'z'.", 103) - end select - - ! Write output - outfile = trim(outputdir)//"/"//trim(tag)//"_"//trim(filename) - call message(1, 'Writing '//trim(outfile)) - call decomp_2d_write_one(1, deriv, trim(outfile), gp) + + 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) diff --git a/setup/SetupEnv_Anvil.sh b/setup/SetupEnv_Anvil.sh index 53254c8f..19d5fbde 100644 --- a/setup/SetupEnv_Anvil.sh +++ b/setup/SetupEnv_Anvil.sh @@ -1,9 +1,9 @@ #!/bin/bash module purge -module load intel/2024.1 -module load cmake/3.20.0 -module load impi/2021.12 -module load intel-mkl/2020.4.304 +module load intel +module load cmake +module load mvapich2 +module load intel-mkl module list export COMPILER_ID=Intel From 686c0af72fb89815968f52a5f8350b1966165f67 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 5 May 2026 14:01:48 -0400 Subject: [PATCH 081/114] Safeguards in destroy of compact deficit budgets --- src/incompressible/budget_time_avg_deficit_compact.F90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index 22dc76b9..a18bccb5 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -870,7 +870,7 @@ subroutine AssembleBudget3(this) ! 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(du, dv, dw, rbuffxE1, rbuffxE2, 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) @@ -1433,7 +1433,6 @@ subroutine ResetBudget(this) 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) @@ -1458,6 +1457,8 @@ subroutine destroy(this) if(allocated(this%vcor)) deallocate(this%vcor) if(allocated(this%wcor)) deallocate(this%wcor) if(allocated(this%wb)) deallocate(this%wb) + + nullify(this%pre_budget, this%prim_igrid_sim) end subroutine ! ----------------------private derivative operators ------------------------ From bb01d54f7261e9fcc07710e822b9747c61eab480 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 21 May 2026 17:44:27 -0400 Subject: [PATCH 082/114] Add program to clip 3D field --- problems/postprocessing_igrid/Clip.F90 | 861 ++++++++++++++++++ .../Clip_files/input_clip.dat | 23 + 2 files changed, 884 insertions(+) create mode 100644 problems/postprocessing_igrid/Clip.F90 create mode 100644 problems/postprocessing_igrid/Clip_files/input_clip.dat diff --git a/problems/postprocessing_igrid/Clip.F90 b/problems/postprocessing_igrid/Clip.F90 new file mode 100644 index 00000000..3bc072d6 --- /dev/null +++ b/problems/postprocessing_igrid/Clip.F90 @@ -0,0 +1,861 @@ +module clip_mod + use mpi + use decomp_2d + use decomp_2d_io + use exits, only: message, gracefulExit + use constants, only: zero, half + use kind_parameters, only: rkind, clen + + implicit none + + private + + public :: initialize_clipper + public :: clip_and_write_file + public :: finalize_clipper + + ! Full-domain descriptors + type(decomp_info), target :: gpC, gpE + + ! Clipped-domain descriptor + type(decomp_info), target :: gpClip + + ! MPI + integer :: myrank = 0, nprocs = 1 + + ! Global full-domain sizes + integer :: nx = 0, ny = 0, nz = 0 + integer :: prow = 0, pcol = 0 + + ! Physical dimensions + real(rkind) :: Lx = zero, Ly = zero, Lz = zero + real(rkind) :: dx = zero, dy = zero, dz = zero + + ! User bounds + real(rkind) :: x1 = zero, x2 = zero + real(rkind) :: y1 = zero, y2 = zero + real(rkind) :: z1 = zero, z2 = zero + + ! Clipped global old-index bounds + integer :: ix1 = 0, ix2 = 0 + integer :: iy1 = 0, iy2 = 0 + integer :: iz1 = 0, iz2 = 0 + + ! Clipped global sizes + integer :: nx_clip = 0 + integer :: ny_clip = 0 + integer :: nz_clip = 0 + + ! Field grid type: + ! 'C' -> cell-centered, old global size nx,ny,nz + ! 'E' -> vertically staggered, old global size nx,ny,nz+1 + character(len=1) :: field_grid = 'C' + + ! Owner lookup for gpClip + integer, allocatable :: clip_xst_all(:,:), clip_xen_all(:,:) + + ! Cached ownership of the old descriptor (set once in initialize_clipper). + integer, allocatable :: old_xst_all(:,:), old_xen_all(:,:) + +contains + +!======================================================================= +! Initialize full-domain descriptors and clipped descriptor. +!======================================================================= +subroutine initialize_clipper(nx_in, ny_in, nz_in, Lx_in, Ly_in, Lz_in, & + prow_in, pcol_in, periodicbcs, & + x1_in, x2_in, y1_in, y2_in, z1_in, z2_in, & + field_grid_in) + implicit none + + integer, intent(in) :: nx_in, ny_in, nz_in + integer, intent(in) :: prow_in, pcol_in + real(rkind), intent(in) :: Lx_in, Ly_in, Lz_in + real(rkind), intent(in) :: x1_in, x2_in + real(rkind), intent(in) :: y1_in, y2_in + real(rkind), intent(in) :: z1_in, z2_in + logical, intent(in) :: periodicbcs(3) + character(len=*), intent(in) :: field_grid_in + + integer :: ierr + + call MPI_Comm_rank(MPI_COMM_WORLD, myrank, ierr) + call MPI_Comm_size(MPI_COMM_WORLD, nprocs, ierr) + + nx = nx_in + ny = ny_in + nz = nz_in + + Lx = Lx_in + Ly = Ly_in + Lz = Lz_in + + prow = prow_in + pcol = pcol_in + + x1 = x1_in + x2 = x2_in + y1 = y1_in + y2 = y2_in + z1 = z1_in + z2 = z2_in + + field_grid = adjustl(field_grid_in) + + dx = Lx / real(nx, rkind) + dy = Ly / real(ny, rkind) + dz = Lz / real(nz, rkind) + + if (field_grid /= 'C' .and. field_grid /= 'c' .and. & + field_grid /= 'E' .and. field_grid /= 'e') then + call gracefulExit("field_grid must be either 'C' or 'E'.", 501) + end if + + ! Full-domain decomp. + call decomp_2d_init(nx, ny, nz, prow, pcol, periodicbcs) + call get_decomp_info(gpC) + + ! Vertically staggered / edge descriptor. + call decomp_info_init(nx, ny, nz + 1, gpE) + + call compute_clip_indices() + + ! New clipped descriptor. + call decomp_info_init(nx_clip, ny_clip, nz_clip, gpClip) + + call build_clip_owner_lookup() + ! Cache old-descriptor ownership once. + ! field_grid is already validated and fixed at this point. + if (field_grid == 'C' .or. field_grid == 'c') then + call gather_descriptor_ownership(gpC, old_xst_all, old_xen_all) + else + call gather_descriptor_ownership(gpE, old_xst_all, old_xen_all) + end if + + if (myrank == 0) then + call message(0, 'Clipper initialized.') + call message(0, ' field_grid = '//field_grid) + call message(0, ' clipped old-index bounds:') + call message(0, ' ix = '//trim(to_string(ix1))//' : '//trim(to_string(ix2))) + call message(0, ' iy = '//trim(to_string(iy1))//' : '//trim(to_string(iy2))) + call message(0, ' iz = '//trim(to_string(iz1))//' : '//trim(to_string(iz2))) + call message(0, ' clipped size:') + call message(0, ' nx_clip = '//trim(to_string(nx_clip))) + call message(0, ' ny_clip = '//trim(to_string(ny_clip))) + call message(0, ' nz_clip = '//trim(to_string(nz_clip))) + end if + +end subroutine initialize_clipper + +!======================================================================= +! Compute index bounds for the selected grid. +! +! C grid: +! x_i = (i - 1) dx +! y_j = (j - 1) dy +! z_k = (k - 1/2) dz +! +! E grid: +! x_i = (i - 1) dx +! y_j = (j - 1) dy +! z_k = (k - 1) dz, k = 1,...,nz+1 +!======================================================================= +subroutine compute_clip_indices() + implicit none + + real(rkind) :: xmin, xmax + real(rkind) :: ymin, ymax + real(rkind) :: zmin, zmax + real(rkind), parameter :: clip_eps = 100.0_rkind * epsilon(1.0_rkind) + + xmin = min(x1, x2) + xmax = max(x1, x2) + + ymin = min(y1, y2) + ymax = max(y1, y2) + + zmin = min(z1, z2) + zmax = max(z1, z2) + + ix1 = max(1, int(ceiling(xmin/dx + 1.0_rkind - clip_eps * (abs(xmin/dx) + 1.0_rkind)))) + ix2 = min(nx, int(floor (xmax/dx + 1.0_rkind + clip_eps * (abs(xmax/dx) + 1.0_rkind)))) + iy1 = max(1, int(ceiling(ymin/dy + 1.0_rkind - clip_eps * (abs(ymin/dy) + 1.0_rkind)))) + iy2 = min(ny, int(floor (ymax/dy + 1.0_rkind + clip_eps * (abs(ymax/dy) + 1.0_rkind)))) + + select case(field_grid) + case('C','c') + ! z_k = (k - 1/2) dz + iz1 = max(1, int(ceiling(zmin/dz + half - clip_eps* (abs(zmin/dz) + 1.0_rkind)))) + iz2 = min(nz, int(floor (zmax/dz + half + clip_eps* (abs(zmax/dz) + 1.0_rkind)))) + + case('E','e') + ! z_k = (k - 1) dz, k = 1,...,nz+1 + iz1 = max(1, int(ceiling(zmin/dz + 1.0_rkind - clip_eps* (abs(zmin/dz) + 1.0_rkind)))) + iz2 = min(nz + 1, int(floor (zmax/dz + 1.0_rkind + clip_eps* (abs(zmax/dz) + 1.0_rkind)))) + end select + + if (ix2 < ix1 .or. iy2 < iy1 .or. iz2 < iz1) then + call gracefulExit('Clip bounds do not intersect the selected grid.', 502) + end if + + nx_clip = ix2 - ix1 + 1 + ny_clip = iy2 - iy1 + 1 + nz_clip = iz2 - iz1 + 1 + +end subroutine compute_clip_indices + +subroutine build_clip_owner_lookup() + implicit none + + integer :: ierr + integer :: local_bounds(6) + integer, allocatable :: all_bounds(:) + + integer :: r + integer :: p + + if (allocated(clip_xst_all)) deallocate(clip_xst_all) + if (allocated(clip_xen_all)) deallocate(clip_xen_all) + + allocate(clip_xst_all(3,nprocs)) + allocate(clip_xen_all(3,nprocs)) + allocate(all_bounds(6*nprocs)) + + local_bounds(1:3) = gpClip%xst(1:3) + local_bounds(4:6) = gpClip%xen(1:3) + + call MPI_Allgather(local_bounds, 6, MPI_INTEGER, & + all_bounds, 6, MPI_INTEGER, & + MPI_COMM_WORLD, ierr) + + if (ierr /= MPI_SUCCESS) then + call gracefulExit('build_clip_owner_lookup: MPI_Allgather failed.', 602) + end if + + do r = 1, nprocs + p = 6*(r - 1) + + clip_xst_all(1,r) = all_bounds(p + 1) + clip_xst_all(2,r) = all_bounds(p + 2) + clip_xst_all(3,r) = all_bounds(p + 3) + + clip_xen_all(1,r) = all_bounds(p + 4) + clip_xen_all(2,r) = all_bounds(p + 5) + clip_xen_all(3,r) = all_bounds(p + 6) + end do + + deallocate(all_bounds) + +end subroutine build_clip_owner_lookup + +subroutine gather_descriptor_ownership(gp, xst_all, xen_all) + implicit none + + type(decomp_info), intent(in) :: gp + + integer, allocatable, intent(out) :: xst_all(:,:) + integer, allocatable, intent(out) :: xen_all(:,:) + + integer :: ierr + integer :: local_bounds(6) + integer, allocatable :: all_bounds(:) + + integer :: r + integer :: p + + if (allocated(xst_all)) deallocate(xst_all) + if (allocated(xen_all)) deallocate(xen_all) + + allocate(xst_all(3,nprocs)) + allocate(xen_all(3,nprocs)) + allocate(all_bounds(6*nprocs)) + + local_bounds(1:3) = gp%xst(1:3) + local_bounds(4:6) = gp%xen(1:3) + + call MPI_Allgather(local_bounds, 6, MPI_INTEGER, & + all_bounds, 6, MPI_INTEGER, & + MPI_COMM_WORLD, ierr) + + if (ierr /= MPI_SUCCESS) then + call gracefulExit('gather_descriptor_ownership: MPI_Allgather failed.', 605) + end if + + do r = 1, nprocs + p = 6*(r - 1) + + xst_all(1,r) = all_bounds(p + 1) + xst_all(2,r) = all_bounds(p + 2) + xst_all(3,r) = all_bounds(p + 3) + + xen_all(1,r) = all_bounds(p + 4) + xen_all(2,r) = all_bounds(p + 5) + xen_all(3,r) = all_bounds(p + 6) + end do + + deallocate(all_bounds) + +end subroutine gather_descriptor_ownership + +!======================================================================= +! Clip one scalar 3D file. +!======================================================================= +subroutine clip_and_write_file(inputdir, infile, basefile, outputdir, outfile) + implicit none + + character(len=*), intent(in) :: inputdir + character(len=*), intent(in) :: infile + character(len=*), intent(in) :: basefile + character(len=*), intent(in) :: outputdir + character(len=*), intent(in) :: outfile + + real(rkind), allocatable :: field_old(:,:,:), buffer(:,:,:) + real(rkind), allocatable :: field_clip(:,:,:) + character(len=clen) :: filename, outfile_local + + select case(field_grid) + case('C','c') + allocate(field_old(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3))) + allocate(buffer(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3))) + + case('E','e') + allocate(field_old(gpE%xsz(1), gpE%xsz(2), gpE%xsz(3))) + allocate(buffer(gpE%xsz(1), gpE%xsz(2), gpE%xsz(3))) + end select + + allocate(field_clip(gpClip%xsz(1), gpClip%xsz(2), gpClip%xsz(3))) + + filename = trim(inputdir)//'/'//trim(infile) + if (myrank == 0) then + call message(0, 'Reading '//trim(filename)) + end if + select case(field_grid) + case('C','c') + call decomp_2d_read_one(1, field_old, trim(filename), gpC) + + case('E','e') + call decomp_2d_read_one(1, field_old, trim(filename), gpE) + end select + + if(trim(basefile) /= '') then + filename = trim(inputdir)//'/'//trim(basefile) + if (myrank == 0) then + call message(0, 'Reading '//trim(filename)) + end if + select case(field_grid) + case('C','c') + call decomp_2d_read_one(1, buffer, trim(filename), gpC) + case('E','e') + call decomp_2d_read_one(1, buffer, trim(filename), gpE) + end select + + field_old = field_old + buffer + end if + + field_clip = zero + call redistribute_clip_xpencil(field_old, field_clip) + + if(trim(outfile) == '') then + outfile_local = 'clipped_'//trim(infile) + else + outfile_local = trim(outfile) + end if + filename = trim(outputdir)//'/'//trim(outfile_local) + if (myrank == 0) then + call message(0, 'Writing clipped field to '//trim(filename)) ! outfile may be '' + end if + call decomp_2d_write_one(1, field_clip, trim(filename), gpClip) + + deallocate(field_old) + deallocate(field_clip) + deallocate(buffer) + +end subroutine clip_and_write_file + +subroutine redistribute_clip_xpencil(field_old, field_clip) + implicit none + + real(rkind), intent(in) :: field_old(:,:,:) + real(rkind), intent(out) :: field_clip(:,:,:) + + type(decomp_info), pointer :: gpOld + + integer :: ierr + + ! MPI source/destination ranks. + integer :: src_rank, dst_rank + + ! Loop indices in clipped global coordinates. + integer :: ig_clip, jg_clip, kg_clip + + ! Local indices in old and clipped arrays. + integer :: i_old, j_old, k_old + integer :: i_clip, j_clip, k_clip + + ! Intersection box in clipped global coordinates. + integer :: ixlo, ixhi + integer :: iylo, iyhi + integer :: izlo, izhi + logical :: has_box + + ! Communication metadata. + integer, allocatable :: send_counts(:), recv_counts(:) + integer, allocatable :: send_displs(:), recv_displs(:) + + ! Send/receive buffers. + real(rkind), allocatable :: send_val(:), recv_val(:) + + ! Buffer positions. + integer :: pos + integer :: total_send, total_recv + + ! Optional consistency counters. + integer :: expected_count + integer :: packed_count + integer :: unpacked_count + + !------------------------------------------------------------ + ! Select old descriptor. + ! + ! C: cell-centered descriptor gpC, global size nx,ny,nz. + ! E: vertically staggered descriptor gpE, global size nx,ny,nz+1. + !------------------------------------------------------------ + if (field_grid == 'C' .or. field_grid == 'c') then + gpOld => gpC + else + gpOld => gpE + end if + + !------------------------------------------------------------ + ! Allocate communication arrays. + !------------------------------------------------------------ + allocate(send_counts(nprocs), recv_counts(nprocs)) + allocate(send_displs(nprocs), recv_displs(nprocs)) + + send_counts = 0 + recv_counts = 0 + send_displs = 0 + recv_displs = 0 + + !------------------------------------------------------------ + ! Count how many values this rank sends to each destination. + ! + ! For destination rank dst_rank, the send block is: + ! + ! old ownership of myrank, mapped to clipped coordinates + ! intersected with + ! gpClip ownership of dst_rank + ! + ! All bounds returned by get_source_dest_intersection are in + ! clipped global coordinates. + !------------------------------------------------------------ + do dst_rank = 0, nprocs - 1 + + call get_source_dest_intersection(myrank, dst_rank, old_xst_all, old_xen_all, & + ixlo, ixhi, iylo, iyhi, izlo, izhi, has_box) + + if (has_box) then + send_counts(dst_rank + 1) = get_intersection_count(ixlo, ixhi, & + iylo, iyhi, & + izlo, izhi) + else + send_counts(dst_rank + 1) = 0 + end if + + end do + + !------------------------------------------------------------ + ! Exchange counts. + !------------------------------------------------------------ + call MPI_Alltoall(send_counts, 1, MPI_INTEGER, & + recv_counts, 1, MPI_INTEGER, & + MPI_COMM_WORLD, ierr) + + if (ierr /= MPI_SUCCESS) then + call gracefulExit('redistribute_clip_xpencil: MPI_Alltoall counts failed.', 701) + end if + + call prefix_displs(send_counts, send_displs) + call prefix_displs(recv_counts, recv_displs) + + total_send = sum(send_counts) + total_recv = sum(recv_counts) + + allocate(send_val(max(total_send,1))) + allocate(recv_val(max(total_recv,1))) + + send_val = zero + recv_val = zero + + !------------------------------------------------------------ + ! Pack values only. + ! + ! Critical ordering: + ! + ! do kg_clip = izlo, izhi + ! do jg_clip = iylo, iyhi + ! do ig_clip = ixlo, ixhi + ! + ! The receiver reconstructs the same intersection box and uses + ! the same loop order during unpacking. + !------------------------------------------------------------ + do dst_rank = 0, nprocs - 1 + + call get_source_dest_intersection(myrank, dst_rank, old_xst_all, old_xen_all, & + ixlo, ixhi, iylo, iyhi, izlo, izhi, has_box) + + if (.not. has_box) cycle + + expected_count = get_intersection_count(ixlo, ixhi, iylo, iyhi, izlo, izhi) + packed_count = 0 + + pos = send_displs(dst_rank + 1) + + do kg_clip = izlo, izhi + k_old = kg_clip + iz1 - gpOld%xst(3) + + do jg_clip = iylo, iyhi + j_old = jg_clip + iy1 - gpOld%xst(2) + + do ig_clip = ixlo, ixhi + i_old = ig_clip + ix1 - gpOld%xst(1) + + if (i_old < 1 .or. i_old > gpOld%xsz(1) .or. & + j_old < 1 .or. j_old > gpOld%xsz(2) .or. & + k_old < 1 .or. k_old > gpOld%xsz(3)) then + call gracefulExit('redistribute_clip_xpencil: old local index out of range during packing.', 702) + end if + + pos = pos + 1 + packed_count = packed_count + 1 + + send_val(pos) = field_old(i_old,j_old,k_old) + + end do + end do + end do + + if (packed_count /= expected_count) then + call gracefulExit('redistribute_clip_xpencil: packed count mismatch.', 703) + end if + + if (pos /= send_displs(dst_rank + 1) + send_counts(dst_rank + 1)) then + call gracefulExit('redistribute_clip_xpencil: send displacement mismatch after packing.', 704) + end if + + end do + + !------------------------------------------------------------ + ! Exchange values only. + !------------------------------------------------------------ + call MPI_Alltoallv(send_val, send_counts, send_displs, MPI_DOUBLE_PRECISION, & + recv_val, recv_counts, recv_displs, MPI_DOUBLE_PRECISION, & + MPI_COMM_WORLD, ierr) + + if (ierr /= MPI_SUCCESS) then + call gracefulExit('redistribute_clip_xpencil: MPI_Alltoallv values failed.', 705) + end if + + !------------------------------------------------------------ + ! Unpack into local gpClip array. + ! + ! For each source rank src_rank, reconstruct: + ! + ! old ownership of src_rank, mapped to clipped coordinates + ! intersected with + ! gpClip ownership of myrank + ! + ! Then unpack using the same kg-jg-ig ordering used by sender. + !------------------------------------------------------------ + do src_rank = 0, nprocs - 1 + + call get_source_dest_intersection(src_rank, myrank, old_xst_all, old_xen_all, & + ixlo, ixhi, iylo, iyhi, izlo, izhi, has_box) + + if (.not. has_box) cycle + + expected_count = get_intersection_count(ixlo, ixhi, iylo, iyhi, izlo, izhi) + unpacked_count = 0 + + pos = recv_displs(src_rank + 1) + + do kg_clip = izlo, izhi + + k_clip = kg_clip - gpClip%xst(3) + 1 + + do jg_clip = iylo, iyhi + + j_clip = jg_clip - gpClip%xst(2) + 1 + + do ig_clip = ixlo, ixhi + + i_clip = ig_clip - gpClip%xst(1) + 1 + + if (i_clip < 1 .or. i_clip > gpClip%xsz(1) .or. & + j_clip < 1 .or. j_clip > gpClip%xsz(2) .or. & + k_clip < 1 .or. k_clip > gpClip%xsz(3)) then + call gracefulExit('redistribute_clip_xpencil: clipped local index out of range during unpacking.', 706) + end if + + pos = pos + 1 + unpacked_count = unpacked_count + 1 + + field_clip(i_clip,j_clip,k_clip) = recv_val(pos) + + end do + end do + end do + + if (unpacked_count /= expected_count) then + call gracefulExit('redistribute_clip_xpencil: unpacked count mismatch.', 707) + end if + + if (pos /= recv_displs(src_rank + 1) + recv_counts(src_rank + 1)) then + call gracefulExit('redistribute_clip_xpencil: receive displacement mismatch after unpacking.', 708) + end if + + end do + + !------------------------------------------------------------ + ! Cleanup. + !------------------------------------------------------------ + deallocate(send_counts, recv_counts) + deallocate(send_displs, recv_displs) + deallocate(send_val, recv_val) + nullify(gpOld) + +end subroutine redistribute_clip_xpencil + +pure integer function get_intersection_count(ixlo, ixhi, iylo, iyhi, izlo, izhi) result(npts) + implicit none + + integer, intent(in) :: ixlo, ixhi + integer, intent(in) :: iylo, iyhi + integer, intent(in) :: izlo, izhi + + if (ixhi < ixlo .or. iyhi < iylo .or. izhi < izlo) then + npts = 0 + else + npts = (ixhi - ixlo + 1) * & + (iyhi - iylo + 1) * & + (izhi - izlo + 1) + end if + +end function get_intersection_count + +subroutine get_source_dest_intersection(src_rank, dst_rank, old_xst_all, old_xen_all, & + ixlo, ixhi, iylo, iyhi, izlo, izhi, has_box) + implicit none + + integer, intent(in) :: src_rank + integer, intent(in) :: dst_rank + + integer, intent(in) :: old_xst_all(:,:) + integer, intent(in) :: old_xen_all(:,:) + + integer, intent(out) :: ixlo, ixhi + integer, intent(out) :: iylo, iyhi + integer, intent(out) :: izlo, izhi + + logical, intent(out) :: has_box + + integer :: src_i1, src_i2 + integer :: src_j1, src_j2 + integer :: src_k1, src_k2 + + integer :: dst_i1, dst_i2 + integer :: dst_j1, dst_j2 + integer :: dst_k1, dst_k2 + + integer :: src + integer :: dst + + ! src_rank and dst_rank are MPI ranks: 0,...,nprocs-1. + ! Array storage uses Fortran indexing: 1,...,nprocs. + src = src_rank + 1 + dst = dst_rank + 1 + + if (src < 1 .or. src > nprocs) then + has_box = .false. + ixlo = 1; ixhi = 0 + iylo = 1; iyhi = 0 + izlo = 1; izhi = 0 + return + end if + + if (dst < 1 .or. dst > nprocs) then + has_box = .false. + ixlo = 1; ixhi = 0 + iylo = 1; iyhi = 0 + izlo = 1; izhi = 0 + return + end if + + !------------------------------------------------------------ + ! Source old ownership mapped into clipped global coordinates. + ! + ! Old global index: + ! ig_old + ! + ! Clipped global index: + ! ig_clip = ig_old - ix1 + 1 + ! + ! Therefore: + ! ig_old = ix1 maps to ig_clip = 1 + !------------------------------------------------------------ + src_i1 = max(1, old_xst_all(1,src) - ix1 + 1) + src_i2 = min(nx_clip, old_xen_all(1,src) - ix1 + 1) + + src_j1 = max(1, old_xst_all(2,src) - iy1 + 1) + src_j2 = min(ny_clip, old_xen_all(2,src) - iy1 + 1) + + src_k1 = max(1, old_xst_all(3,src) - iz1 + 1) + src_k2 = min(nz_clip, old_xen_all(3,src) - iz1 + 1) + + !------------------------------------------------------------ + ! Destination gpClip ownership is already in clipped global + ! coordinates. + !------------------------------------------------------------ + dst_i1 = clip_xst_all(1,dst) + dst_i2 = clip_xen_all(1,dst) + + dst_j1 = clip_xst_all(2,dst) + dst_j2 = clip_xen_all(2,dst) + + dst_k1 = clip_xst_all(3,dst) + dst_k2 = clip_xen_all(3,dst) + + !------------------------------------------------------------ + ! Source-destination intersection in clipped coordinates. + !------------------------------------------------------------ + ixlo = max(src_i1, dst_i1) + ixhi = min(src_i2, dst_i2) + + iylo = max(src_j1, dst_j1) + iyhi = min(src_j2, dst_j2) + + izlo = max(src_k1, dst_k1) + izhi = min(src_k2, dst_k2) + + has_box = (ixhi >= ixlo .and. iyhi >= iylo .and. izhi >= izlo) + +end subroutine get_source_dest_intersection + +subroutine prefix_displs(counts, displs) + implicit none + + integer, intent(in) :: counts(:) + integer, intent(out) :: displs(:) + + integer :: r + + if (size(displs) /= size(counts)) then + call gracefulExit('prefix_displs: counts and displs have inconsistent sizes.', 601) + end if + + if (size(counts) < 1) return + + displs(1) = 0 + + do r = 2, size(counts) + displs(r) = displs(r-1) + counts(r-1) + end do + +end subroutine prefix_displs + +!======================================================================= +! Cleanup. +!======================================================================= +subroutine finalize_clipper() + implicit none + + if (allocated(clip_xst_all)) deallocate(clip_xst_all) + if (allocated(clip_xen_all)) deallocate(clip_xen_all) + if (allocated(old_xst_all)) deallocate(old_xst_all) + if (allocated(old_xen_all)) deallocate(old_xen_all) + + call decomp_info_finalize(gpClip) + call decomp_info_finalize(gpE) + call decomp_info_finalize(gpC) + call decomp_2d_finalize() + +end subroutine finalize_clipper + +!======================================================================= +! Small integer-to-string helper. +!======================================================================= +pure function to_string(i) result(str) + implicit none + + integer, intent(in) :: i + character(len=32) :: str + + write(str, '(I0)') i + +end function to_string + +end module clip_mod + +program clip + use kind_parameters, only: rkind, clen + use exits, only: gracefulExit + use mpi + use clip_mod + + implicit none + + integer :: ierr + integer :: ioUnit + character(len=clen) :: inputfile='' + character(len=clen) :: infile='', outfile='', basefile='' + character(len=clen) :: ers + character(len=clen) :: inputdir='.', outputdir='.' + + integer :: nx=0, ny=0, nz=0 + integer :: prow=0, pcol=0 + real(rkind) :: Lx=0.0_rkind, Ly=0.0_rkind, Lz=0.0_rkind + real(rkind) :: x1=0.0_rkind, x2=0.0_rkind, y1=0.0_rkind, y2=0.0_rkind, z1=0.0_rkind, z2=0.0_rkind + logical :: periodicbcs(3) + logical :: periodic_x = .true., periodic_y=.true., periodic_z = .false. + character(len=1) :: field_grid='C' + + namelist /INPUT/ infile, outfile, basefile, nx, ny, nz, Lx, Ly, Lz,& + prow, pcol, field_grid, & + x1, x2, y1, y2, z1, z2, periodic_x, periodic_y, periodic_z,& + inputdir, outputdir + + call MPI_Init(ierr) + + call GET_COMMAND_ARGUMENT(1, inputfile) + + if (len_trim(inputfile) == 0) then + call gracefulExit('clip3d: cannot read input file', 100) + end if + + 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,'(I0)') ierr + call gracefulExit('Reading failed for INPUT with error '//trim(ers), 101) + end if + + close(ioUnit) + + periodicbcs(1) = periodic_x + periodicbcs(2) = periodic_y + periodicbcs(3) = periodic_z + + call initialize_clipper(nx, ny, nz, Lx, Ly, Lz, & + prow, pcol, periodicbcs, & + x1, x2, y1, y2, z1, z2, & + field_grid) + + call clip_and_write_file(trim(inputdir), trim(infile), trim(basefile), trim(outputdir), trim(outfile)) + + call finalize_clipper() + + call MPI_Finalize(ierr) + +end program clip \ No newline at end of file diff --git a/problems/postprocessing_igrid/Clip_files/input_clip.dat b/problems/postprocessing_igrid/Clip_files/input_clip.dat new file mode 100644 index 00000000..f60644e4 --- /dev/null +++ b/problems/postprocessing_igrid/Clip_files/input_clip.dat @@ -0,0 +1,23 @@ +&INPUT +inputdir = "/anvil/scratch/x-kali/PadeOpsSims/EXT-BLH800/t092440_n014462" +outputdir = "/anvil/scratch/x-kali/PadeOpsSims/EXT-BLH800/t092440_n014462" ! Directory for all output files +nx = 2200 ! Number of points in X +ny = 1000 ! Number of points in Y +nz = 800 ! Number of points in Z +Lx = 698.4126984D0 ! Domain Length (appropriate dimesnions/non-dimensionalized) +Ly = 158.7301587D0 ! Domain Width (appropriate dimesnions/non-dimensionalized) +Lz = 63.49206349D0 ! Domain Height (appropriate dimesnions/non-dimensionalized) +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) +periodic_z = .False. ! [optional] +field_grid = "C" ! C: Cell based, E: Edge based +infile = "Run09_comp_deficit_budget0_term01_t092440_n014462.s3D" +basefile = "Run08_budget0_term01_t092440_n014462.s3D" ! Will be summed with infile +outfile = "Run09_budget0_term01_t092440_n014462.s3D" +x1 = 119.0 +x2 = 541.0 +y1 = 40.0 +y2 = 120.0 +z1 = -1.0 +z2 = 7.0 +/ From fd01bad9ef6e96cf30ee204e9a4929d0025979da Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 21 May 2026 19:54:11 -0400 Subject: [PATCH 083/114] Add y taper in AD Fringe --- src/incompressible/fringeADmethod.F90 | 526 +++++++++++++++++++++----- src/incompressible/igrid.F90 | 7 +- 2 files changed, 442 insertions(+), 91 deletions(-) diff --git a/src/incompressible/fringeADmethod.F90 b/src/incompressible/fringeADmethod.F90 index b7e9812b..b10b4baa 100644 --- a/src/incompressible/fringeADmethod.F90 +++ b/src/incompressible/fringeADmethod.F90 @@ -4,107 +4,457 @@ module fringeADMethod use exits, only: message use constants, only: zero, one, half, two implicit none + private public :: fringeAD type :: fringeAD - real(rkind), dimension(:,:,:), allocatable :: Fringe_kernel + real(rkind), dimension(:,:,:), allocatable :: Fringe_kernel contains procedure :: init procedure :: destroy procedure :: S_fringe end type fringeAD - contains +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 + class(fringeAD), intent(inout) :: this + + if (allocated(this%Fringe_kernel)) deallocate(this%Fringe_kernel) + + end subroutine destroy + + + subroutine init(this, inputfile, nx, ny, nz, x, y, z, Lx, Ly, dz, dy) + class(fringeAD), intent(inout) :: this + character(*), intent(in) :: inputfile + integer, intent(in) :: nx, ny, nz + real(rkind), intent(in) :: x(nx), y(ny), z(nz) + real(rkind), intent(in) :: dz, dy, Lx, Ly + + integer :: j, k, ioUnit, ierr + + real(rkind) :: xi_st(nx) + real(rkind) :: xi_en(nx) + real(rkind) :: S1(nx) + real(rkind) :: S2(nx) + real(rkind) :: Fringe_func(nx) + real(rkind) :: xper(nx) + + real(rkind) :: fringe_len + real(rkind) :: delta_st_ + real(rkind) :: delta_en_ + + real(rkind) :: FringeAD_deltaH_ + real(rkind) :: FringeAD_deltaY_ + + real(rkind) :: sigma_z + real(rkind) :: sigma_y(ny) + real(rkind) :: alpha + + real(rkind) :: y_fringe_start + real(rkind) :: y_fringe_end + real(rkind) :: y_tol + real(rkind) :: dist_to_fringe + + logical :: in_y_fringe(ny) + logical :: use_y_taper + logical :: y_fringe_wrap + logical :: y_fringe_active + + ! ------------------------------------------------------------------ + ! FRINGEAD namelist variables. + ! + ! FringeAD_st and FringeAD_en define the x-extent over which the AD + ! fringe is active. This interval is periodic in x. + ! + ! Example: + ! + ! FringeAD_st = 0.9 + ! FringeAD_en = 0.1 + ! + ! activates the AD fringe from 0.9*Lx to Lx and from 0 to 0.1*Lx. + ! + ! FringeAD_H and FringeAD_deltaH control the vertical activation. + ! Below FringeAD_H, the AD fringe is inactive. Above FringeAD_H, it is + ! tapered with tanh^2 if use_tanh = .true. + ! + ! FringeAD_taper_y controls whether the AD fringe is suppressed/tapered + ! near the main y-fringe. + ! ------------------------------------------------------------------ + real(rkind) :: FringeAD_st = 0.875_rkind + real(rkind) :: FringeAD_en = one + real(rkind) :: FringeAD_delta_st = 0.05_rkind + real(rkind) :: FringeAD_delta_en = 0.075_rkind + real(rkind) :: FringeAD_H = 10._rkind + real(rkind) :: FringeAD_deltaH = 4._rkind + real(rkind) :: FringeAD_deltaY = 4._rkind + logical :: use_tanh = .true. + logical :: FringeAD_taper_y = .true. + + ! ------------------------------------------------------------------ + ! FRINGE namelist variables. + ! + ! The AD-fringe y-taper uses: + ! + ! Apply_y_fringe + ! Fringe_yst + ! Fringe_yen + ! + ! The other variables are declared so that the full FRINGE namelist can + ! be read safely. + ! ------------------------------------------------------------------ + logical :: Apply_x_fringe = .true. + logical :: Apply_y_fringe = .false. + logical :: do_shifts = .false. + + real(rkind) :: Fringe_xst = 0.75_rkind + real(rkind) :: Fringe_xen = one + real(rkind) :: Fringe_yst = one + real(rkind) :: Fringe_yen = one + + real(rkind) :: Fringe_delta_st_x = one + real(rkind) :: Fringe_delta_en_x = one + real(rkind) :: Fringe_delta_st_y = one + real(rkind) :: Fringe_delta_en_y = one + + real(rkind) :: LambdaFact = 2.45_rkind + real(rkind) :: LambdaFact2 = 2.45_rkind + real(rkind) :: LambdaFactPotTemp = 2.45_rkind + + real(rkind) :: Fringe1_xst = 0.75_rkind + real(rkind) :: Fringe1_xen = one + real(rkind) :: Fringe1_delta_st_x = one + real(rkind) :: Fringe1_delta_en_x = one + + real(rkind) :: Fringe2_xst = 0.75_rkind + real(rkind) :: Fringe2_xen = one + real(rkind) :: Fringe2_delta_st_x = one + real(rkind) :: Fringe2_delta_en_x = one + + real(rkind) :: xshift = zero + real(rkind) :: yshift = zero + + namelist /FRINGEAD/ FringeAD_st, FringeAD_en, FringeAD_delta_st, FringeAD_delta_en, & + FringeAD_H, FringeAD_deltaH, FringeAD_deltaY, use_tanh, & + FringeAD_taper_y + + namelist /FRINGE/ 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, Fringe_yen, Fringe_yst, & + LambdaFactPotTemp, LambdaFact2, & + Fringe1_delta_st_x, Fringe1_delta_en_x, Fringe1_xst, Fringe1_xen, & + Fringe2_delta_st_x, Fringe2_delta_en_x, Fringe2_xst, Fringe2_xen, & + do_shifts, xshift, yshift + + if (allocated(this%Fringe_kernel)) deallocate(this%Fringe_kernel) + allocate(this%Fringe_kernel(nx, ny, nz)) + + ioUnit = 1019 + + ! ------------------------------------------------------------------ + ! Read FRINGEAD namelist. + ! ------------------------------------------------------------------ + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', iostat=ierr) + if (ierr /= 0) then + call message('fringeADMethod:init could not open input file for FRINGEAD namelist.') + this%Fringe_kernel = one + return 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 + read(unit=ioUnit, nml=FRINGEAD, iostat=ierr) + close(ioUnit) + + if (ierr /= 0) then + call message('fringeADMethod:init could not read FRINGEAD namelist; using defaults where needed.') + end if + + ! ------------------------------------------------------------------ + ! Read FRINGE namelist. + ! + ! This is needed to identify the main y-fringe location. + ! ------------------------------------------------------------------ + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', iostat=ierr) + if (ierr /= 0) then + call message('fringeADMethod:init could not open input file for FRINGE namelist.') + Apply_y_fringe = .false. 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)) + read(unit=ioUnit, nml=FRINGE, iostat=ierr) + close(ioUnit) + + if (ierr /= 0) then + call message('fringeADMethod:init could not read FRINGE namelist; assuming no y-fringe.') + Apply_y_fringe = .false. + end if + end if + + ! ------------------------------------------------------------------ + ! x-direction: build the periodic AD-fringe function. + ! + ! Fringe_func = 1 outside the AD-fringe x-region. + ! Fringe_func = 0 inside the AD-fringe x-region. + ! + ! The interval is periodic: + ! + ! xper = modulo(x - FringeAD_st, Lx) + ! fringe_len = modulo(FringeAD_en - FringeAD_st, Lx) + ! + ! so FringeAD_st > FringeAD_en naturally wraps around the x-boundary. + ! ------------------------------------------------------------------ + 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 + + xper = modulo(x - FringeAD_st, Lx) + fringe_len = modulo(FringeAD_en - FringeAD_st, Lx) + + xi_st = xper / delta_st_ + xi_en = (xper - fringe_len) / delta_en_ + one + + call this%S_fringe(xi_st, S1) + call this%S_fringe(xi_en, S2) + + Fringe_func = one - (S1 - S2) + + ! ------------------------------------------------------------------ + ! z-direction: vertical activation width. + ! ------------------------------------------------------------------ + FringeAD_deltaH_ = max(two, FringeAD_deltaH) * abs(dz) + + ! ------------------------------------------------------------------ + ! y-direction: optional generic taper near the main y-fringe. + ! + ! The main y-fringe is identified from Fringe_yst and Fringe_yen. + ! + ! Case 1: high-y fringe + ! + ! Fringe_yst = 0.9 + ! Fringe_yen = 1.0 + ! + ! y >= 0.9*Ly: + ! AD fringe inactive + ! + ! 0.9*Ly - deltaY <= y <= 0.9*Ly: + ! AD fringe tapered + ! + ! y < 0.9*Ly - deltaY: + ! AD fringe fully active, subject to x and z masks + ! + ! Case 2: low-y fringe + ! + ! Fringe_yst = 0.0 + ! Fringe_yen = 0.1 + ! + ! y <= 0.1*Ly: + ! AD fringe inactive + ! + ! 0.1*Ly <= y <= 0.1*Ly + deltaY: + ! AD fringe tapered + ! + ! y > 0.1*Ly + deltaY: + ! AD fringe fully active, subject to x and z masks + ! + ! Case 3: wrapped y-fringe + ! + ! Fringe_yst = 0.9 + ! Fringe_yen = 0.1 + ! + ! y >= 0.9*Ly or y <= 0.1*Ly: + ! AD fringe inactive + ! + ! The AD fringe is tapered away from both exposed edges. + ! + ! If Apply_y_fringe = .false. or FringeAD_taper_y = .false., + ! sigma_y = 1 everywhere and the AD-fringe kernel has no y-dependence. + ! ------------------------------------------------------------------ + FringeAD_deltaY_ = max(two, FringeAD_deltaY) * abs(dy) + + sigma_y(:) = one + in_y_fringe(:) = .false. + + use_y_taper = Apply_y_fringe .and. FringeAD_taper_y + + if (use_y_taper) then + + y_fringe_start = Fringe_yst * Ly + y_fringe_end = Fringe_yen * Ly + y_tol = epsilon(one) * max(one, Ly) + + y_fringe_active = abs(y_fringe_end - y_fringe_start) > y_tol + + if (y_fringe_active) then + + y_fringe_wrap = y_fringe_start > y_fringe_end + + do j = 1, ny + + if (.not. y_fringe_wrap) then + + ! Non-wrapped y-fringe: + ! + ! y_fringe_start <= y <= y_fringe_end + ! + ! Examples: + ! 0.9*Ly -> Ly + ! 0 -> 0.1*Ly + if (y(j) >= y_fringe_start .and. y(j) <= y_fringe_end) then + + in_y_fringe(j) = .true. + sigma_y(j) = zero + + else + + if (y(j) < y_fringe_start) then + dist_to_fringe = y_fringe_start - y(j) + else + dist_to_fringe = y(j) - y_fringe_end + end if + + sigma_y(j) = tanh(dist_to_fringe / FringeAD_deltaY_) + sigma_y(j) = sigma_y(j) * sigma_y(j) + + end if + + else + + ! Wrapped y-fringe: + ! + ! y >= y_fringe_start or y <= y_fringe_end + ! + ! Example: + ! 0.9*Ly -> 0.1*Ly + if (y(j) >= y_fringe_start .or. y(j) <= y_fringe_end) then + + in_y_fringe(j) = .true. + sigma_y(j) = zero + + else + + dist_to_fringe = min(y(j) - y_fringe_end, y_fringe_start - y(j)) + + sigma_y(j) = tanh(dist_to_fringe / FringeAD_deltaY_) + sigma_y(j) = sigma_y(j) * sigma_y(j) + + end if + + end if + + end do + + end if + end if - end do - end subroutine -end module fringeADMethod + + ! ------------------------------------------------------------------ + ! Build Fringe_kernel(nx, ny, nz). + ! + ! The smooth form is: + ! + ! kernel = (1 - alpha) + alpha*Fringe_func + ! + ! where: + ! + ! alpha = sigma_z * sigma_y + ! + ! Therefore: + ! + ! alpha = 0: + ! kernel = 1 + ! AD fringe inactive + ! + ! alpha = 1: + ! kernel = Fringe_func + ! AD fringe fully active in x + ! + ! 0 < alpha < 1: + ! smooth transition + ! + ! The sharp form use_tanh = .false. uses the same in_y_fringe array + ! as the smooth form, so both branches are logically consistent. + ! ------------------------------------------------------------------ + do k = 1, nz + + if (use_tanh) then + + if (z(k) <= FringeAD_H) then + sigma_z = zero + else + sigma_z = tanh((z(k) - FringeAD_H) / FringeAD_deltaH_) + sigma_z = sigma_z * sigma_z + end if + + do j = 1, ny + alpha = sigma_z * sigma_y(j) + this%Fringe_kernel(:,j,k) = (one - alpha) + alpha * Fringe_func(:) + end do + + else + + do j = 1, ny + + if (z(k) < FringeAD_H) then + + ! Below the AD-fringe height: + ! AD fringe inactive. + this%Fringe_kernel(:,j,k) = one + + else if (use_y_taper .and. in_y_fringe(j)) then + + ! Inside the main y-fringe: + ! AD fringe inactive. + this%Fringe_kernel(:,j,k) = one + + else + + ! Above FringeAD_H and outside the main y-fringe: + ! AD fringe fully active in x. + ! + ! For use_tanh = .false., the transition in y is sharp. + this%Fringe_kernel(:,j,k) = Fringe_func(:) + + end if + + end do + + end if + + end do + + end subroutine init + + + 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) <= zero) then + + output(i) = zero + + else if (x(i) >= 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) + + output(i) = one / (one + exp(exparg)) + + end if + + end do + + end subroutine S_fringe + +end module fringeADMethod \ No newline at end of file diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index ccd37bcc..137c095f 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -449,7 +449,7 @@ subroutine init(this,inputfile, initialize2decomp) 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) :: Lx, Ly real(rkind), dimension(:,:,:), allocatable, target :: tmpzE, tmpzC, tmpyE, tmpyC namelist /INPUT/ nx, ny, nz, tstop, dt, CFL, nsteps, inputdir, outputdir, prow, pcol, & @@ -1206,9 +1206,10 @@ subroutine init(this,inputfile, initialize2decomp) 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)) + Lx = this%gpC%xsz(1) * this%dx + Ly = this%gpC%ysz(2) * this%dy - 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) + call this%fringe_ad%init(trim(inputfile), this%gpE%xsz(1), this%gpE%xsz(2), this%gpE%xsz(3), this%mesh(:,1,1,1), this%mesh(1,:,1,2), ztmp, Lx, Ly, this%dz, this%dy) deallocate(ztmp) end if From 823d3f769222ef202b5296e54d6af65a9f00440b Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 22 May 2026 17:41:03 -0400 Subject: [PATCH 084/114] Add Spectrum Program --- problems/postprocessing_igrid/Spectrum.F90 | 520 ++++++++++++++++++ .../Spectrum_files/fields_spectrum.dat | 12 + .../Spectrum_files/input_spectrum.dat | 17 + 3 files changed, 549 insertions(+) create mode 100644 problems/postprocessing_igrid/Spectrum.F90 create mode 100644 problems/postprocessing_igrid/Spectrum_files/fields_spectrum.dat create mode 100644 problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat diff --git a/problems/postprocessing_igrid/Spectrum.F90 b/problems/postprocessing_igrid/Spectrum.F90 new file mode 100644 index 00000000..81d343ff --- /dev/null +++ b/problems/postprocessing_igrid/Spectrum.F90 @@ -0,0 +1,520 @@ +module spectrum_mod + use mpi + use decomp_2d + use decomp_2d_io + use kind_parameters, only: rkind, clen, mpirkind + use constants, only: zero, one, two, half, pi + use exits, only: message, gracefulExit + use reductions, only: p_sum + use spectralMod, only: spectral + + implicit none + + character(len=clen) :: inputdir, outputdir, fields + integer :: nx, ny, nz, prow=0, pcol=0 + real(rkind) :: Lx=one, Ly=one, Lz=one, dx=one, dy=one, dz=one + real(rkind) :: npts=one, nhorz=one + logical :: remove_spatial_mean=.false. + logical :: remove_horizontal_mean=.false. + logical :: include_one_half=.false. + logical :: write_density=.false. + + type(decomp_info) :: gpC + type(spectral) :: spectC + real(rkind), dimension(:,:,:), allocatable :: field, rbuffxC + complex(rkind), dimension(:,:,:), allocatable :: fhat + real(rkind), dimension(:), allocatable :: kbin, spectrum_local, spectrum_global + integer, dimension(:), allocatable :: counts_local, counts_global + integer :: nbins, ierr + real(rkind) :: dk, normfact + + type field_component + character(len=clen) :: filename = '' + real(rkind) :: scale = one + end type field_component + + type spectrum_field + character(len=clen) :: name = '' + integer :: ncomponents = 0 + type(field_component), allocatable :: components(:) + end type spectrum_field + +contains + + subroutine read_field_specs(filename, specs) + implicit none + + character(len=*), intent(in) :: filename + type(spectrum_field), allocatable, intent(out) :: specs(:) + integer :: unit, ios, nfields, ifield, icomp + character(len=2048) :: line, clean_line, field_name + logical :: in_block, waiting_for_open + integer, allocatable :: component_counts(:) + + open(newunit=unit, file=filename, status='old', action='read', iostat=ios) + if (ios /= 0) call gracefulExit("Could not open field-spec file.", 112) + + ! First pass: count fields. Braces may be on the field-name line or + ! on the following line. + nfields = 0 + in_block = .false. + waiting_for_open = .false. + do + read(unit, '(A)', iostat=ios) line + if (ios /= 0) exit + + call strip_comments(line, clean_line) + if (len_trim(clean_line) == 0) cycle + + if (waiting_for_open) then + if (trim(clean_line) /= '{') call gracefulExit("Field-spec parser expected '{'.", 113) + waiting_for_open = .false. + in_block = .true. + cycle + end if + + if (in_block) then + if (trim(clean_line) == '}') then + in_block = .false. + else + component_counts(nfields) = component_counts(nfields) + 1 + end if + cycle + end if + + nfields = nfields + 1 + if (.not. allocated(component_counts)) allocate(component_counts(1024)) + if (nfields > size(component_counts)) call grow_integer_array(component_counts) + component_counts(nfields) = 0 + if (index(clean_line, '{') > 0) then + in_block = .true. + else + waiting_for_open = .true. + end if + end do + + close(unit) + + if (ios > 0) call gracefulExit("Error while reading field-spec file.", 556) + if (nfields == 0) call gracefulExit("Field-spec file contains no fields.", 114) + if (in_block .or. waiting_for_open) call gracefulExit("Field-spec file ended before a field block was closed.", 115) + + allocate(specs(nfields)) + do ifield = 1, nfields + if (component_counts(ifield) == 0) call gracefulExit("Field block contains no components.", 119) + allocate(specs(ifield)%components(component_counts(ifield))) + end do + + ! Second pass: read field names and component lines. + open(newunit=unit, file=filename, status='old', action='read', iostat=ios) + if (ios /= 0) call gracefulExit("Could not reopen field-spec file.", 116) + + ifield = 0 + icomp = 0 + in_block = .false. + waiting_for_open = .false. + do + read(unit, '(A)', iostat=ios) line + if (ios /= 0) exit + + call strip_comments(line, clean_line) + if (len_trim(clean_line) == 0) cycle + + if (waiting_for_open) then + if (trim(clean_line) /= '{') call gracefulExit("Field-spec parser expected '{'.", 117) + waiting_for_open = .false. + in_block = .true. + icomp = 0 + cycle + end if + + if (.not. in_block) then + ifield = ifield + 1 + call parse_field_name(clean_line, field_name, in_block) + specs(ifield)%name = trim(field_name) + specs(ifield)%ncomponents = component_counts(ifield) + icomp = 0 + if (.not. in_block) waiting_for_open = .true. + cycle + end if + + if (trim(clean_line) == '}') then + in_block = .false. + else + icomp = icomp + 1 + call parse_component(clean_line, & + specs(ifield)%components(icomp)%filename, & + specs(ifield)%components(icomp)%scale) + end if + end do + close(unit) + + if (ios > 0) call gracefulExit("Error while reading field-spec file.", 557) + end subroutine read_field_specs + + subroutine grow_integer_array(values) + implicit none + integer, allocatable, intent(inout) :: values(:) + integer, allocatable :: old_values(:) + integer :: old_size + + old_size = size(values) + allocate(old_values(old_size)) + old_values = values + deallocate(values) + allocate(values(2*old_size)) + values(1:old_size) = old_values + values(old_size+1:) = 0 + deallocate(old_values) + end subroutine grow_integer_array + + subroutine parse_field_name(line, field_name, block_is_open) + implicit none + character(len=*), intent(in) :: line + character(len=*), intent(out) :: field_name + logical, intent(out) :: block_is_open + integer :: brace_pos + + brace_pos = index(line, '{') + block_is_open = brace_pos > 0 + if (block_is_open) then + field_name = adjustl(line(:brace_pos-1)) + else + field_name = adjustl(line) + end if + if (len_trim(field_name) == 0) call gracefulExit("Field-spec parser found an empty field name.", 120) + end subroutine parse_field_name + + subroutine parse_component(line, filename, scale) + implicit none + character(len=*), intent(in) :: line + character(len=*), intent(out) :: filename + real(rkind), intent(out) :: scale + character(len=2048) :: normalized + character(len=clen) :: token1, token2, token3, token4 + integer :: ios + + call normalize_component_line(line, normalized) + token1 = '' + token2 = '' + token3 = '' + token4 = '' + read(normalized, *, iostat=ios) token1, token2 + if (ios /= 0) call gracefulExit("Malformed field component line: "//trim(line), 121) + + if (trim(token1) == 'file') then + read(normalized, *, iostat=ios) token1, token2, token3, token4 + if (ios /= 0) call gracefulExit("Malformed keyed field component line: "//trim(line), 121) + filename = trim(token2) + if (trim(token3) /= 'scale') call gracefulExit("Component line missing scale key: "//trim(line), 122) + read(token4, *, iostat=ios) scale + else + filename = trim(token1) + read(token2, *, iostat=ios) scale + end if + + if (ios /= 0) call gracefulExit("Could not parse component scale: "//trim(line), 123) + if (len_trim(filename) == 0) call gracefulExit("Component line has an empty filename.", 124) + end subroutine parse_component + + subroutine normalize_component_line(line, normalized) + implicit none + character(len=*), intent(in) :: line + character(len=*), intent(out) :: normalized + integer :: i + + normalized = line + do i = 1, len_trim(normalized) + select case (normalized(i:i)) + case ('{', '}', '"', ',', ':') + normalized(i:i) = ' ' + end select + end do + normalized = adjustl(normalized) + end subroutine normalize_component_line + + subroutine strip_comments(line, clean_line) + implicit none + character(len=*), intent(in) :: line + character(len=*), intent(out) :: clean_line + integer :: bang_pos, hash_pos, comment_pos + + clean_line = line + bang_pos = index(clean_line, '!') + hash_pos = index(clean_line, '#') + comment_pos = 0 + if (bang_pos > 0) comment_pos = bang_pos + if ((hash_pos > 0) .and. ((comment_pos == 0) .or. (hash_pos < comment_pos))) comment_pos = hash_pos + if (comment_pos > 0) clean_line(comment_pos:) = ' ' + clean_line = adjustl(clean_line) + end subroutine strip_comments + + subroutine read_field(spec) + implicit none + type(spectrum_field), intent(in) :: spec + character(len=clen) :: infile + integer :: i + + field = zero + rbuffxC = zero + do i = 1, spec%ncomponents + infile = resolve_input_path(spec%components(i)%filename) + call message(1, 'Reading '//trim(infile)) + call decomp_2d_read_one(1, rbuffxC, trim(infile), gpC) + field = field + spec%components(i)%scale*rbuffxC + end do + + end subroutine read_field + + function resolve_input_path(filename) result(path) + implicit none + character(len=*), intent(in) :: filename + character(len=clen) :: path + + if (filename(1:1) == '/') then + path = trim(filename) + else + path = trim(inputdir)//'/'//trim(filename) + end if + end function resolve_input_path + + subroutine remove_requested_means() + real(rkind) :: mean_value + + if (remove_spatial_mean) then + mean_value = p_sum(sum(field))/npts + field = field - mean_value + call message(1, 'Removed volume mean:', mean_value) + end if + + if (remove_horizontal_mean) then + call remove_horizontal_profile() + end if + end subroutine remove_requested_means + + subroutine remove_horizontal_profile() + real(rkind), dimension(:), allocatable :: profile_local, profile_global + integer :: i, j, k, kg + + allocate(profile_local(nz), profile_global(nz)) + profile_local = zero + profile_global = zero + + do k = 1, gpC%xsz(3) + kg = gpC%xst(3) + k - 1 + do j = 1, gpC%xsz(2) + do i = 1, gpC%xsz(1) + profile_local(kg) = profile_local(kg) + field(i,j,k) + end do + end do + end do + + call MPI_Allreduce(profile_local, profile_global, nz, mpirkind, MPI_SUM, MPI_COMM_WORLD, ierr) + profile_global = profile_global/nhorz + + do k = 1, gpC%xsz(3) + kg = gpC%xst(3) + k - 1 + field(:,:,k) = field(:,:,k) - profile_global(kg) + end do + + call message(1, 'Removed horizontally averaged mean profile') + deallocate(profile_local, profile_global) + end subroutine remove_horizontal_profile + + subroutine init_bins() + integer :: b + real(rkind) :: kmax + + dk = min(two*pi/Lx, two*pi/Ly) + kmax = sqrt((pi/dx)**2 + (pi/dy)**2) + nbins = int(kmax/dk) + 2 + normfact = one/(nhorz*nhorz*real(nz,rkind)) + + allocate(kbin(nbins), spectrum_local(nbins), spectrum_global(nbins)) + allocate(counts_local(nbins), counts_global(nbins)) + + do b = 1, nbins + kbin(b) = (real(b,rkind) - half)*dk + end do + + spectrum_local = zero + spectrum_global = zero + counts_local = 0 + counts_global = 0 + end subroutine init_bins + + subroutine compute_spectrum() + integer :: i, j, k, ig, ibin, multiplicity + real(rkind) :: kmag, amp2, factor + + factor = one + if (include_one_half) factor = half + + spectrum_local = zero + counts_local = 0 + + do k = 1, size(fhat,3) + do j = 1, size(fhat,2) + do i = 1, size(fhat,1) + kmag = sqrt(spectC%kabs_sq(i,j,k)) + ibin = int(kmag/dk) + 1 + + if ((ibin >= 1) .and. (ibin <= nbins)) then + ig = spectC%spectdecomp%yst(1) + i - 1 + multiplicity = hermitian_multiplicity(ig) + amp2 = real(fhat(i,j,k)*conjg(fhat(i,j,k)), rkind) + spectrum_local(ibin) = spectrum_local(ibin) + & + factor*real(multiplicity,rkind)*amp2*normfact + counts_local(ibin) = counts_local(ibin) + multiplicity + end if + end do + end do + end do + + call MPI_Reduce(spectrum_local, spectrum_global, nbins, mpirkind, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + call MPI_Reduce(counts_local, counts_global, nbins, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + + if (write_density .and. nrank == 0) spectrum_global = spectrum_global/dk + end subroutine compute_spectrum + + integer function hermitian_multiplicity(ig) + integer, intent(in) :: ig + + if ((ig == 1) .or. (ig == nx/2 + 1)) then + hermitian_multiplicity = 1 + else + hermitian_multiplicity = 2 + end if + end function hermitian_multiplicity + + subroutine parseval_check() + real(rkind) :: physical_energy, spectral_energy, factor + + factor = one + if (include_one_half) factor = half + + physical_energy = factor*p_sum(sum(field*field))/npts + if (nrank == 0) then + if (write_density) then + spectral_energy = sum(spectrum_global)*dk + else + spectral_energy = sum(spectrum_global) + end if + call message(1, 'Physical-space variance/energy:', physical_energy) + call message(1, 'Spectrum-integrated energy:', spectral_energy) + call message(1, 'Parseval absolute error:', abs(spectral_energy - physical_energy)) + end if + end subroutine parseval_check + + subroutine export_csv(field_name) + character(len=*), intent(in) :: field_name + character(len=clen) :: outfile + integer :: unit, b + + if (nrank /= 0) return + + outfile = trim(outputdir)//'/spectrum_'//trim(sanitize_field_name(field_name))//'.csv' + call message(1, 'Writing spectrum to '//trim(outfile)) + + open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') + write(unit, '(A)') 'k,E' + do b = 1, nbins + if (counts_global(b) > 0) write(unit, '(ES24.16,",",ES24.16)') kbin(b), spectrum_global(b) + end do + close(unit) + end subroutine export_csv + + function sanitize_field_name(field_name) result(clean_name) + implicit none + character(len=*), intent(in) :: field_name + character(len=clen) :: clean_name + integer :: i + + clean_name = adjustl(field_name) + do i = 1, len_trim(clean_name) + select case (clean_name(i:i)) + case (' ', '/', '\', ':', ',', ';', '{', '}', '(', ')', '[', ']') + clean_name(i:i) = '_' + end select + end do + end function sanitize_field_name + +end module spectrum_mod + +program spectrum + use mpi + use decomp_2d + use decomp_2d_io + use spectrum_mod + use exits, only: message, gracefulExit + + implicit none + + character(len=clen) :: inputfile, infile + integer :: ioUnit, ierr_local, ispec + logical :: exists + type(spectrum_field), allocatable :: specs(:) + + namelist /INPUT/ inputdir, outputdir, nx, ny, nz, Lx, Ly, Lz, prow, pcol, fields, & + remove_spatial_mean, remove_horizontal_mean, include_one_half, write_density + + call MPI_Init(ierr) + call MPI_Comm_rank(MPI_COMM_WORLD, nrank, ierr) + call MPI_Comm_size(MPI_COMM_WORLD, nproc, ierr) + + call GET_COMMAND_ARGUMENT(1, inputfile) + if (len_trim(inputfile) == 0) call gracefulExit('Usage: Spectrum.x input.dat', 100) + + ioUnit = 11 + open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', status='old', iostat=ierr_local) + if (ierr_local /= 0) call gracefulExit('Could not open input namelist file.', 101) + read(unit=ioUnit, NML=INPUT) + close(ioUnit) + + if (mod(nx,2) /= 0) call gracefulExit('nx must be even for PadeOps real-to-complex FFT storage.', 102) + if (mod(ny,2) /= 0) call gracefulExit('ny must be even.', 103) + if (mod(nz,2) /= 0) call gracefulExit('nz must be even.', 104) + + dx = Lx/real(nx,rkind) + dy = Ly/real(ny,rkind) + dz = Lz/real(nz,rkind) + npts = real(nx,rkind)*real(ny,rkind)*real(nz,rkind) + nhorz = real(nx,rkind)*real(ny,rkind) + + call decomp_2d_init(nx, ny, nz, prow, pcol) + call decomp_info_init(nx, ny, nz, gpC) + + call spectC%init('x', nx, ny, nz, dx, dy, dz, 'FOUR', '2/3rd',dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + + allocate(field(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3))) + allocate(rbuffxC(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3))) + call spectC%alloc_r2c_out(fhat) + + if (len_trim(fields) == 0) call gracefulExit('No field-spec file was provided in fields.', 105) + if (fields(1:1) == '/') then + infile = trim(fields) + else + infile = trim(inputdir)//'/'//trim(fields) + end if + inquire(file=trim(infile), exist=exists) + if (.not. exists) call gracefulExit('Input field-spec file not found: '//trim(infile), 106) + call init_bins() + call read_field_specs(trim(infile), specs) + + do ispec = 1, size(specs) + call message(1, 'Computing spectrum for '//trim(specs(ispec)%name)) + call read_field(specs(ispec)) + call remove_requested_means() + call spectC%fft(field, fhat) + call compute_spectrum() + call parseval_check() + call export_csv(specs(ispec)%name) + end do + + deallocate(field, rbuffxC, fhat, kbin, spectrum_local, spectrum_global, counts_local, counts_global) + call spectC%destroy() + call decomp_info_finalize(gpC) + call decomp_2d_finalize() + call MPI_Finalize(ierr) + +end program spectrum diff --git a/problems/postprocessing_igrid/Spectrum_files/fields_spectrum.dat b/problems/postprocessing_igrid/Spectrum_files/fields_spectrum.dat new file mode 100644 index 00000000..b6f07cd8 --- /dev/null +++ b/problems/postprocessing_igrid/Spectrum_files/fields_spectrum.dat @@ -0,0 +1,12 @@ +field1 +{ + {"file":field_file_1, "scale":1.0} + {"file":field_file_2, "scale":-1.0} +} + +field2 +{ + field_file_1 1.0 + field_file_2 2.0 + field_file_3 -1.0 +} diff --git a/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat b/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat new file mode 100644 index 00000000..2ca7a36d --- /dev/null +++ b/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat @@ -0,0 +1,17 @@ +&INPUT +inputdir = "/anvil/scratch/x-kali/PadeOpsSims/EXT-BLH800/t092440_n014462" +outputdir = "/anvil/scratch/x-kali/PadeOpsSims/EXT-BLH800/t092440_n014462" ! Directory for all output files +nx = 2200 ! Number of points in X +ny = 1000 ! Number of points in Y +nz = 800 ! Number of points in Z +Lx = 698.4126984D0 ! Domain Length (appropriate dimesnions/non-dimensionalized) +Ly = 158.7301587D0 ! Domain Width (appropriate dimesnions/non-dimensionalized) +Lz = 63.49206349D0 ! Domain Height (appropriate dimesnions/non-dimensionalized) +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) +fields = "fields_spectrum.dat" ! Field-spec file under inputdir, or use an absolute path +remove_spatial_mean = .false. +remove_horizontal_mean = .false. +include_one_half = .false. +write_density = .true. +/ From b9bfd85ade32514170cb42c0931a5cebb7e46110 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 22 May 2026 23:01:17 -0400 Subject: [PATCH 085/114] Add some fixes to Spectrum.F90 --- problems/postprocessing_igrid/Spectrum.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/problems/postprocessing_igrid/Spectrum.F90 b/problems/postprocessing_igrid/Spectrum.F90 index 81d343ff..a88a8e70 100644 --- a/problems/postprocessing_igrid/Spectrum.F90 +++ b/problems/postprocessing_igrid/Spectrum.F90 @@ -226,7 +226,7 @@ subroutine normalize_component_line(line, normalized) normalized = line do i = 1, len_trim(normalized) select case (normalized(i:i)) - case ('{', '}', '"', ',', ':') + case ('{', '}', ',', ':') normalized(i:i) = ' ' end select end do @@ -284,7 +284,7 @@ subroutine remove_requested_means() if (remove_spatial_mean) then mean_value = p_sum(sum(field))/npts field = field - mean_value - call message(1, 'Removed volume mean:', mean_value) + call message(0, 'Removed volume mean:', mean_value) end if if (remove_horizontal_mean) then @@ -317,7 +317,7 @@ subroutine remove_horizontal_profile() field(:,:,k) = field(:,:,k) - profile_global(kg) end do - call message(1, 'Removed horizontally averaged mean profile') + call message(0, 'Removed horizontally averaged mean profile') deallocate(profile_local, profile_global) end subroutine remove_horizontal_profile @@ -400,9 +400,9 @@ subroutine parseval_check() else spectral_energy = sum(spectrum_global) end if - call message(1, 'Physical-space variance/energy:', physical_energy) - call message(1, 'Spectrum-integrated energy:', spectral_energy) - call message(1, 'Parseval absolute error:', abs(spectral_energy - physical_energy)) + call message(0, 'Physical-space variance/energy:', physical_energy) + call message(0, 'Spectrum-integrated energy:', spectral_energy) + call message(0, 'Parseval absolute error:', abs(spectral_energy - physical_energy)) end if end subroutine parseval_check @@ -414,7 +414,7 @@ subroutine export_csv(field_name) if (nrank /= 0) return outfile = trim(outputdir)//'/spectrum_'//trim(sanitize_field_name(field_name))//'.csv' - call message(1, 'Writing spectrum to '//trim(outfile)) + call message(0, 'Writing spectrum to '//trim(outfile)) open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') write(unit, '(A)') 'k,E' @@ -502,7 +502,7 @@ program spectrum call read_field_specs(trim(infile), specs) do ispec = 1, size(specs) - call message(1, 'Computing spectrum for '//trim(specs(ispec)%name)) + call message(0, 'Computing spectrum for '//trim(specs(ispec)%name)) call read_field(specs(ispec)) call remove_requested_means() call spectC%fft(field, fhat) From 004b2e94dd134e6e113da328281763dcccac216f Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 25 May 2026 12:16:14 -0400 Subject: [PATCH 086/114] change AD Fringe namelist name to avoid collision with &Fringe namelist --- src/incompressible/fringeADmethod.F90 | 40 ++++++++++++++++++++++----- 1 file changed, 33 insertions(+), 7 deletions(-) diff --git a/src/incompressible/fringeADmethod.F90 b/src/incompressible/fringeADmethod.F90 index b10b4baa..f4d8c769 100644 --- a/src/incompressible/fringeADmethod.F90 +++ b/src/incompressible/fringeADmethod.F90 @@ -64,7 +64,7 @@ subroutine init(this, inputfile, nx, ny, nz, x, y, z, Lx, Ly, dz, dy) logical :: y_fringe_active ! ------------------------------------------------------------------ - ! FRINGEAD namelist variables. + ! ADFRINGE namelist variables. ! ! FringeAD_st and FringeAD_en define the x-extent over which the AD ! fringe is active. This interval is periodic in x. @@ -136,7 +136,7 @@ subroutine init(this, inputfile, nx, ny, nz, x, y, z, Lx, Ly, dz, dy) real(rkind) :: xshift = zero real(rkind) :: yshift = zero - namelist /FRINGEAD/ FringeAD_st, FringeAD_en, FringeAD_delta_st, FringeAD_delta_en, & + namelist /ADFRINGE/ FringeAD_st, FringeAD_en, FringeAD_delta_st, FringeAD_delta_en, & FringeAD_H, FringeAD_deltaH, FringeAD_deltaY, use_tanh, & FringeAD_taper_y @@ -154,20 +154,20 @@ subroutine init(this, inputfile, nx, ny, nz, x, y, z, Lx, Ly, dz, dy) ioUnit = 1019 ! ------------------------------------------------------------------ - ! Read FRINGEAD namelist. + ! Read ADFRINGE namelist. ! ------------------------------------------------------------------ open(unit=ioUnit, file=trim(inputfile), form='FORMATTED', iostat=ierr) if (ierr /= 0) then - call message('fringeADMethod:init could not open input file for FRINGEAD namelist.') + call message('fringeADMethod:init could not open input file for ADFRINGE namelist.') this%Fringe_kernel = one return end if - read(unit=ioUnit, nml=FRINGEAD, iostat=ierr) + read(unit=ioUnit, nml=ADFRINGE, iostat=ierr) close(ioUnit) if (ierr /= 0) then - call message('fringeADMethod:init could not read FRINGEAD namelist; using defaults where needed.') + call message('fringeADMethod:init could not read ADFRINGE namelist; using defaults where needed.') end if ! ------------------------------------------------------------------ @@ -189,6 +189,32 @@ subroutine init(this, inputfile, nx, ny, nz, x, y, z, Lx, Ly, dz, dy) end if end if + call message(0, 'AD fringe parameters:') + call message(1, 'FringeAD_st', FringeAD_st) + call message(1, 'FringeAD_en', FringeAD_en) + call message(1, 'FringeAD_delta_st', FringeAD_delta_st) + call message(1, 'FringeAD_delta_en', FringeAD_delta_en) + call message(1, 'FringeAD_H', FringeAD_H) + call message(1, 'FringeAD_deltaH', FringeAD_deltaH) + call message(1, 'FringeAD_deltaY', FringeAD_deltaY) + if (use_tanh) then + call message(1, 'use_tanh = .true.') + else + call message(1, 'use_tanh = .false.') + end if + if (FringeAD_taper_y) then + call message(1, 'FringeAD_taper_y = .true.') + else + call message(1, 'FringeAD_taper_y = .false.') + end if + if (Apply_y_fringe) then + call message(1, 'Apply_y_fringe = .true.') + else + call message(1, 'Apply_y_fringe = .false.') + end if + call message(1, 'Fringe_yst', Fringe_yst) + call message(1, 'Fringe_yen', Fringe_yen) + ! ------------------------------------------------------------------ ! x-direction: build the periodic AD-fringe function. ! @@ -457,4 +483,4 @@ subroutine S_fringe(this, x, output) end subroutine S_fringe -end module fringeADMethod \ No newline at end of file +end module fringeADMethod From 6c2e38518f2ad7cad56a18acb0512d6450bb4927 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 25 May 2026 15:11:58 -0400 Subject: [PATCH 087/114] Add 1D options to Spectrum --- problems/postprocessing_igrid/Spectrum.F90 | 232 ++++++++++++++++-- .../Spectrum_files/input_spectrum.dat | 4 + 2 files changed, 221 insertions(+), 15 deletions(-) diff --git a/problems/postprocessing_igrid/Spectrum.F90 b/problems/postprocessing_igrid/Spectrum.F90 index a88a8e70..843736d6 100644 --- a/problems/postprocessing_igrid/Spectrum.F90 +++ b/problems/postprocessing_igrid/Spectrum.F90 @@ -18,6 +18,10 @@ module spectrum_mod logical :: remove_horizontal_mean=.false. logical :: include_one_half=.false. logical :: write_density=.false. + logical :: write_x_spectrum=.true. + logical :: write_y_spectrum=.true. + logical :: write_vertical_summary=.true. + logical :: write_height_spectra=.false. type(decomp_info) :: gpC type(spectral) :: spectC @@ -25,8 +29,15 @@ module spectrum_mod complex(rkind), dimension(:,:,:), allocatable :: fhat real(rkind), dimension(:), allocatable :: kbin, spectrum_local, spectrum_global integer, dimension(:), allocatable :: counts_local, counts_global + real(rkind), dimension(:), allocatable :: kxbin, kybin, spectrum_x_local, spectrum_x_global + real(rkind), dimension(:), allocatable :: spectrum_y_local, spectrum_y_global + integer, dimension(:), allocatable :: counts_x_local, counts_x_global + integer, dimension(:), allocatable :: counts_y_local, counts_y_global + real(rkind), dimension(:,:), allocatable :: spectrum_height_local, spectrum_height_global + integer, dimension(:,:), allocatable :: counts_height_local, counts_height_global integer :: nbins, ierr - real(rkind) :: dk, normfact + integer :: nbins_x, nbins_y + real(rkind) :: dk, dkx, dky, normfact type field_component character(len=clen) :: filename = '' @@ -326,25 +337,56 @@ subroutine init_bins() real(rkind) :: kmax dk = min(two*pi/Lx, two*pi/Ly) + dkx = two*pi/Lx + dky = two*pi/Ly kmax = sqrt((pi/dx)**2 + (pi/dy)**2) nbins = int(kmax/dk) + 2 + nbins_x = nx/2 + 1 + nbins_y = ny/2 + 1 normfact = one/(nhorz*nhorz*real(nz,rkind)) allocate(kbin(nbins), spectrum_local(nbins), spectrum_global(nbins)) allocate(counts_local(nbins), counts_global(nbins)) + allocate(kxbin(nbins_x), kybin(nbins_y)) + allocate(spectrum_x_local(nbins_x), spectrum_x_global(nbins_x)) + allocate(spectrum_y_local(nbins_y), spectrum_y_global(nbins_y)) + allocate(counts_x_local(nbins_x), counts_x_global(nbins_x)) + allocate(counts_y_local(nbins_y), counts_y_global(nbins_y)) + allocate(spectrum_height_local(nbins,nz), spectrum_height_global(nbins,nz)) + allocate(counts_height_local(nbins,nz), counts_height_global(nbins,nz)) do b = 1, nbins kbin(b) = (real(b,rkind) - half)*dk end do + do b = 1, nbins_x + kxbin(b) = real(b-1,rkind)*dkx + end do + + do b = 1, nbins_y + kybin(b) = real(b-1,rkind)*dky + end do + spectrum_local = zero spectrum_global = zero counts_local = 0 counts_global = 0 + spectrum_x_local = zero + spectrum_x_global = zero + spectrum_y_local = zero + spectrum_y_global = zero + counts_x_local = 0 + counts_x_global = 0 + counts_y_local = 0 + counts_y_global = 0 + spectrum_height_local = zero + spectrum_height_global = zero + counts_height_local = 0 + counts_height_global = 0 end subroutine init_bins subroutine compute_spectrum() - integer :: i, j, k, ig, ibin, multiplicity + integer :: i, j, k, ig, jg, kg, ibin, ixbin, iybin, multiplicity real(rkind) :: kmag, amp2, factor factor = one @@ -352,20 +394,43 @@ subroutine compute_spectrum() spectrum_local = zero counts_local = 0 + spectrum_x_local = zero + spectrum_y_local = zero + counts_x_local = 0 + counts_y_local = 0 + spectrum_height_local = zero + counts_height_local = 0 do k = 1, size(fhat,3) + kg = spectC%spectdecomp%yst(3) + k - 1 do j = 1, size(fhat,2) + jg = spectC%spectdecomp%yst(2) + j - 1 + iybin = y_abs_bin(jg) do i = 1, size(fhat,1) kmag = sqrt(spectC%kabs_sq(i,j,k)) ibin = int(kmag/dk) + 1 + ig = spectC%spectdecomp%yst(1) + i - 1 + ixbin = ig + multiplicity = hermitian_multiplicity(ig) + amp2 = factor*real(multiplicity,rkind)* & + real(fhat(i,j,k)*conjg(fhat(i,j,k)), rkind)*normfact + if ((ibin >= 1) .and. (ibin <= nbins)) then - ig = spectC%spectdecomp%yst(1) + i - 1 - multiplicity = hermitian_multiplicity(ig) - amp2 = real(fhat(i,j,k)*conjg(fhat(i,j,k)), rkind) - spectrum_local(ibin) = spectrum_local(ibin) + & - factor*real(multiplicity,rkind)*amp2*normfact + spectrum_local(ibin) = spectrum_local(ibin) + amp2 counts_local(ibin) = counts_local(ibin) + multiplicity + spectrum_height_local(ibin,kg) = spectrum_height_local(ibin,kg) + amp2*real(nz,rkind) + counts_height_local(ibin,kg) = counts_height_local(ibin,kg) + multiplicity + end if + + if ((ixbin >= 1) .and. (ixbin <= nbins_x)) then + spectrum_x_local(ixbin) = spectrum_x_local(ixbin) + amp2 + counts_x_local(ixbin) = counts_x_local(ixbin) + multiplicity + end if + + if ((iybin >= 1) .and. (iybin <= nbins_y)) then + spectrum_y_local(iybin) = spectrum_y_local(iybin) + amp2 + counts_y_local(iybin) = counts_y_local(iybin) + multiplicity end if end do end do @@ -373,10 +438,33 @@ subroutine compute_spectrum() call MPI_Reduce(spectrum_local, spectrum_global, nbins, mpirkind, MPI_SUM, 0, MPI_COMM_WORLD, ierr) call MPI_Reduce(counts_local, counts_global, nbins, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD, ierr) - - if (write_density .and. nrank == 0) spectrum_global = spectrum_global/dk + call MPI_Reduce(spectrum_x_local, spectrum_x_global, nbins_x, mpirkind, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + call MPI_Reduce(spectrum_y_local, spectrum_y_global, nbins_y, mpirkind, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + call MPI_Reduce(counts_x_local, counts_x_global, nbins_x, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + call MPI_Reduce(counts_y_local, counts_y_global, nbins_y, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + call MPI_Reduce(spectrum_height_local, spectrum_height_global, nbins*nz, & + mpirkind, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + call MPI_Reduce(counts_height_local, counts_height_global, nbins*nz, & + MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + + if (write_density .and. nrank == 0) then + spectrum_global = spectrum_global/dk + spectrum_x_global = spectrum_x_global/dkx + spectrum_y_global = spectrum_y_global/dky + spectrum_height_global = spectrum_height_global/dk + end if end subroutine compute_spectrum + integer function y_abs_bin(jg) + integer, intent(in) :: jg + + if (jg <= ny/2 + 1) then + y_abs_bin = jg + else + y_abs_bin = ny - jg + 2 + end if + end function y_abs_bin + integer function hermitian_multiplicity(ig) integer, intent(in) :: ig @@ -388,7 +476,7 @@ integer function hermitian_multiplicity(ig) end function hermitian_multiplicity subroutine parseval_check() - real(rkind) :: physical_energy, spectral_energy, factor + real(rkind) :: physical_energy, spectral_energy, spectral_x_energy, spectral_y_energy, factor factor = one if (include_one_half) factor = half @@ -401,8 +489,17 @@ subroutine parseval_check() spectral_energy = sum(spectrum_global) end if call message(0, 'Physical-space variance/energy:', physical_energy) - call message(0, 'Spectrum-integrated energy:', spectral_energy) - call message(0, 'Parseval absolute error:', abs(spectral_energy - physical_energy)) + call message(0, 'Horizontal spectrum-integrated energy:', spectral_energy) + call message(0, 'Horizontal spectrum Parseval absolute error:', abs(spectral_energy - physical_energy)) + if (write_density) then + spectral_x_energy = sum(spectrum_x_global)*dkx + spectral_y_energy = sum(spectrum_y_global)*dky + else + spectral_x_energy = sum(spectrum_x_global) + spectral_y_energy = sum(spectrum_y_global) + end if + call message(0, 'Streamwise spectrum-integrated energy:', spectral_x_energy) + call message(0, 'Spanwise spectrum-integrated energy:', spectral_y_energy) end if end subroutine parseval_check @@ -414,7 +511,7 @@ subroutine export_csv(field_name) if (nrank /= 0) return outfile = trim(outputdir)//'/spectrum_'//trim(sanitize_field_name(field_name))//'.csv' - call message(0, 'Writing spectrum to '//trim(outfile)) + call message(0, 'Writing vertically averaged horizontal spectrum to '//trim(outfile)) open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') write(unit, '(A)') 'k,E' @@ -424,6 +521,103 @@ subroutine export_csv(field_name) close(unit) end subroutine export_csv + subroutine export_directional_csv(field_name) + character(len=*), intent(in) :: field_name + character(len=clen) :: outfile, clean_name + integer :: unit, b + + if (nrank /= 0) return + + clean_name = sanitize_field_name(field_name) + + if (write_x_spectrum) then + outfile = trim(outputdir)//'/spectrum_x_'//trim(clean_name)//'.csv' + call message(0, 'Writing streamwise spectrum to '//trim(outfile)) + open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') + write(unit, '(A)') 'kx,E' + do b = 1, nbins_x + if (counts_x_global(b) > 0) write(unit, '(ES24.16,",",ES24.16)') kxbin(b), spectrum_x_global(b) + end do + close(unit) + end if + + if (write_y_spectrum) then + outfile = trim(outputdir)//'/spectrum_y_'//trim(clean_name)//'.csv' + call message(0, 'Writing spanwise spectrum to '//trim(outfile)) + open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') + write(unit, '(A)') 'ky,E' + do b = 1, nbins_y + if (counts_y_global(b) > 0) write(unit, '(ES24.16,",",ES24.16)') kybin(b), spectrum_y_global(b) + end do + close(unit) + end if + end subroutine export_directional_csv + + subroutine export_vertical_summary_csv(field_name) + character(len=*), intent(in) :: field_name + character(len=clen) :: outfile, clean_name + integer :: unit, b, kg + real(rkind) :: energy_sum, zc, zspread, zg + + if (nrank /= 0) return + if (.not. write_vertical_summary) return + + clean_name = sanitize_field_name(field_name) + outfile = trim(outputdir)//'/spectrum_zsummary_'//trim(clean_name)//'.csv' + call message(0, 'Writing vertical spectrum summary to '//trim(outfile)) + + open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') + write(unit, '(A)') 'k,E,z_centroid,z_spread' + do b = 1, nbins + if (counts_global(b) <= 0) cycle + energy_sum = sum(spectrum_height_global(b,:)) + if (energy_sum <= zero) cycle + + zc = zero + do kg = 1, nz + zg = (real(kg,rkind) - half)*dz + zc = zc + zg*spectrum_height_global(b,kg) + end do + zc = zc/energy_sum + + zspread = zero + do kg = 1, nz + zg = (real(kg,rkind) - half)*dz + zspread = zspread + (zg - zc)**2*spectrum_height_global(b,kg) + end do + zspread = sqrt(zspread/energy_sum) + + write(unit, '(ES24.16,",",ES24.16,",",ES24.16,",",ES24.16)') & + kbin(b), spectrum_global(b), zc, zspread + end do + close(unit) + end subroutine export_vertical_summary_csv + + subroutine export_height_spectra_csv(field_name) + character(len=*), intent(in) :: field_name + character(len=clen) :: outfile, clean_name + integer :: unit, b, kg + real(rkind) :: zg + + if (nrank /= 0) return + if (.not. write_height_spectra) return + + clean_name = sanitize_field_name(field_name) + outfile = trim(outputdir)//'/spectrum_height_'//trim(clean_name)//'.csv' + call message(0, 'Writing height-resolved horizontal spectra to '//trim(outfile)) + + open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') + write(unit, '(A)') 'z,k,E' + do kg = 1, nz + zg = (real(kg,rkind) - half)*dz + do b = 1, nbins + if (counts_height_global(b,kg) > 0) write(unit, '(ES24.16,",",ES24.16,",",ES24.16)') & + zg, kbin(b), spectrum_height_global(b,kg) + end do + end do + close(unit) + end subroutine export_height_spectra_csv + function sanitize_field_name(field_name) result(clean_name) implicit none character(len=*), intent(in) :: field_name @@ -456,7 +650,8 @@ program spectrum type(spectrum_field), allocatable :: specs(:) namelist /INPUT/ inputdir, outputdir, nx, ny, nz, Lx, Ly, Lz, prow, pcol, fields, & - remove_spatial_mean, remove_horizontal_mean, include_one_half, write_density + remove_spatial_mean, remove_horizontal_mean, include_one_half, write_density, & + write_x_spectrum, write_y_spectrum, write_vertical_summary, write_height_spectra call MPI_Init(ierr) call MPI_Comm_rank(MPI_COMM_WORLD, nrank, ierr) @@ -484,7 +679,8 @@ program spectrum call decomp_2d_init(nx, ny, nz, prow, pcol) call decomp_info_init(nx, ny, nz, gpC) - call spectC%init('x', nx, ny, nz, dx, dy, dz, 'FOUR', '2/3rd',dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) + call spectC%init('x', nx, ny, nz, dx, dy, dz, 'FOUR', '2/3rd', & + dimTransform=2, fixOddball=.false., init_periodicInZ=.false.) allocate(field(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3))) allocate(rbuffxC(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3))) @@ -509,9 +705,15 @@ program spectrum call compute_spectrum() call parseval_check() call export_csv(specs(ispec)%name) + call export_directional_csv(specs(ispec)%name) + call export_vertical_summary_csv(specs(ispec)%name) + call export_height_spectra_csv(specs(ispec)%name) end do deallocate(field, rbuffxC, fhat, kbin, spectrum_local, spectrum_global, counts_local, counts_global) + deallocate(kxbin, kybin, spectrum_x_local, spectrum_x_global, spectrum_y_local, spectrum_y_global) + deallocate(counts_x_local, counts_x_global, counts_y_local, counts_y_global) + deallocate(spectrum_height_local, spectrum_height_global, counts_height_local, counts_height_global) call spectC%destroy() call decomp_info_finalize(gpC) call decomp_2d_finalize() diff --git a/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat b/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat index 2ca7a36d..05e909c6 100644 --- a/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat +++ b/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat @@ -14,4 +14,8 @@ remove_spatial_mean = .false. remove_horizontal_mean = .false. include_one_half = .false. write_density = .true. +write_x_spectrum = .true. +write_y_spectrum = .true. +write_vertical_summary = .true. +write_height_spectra = .false. / From 51d6948d907b88da2cb5f2548bc2f7c238ae7196 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 25 May 2026 18:21:54 -0400 Subject: [PATCH 088/114] Add yz spectra per x --- problems/postprocessing_igrid/Spectrum.F90 | 133 +++++++++++++++++- .../Spectrum_files/input_spectrum.dat | 1 + 2 files changed, 132 insertions(+), 2 deletions(-) diff --git a/problems/postprocessing_igrid/Spectrum.F90 b/problems/postprocessing_igrid/Spectrum.F90 index 843736d6..2fe91311 100644 --- a/problems/postprocessing_igrid/Spectrum.F90 +++ b/problems/postprocessing_igrid/Spectrum.F90 @@ -22,11 +22,15 @@ module spectrum_mod logical :: write_y_spectrum=.true. logical :: write_vertical_summary=.true. logical :: write_height_spectra=.false. + logical :: write_yz_plane_spectra=.false. type(decomp_info) :: gpC + type(decomp_info) :: gpYSpec type(spectral) :: spectC real(rkind), dimension(:,:,:), allocatable :: field, rbuffxC + real(rkind), dimension(:,:,:), allocatable :: field_y complex(rkind), dimension(:,:,:), allocatable :: fhat + complex(rkind), dimension(:,:,:), allocatable :: field_yhat real(rkind), dimension(:), allocatable :: kbin, spectrum_local, spectrum_global integer, dimension(:), allocatable :: counts_local, counts_global real(rkind), dimension(:), allocatable :: kxbin, kybin, spectrum_x_local, spectrum_x_global @@ -35,9 +39,13 @@ module spectrum_mod integer, dimension(:), allocatable :: counts_y_local, counts_y_global real(rkind), dimension(:,:), allocatable :: spectrum_height_local, spectrum_height_global integer, dimension(:,:), allocatable :: counts_height_local, counts_height_global + real(rkind), dimension(:,:), allocatable :: spectrum_yzplane_local, spectrum_yzplane_global integer :: nbins, ierr integer :: nbins_x, nbins_y - real(rkind) :: dk, dkx, dky, normfact + real(rkind) :: dk, dkx, dky, normfact, normfact_yzplane + integer(kind=8) :: plan_r2c_y_plane = 0 + + include "fftw3.f" type field_component character(len=clen) :: filename = '' @@ -344,6 +352,7 @@ subroutine init_bins() nbins_x = nx/2 + 1 nbins_y = ny/2 + 1 normfact = one/(nhorz*nhorz*real(nz,rkind)) + normfact_yzplane = one/(real(ny,rkind)*real(ny,rkind)*real(nz,rkind)) allocate(kbin(nbins), spectrum_local(nbins), spectrum_global(nbins)) allocate(counts_local(nbins), counts_global(nbins)) @@ -354,6 +363,7 @@ subroutine init_bins() allocate(counts_y_local(nbins_y), counts_y_global(nbins_y)) allocate(spectrum_height_local(nbins,nz), spectrum_height_global(nbins,nz)) allocate(counts_height_local(nbins,nz), counts_height_global(nbins,nz)) + allocate(spectrum_yzplane_local(nbins_y,nx), spectrum_yzplane_global(nbins_y,nx)) do b = 1, nbins kbin(b) = (real(b,rkind) - half)*dk @@ -383,8 +393,44 @@ subroutine init_bins() spectrum_height_global = zero counts_height_local = 0 counts_height_global = 0 + spectrum_yzplane_local = zero + spectrum_yzplane_global = zero end subroutine init_bins + subroutine init_yz_plane_spectra() + integer :: ierr_local + integer :: n_sizeact, n_sizeinput, n_sizeoutput, n_howmany, n_jump, n_chunk + real(rkind), dimension(:,:), allocatable :: real_arr_2d + complex(rkind), dimension(:,:), allocatable :: cmplx_arr_2d + + if (.not. write_yz_plane_spectra) return + + call decomp_info_init(nx, ny/2 + 1, nz, gpYSpec) + allocate(field_y(gpC%ysz(1), gpC%ysz(2), gpC%ysz(3)), stat=ierr_local) + if (ierr_local /= 0) call gracefulExit("Could not allocate y-pencil field buffer.", 130) + allocate(field_yhat(gpYSpec%ysz(1), gpYSpec%ysz(2), gpYSpec%ysz(3)), stat=ierr_local) + if (ierr_local /= 0) call gracefulExit("Could not allocate y-plane spectrum buffer.", 131) + + allocate(real_arr_2d(gpC%ysz(1), gpC%ysz(2)), stat=ierr_local) + if (ierr_local /= 0) call gracefulExit("Could not allocate y FFT planning real buffer.", 132) + allocate(cmplx_arr_2d(gpYSpec%ysz(1), gpYSpec%ysz(2)), stat=ierr_local) + if (ierr_local /= 0) call gracefulExit("Could not allocate y FFT planning complex buffer.", 133) + + n_sizeact = gpC%ysz(2) + n_sizeinput = gpC%ysz(2) + n_sizeoutput = gpYSpec%ysz(2) + n_howmany = gpC%ysz(1) + n_jump = gpC%ysz(1) + n_chunk = 1 + call dfftw_plan_many_dft_r2c(plan_r2c_y_plane, 1, n_sizeact, & + n_howmany, real_arr_2d, n_sizeinput, n_jump, n_chunk, & + cmplx_arr_2d, n_sizeoutput, n_jump, n_chunk, FFTW_MEASURE) + + deallocate(real_arr_2d, cmplx_arr_2d) + field_y = zero + field_yhat = cmplx(zero, zero, kind=rkind) + end subroutine init_yz_plane_spectra + subroutine compute_spectrum() integer :: i, j, k, ig, jg, kg, ibin, ixbin, iybin, multiplicity real(rkind) :: kmag, amp2, factor @@ -475,6 +521,55 @@ integer function hermitian_multiplicity(ig) end if end function hermitian_multiplicity + integer function y_hermitian_multiplicity(iy) + integer, intent(in) :: iy + + if ((iy == 1) .or. (iy == ny/2 + 1)) then + y_hermitian_multiplicity = 1 + else + y_hermitian_multiplicity = 2 + end if + end function y_hermitian_multiplicity + + subroutine compute_yz_plane_spectrum() + integer :: i, j, k, ig, multiplicity + real(rkind) :: amp2, factor + + if (.not. write_yz_plane_spectra) return + + factor = one + if (include_one_half) factor = half + + spectrum_yzplane_local = zero + field_y = zero + field_yhat = cmplx(zero, zero, kind=rkind) + + call transpose_x_to_y(field, field_y, gpC) + + do k = 1, gpC%ysz(3) + call dfftw_execute_dft_r2c(plan_r2c_y_plane, field_y(:,:,k), field_yhat(:,:,k)) + end do + + do k = 1, size(field_yhat,3) + do j = 1, size(field_yhat,2) + multiplicity = y_hermitian_multiplicity(j) + do i = 1, size(field_yhat,1) + ig = gpYSpec%yst(1) + i - 1 + amp2 = factor*real(multiplicity,rkind)* & + real(field_yhat(i,j,k)*conjg(field_yhat(i,j,k)), rkind)*normfact_yzplane + if ((ig >= 1) .and. (ig <= nx)) then + spectrum_yzplane_local(j,ig) = spectrum_yzplane_local(j,ig) + amp2 + end if + end do + end do + end do + + call MPI_Reduce(spectrum_yzplane_local, spectrum_yzplane_global, nbins_y*nx, & + mpirkind, MPI_SUM, 0, MPI_COMM_WORLD, ierr) + + if (write_density .and. nrank == 0) spectrum_yzplane_global = spectrum_yzplane_global/dky + end subroutine compute_yz_plane_spectrum + subroutine parseval_check() real(rkind) :: physical_energy, spectral_energy, spectral_x_energy, spectral_y_energy, factor @@ -618,6 +713,30 @@ subroutine export_height_spectra_csv(field_name) close(unit) end subroutine export_height_spectra_csv + subroutine export_yz_plane_spectra_csv(field_name) + character(len=*), intent(in) :: field_name + character(len=clen) :: outfile, clean_name + integer :: unit, b, ig + real(rkind) :: xg + + if (nrank /= 0) return + if (.not. write_yz_plane_spectra) return + + clean_name = sanitize_field_name(field_name) + outfile = trim(outputdir)//'/spectrum_yzplane_'//trim(clean_name)//'.csv' + call message(0, 'Writing y spectra for each y-z plane to '//trim(outfile)) + + open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') + write(unit, '(A)') 'x,ky,E' + do ig = 1, nx + xg = (real(ig,rkind) - half)*dx + do b = 1, nbins_y + write(unit, '(ES24.16,",",ES24.16,",",ES24.16)') xg, kybin(b), spectrum_yzplane_global(b,ig) + end do + end do + close(unit) + end subroutine export_yz_plane_spectra_csv + function sanitize_field_name(field_name) result(clean_name) implicit none character(len=*), intent(in) :: field_name @@ -651,7 +770,8 @@ program spectrum namelist /INPUT/ inputdir, outputdir, nx, ny, nz, Lx, Ly, Lz, prow, pcol, fields, & remove_spatial_mean, remove_horizontal_mean, include_one_half, write_density, & - write_x_spectrum, write_y_spectrum, write_vertical_summary, write_height_spectra + write_x_spectrum, write_y_spectrum, write_vertical_summary, write_height_spectra, & + write_yz_plane_spectra call MPI_Init(ierr) call MPI_Comm_rank(MPI_COMM_WORLD, nrank, ierr) @@ -695,12 +815,14 @@ program spectrum inquire(file=trim(infile), exist=exists) if (.not. exists) call gracefulExit('Input field-spec file not found: '//trim(infile), 106) call init_bins() + call init_yz_plane_spectra() call read_field_specs(trim(infile), specs) do ispec = 1, size(specs) call message(0, 'Computing spectrum for '//trim(specs(ispec)%name)) call read_field(specs(ispec)) call remove_requested_means() + call compute_yz_plane_spectrum() call spectC%fft(field, fhat) call compute_spectrum() call parseval_check() @@ -708,12 +830,19 @@ program spectrum call export_directional_csv(specs(ispec)%name) call export_vertical_summary_csv(specs(ispec)%name) call export_height_spectra_csv(specs(ispec)%name) + call export_yz_plane_spectra_csv(specs(ispec)%name) end do deallocate(field, rbuffxC, fhat, kbin, spectrum_local, spectrum_global, counts_local, counts_global) deallocate(kxbin, kybin, spectrum_x_local, spectrum_x_global, spectrum_y_local, spectrum_y_global) deallocate(counts_x_local, counts_x_global, counts_y_local, counts_y_global) deallocate(spectrum_height_local, spectrum_height_global, counts_height_local, counts_height_global) + deallocate(spectrum_yzplane_local, spectrum_yzplane_global) + if (write_yz_plane_spectra) then + call dfftw_destroy_plan(plan_r2c_y_plane) + deallocate(field_y, field_yhat) + call decomp_info_finalize(gpYSpec) + end if call spectC%destroy() call decomp_info_finalize(gpC) call decomp_2d_finalize() diff --git a/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat b/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat index 05e909c6..dbb96ef3 100644 --- a/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat +++ b/problems/postprocessing_igrid/Spectrum_files/input_spectrum.dat @@ -18,4 +18,5 @@ write_x_spectrum = .true. write_y_spectrum = .true. write_vertical_summary = .true. write_height_spectra = .false. +write_yz_plane_spectra = .true. / From 9dbe1b4f1fb2e7dc12e2cc1de39bf057b77a34c5 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 29 May 2026 17:06:38 -0400 Subject: [PATCH 089/114] add lateral spectrum and vertical stats --- problems/postprocessing_igrid/Spectrum.F90 | 42 +++++++++++++++------- 1 file changed, 30 insertions(+), 12 deletions(-) diff --git a/problems/postprocessing_igrid/Spectrum.F90 b/problems/postprocessing_igrid/Spectrum.F90 index 2fe91311..d8829913 100644 --- a/problems/postprocessing_igrid/Spectrum.F90 +++ b/problems/postprocessing_igrid/Spectrum.F90 @@ -571,7 +571,8 @@ subroutine compute_yz_plane_spectrum() end subroutine compute_yz_plane_spectrum subroutine parseval_check() - real(rkind) :: physical_energy, spectral_energy, spectral_x_energy, spectral_y_energy, factor + real(rkind) :: physical_energy, spectral_energy, spectral_x_energy, spectral_y_energy + real(rkind) :: spectral_height_energy, spectral_yzplane_energy, factor factor = one if (include_one_half) factor = half @@ -583,18 +584,35 @@ subroutine parseval_check() else spectral_energy = sum(spectrum_global) end if - call message(0, 'Physical-space variance/energy:', physical_energy) - call message(0, 'Horizontal spectrum-integrated energy:', spectral_energy) - call message(0, 'Horizontal spectrum Parseval absolute error:', abs(spectral_energy - physical_energy)) + call message(2, 'Physical-space variance/energy:', physical_energy) + call message(2, 'Horizontal spectrum-integrated energy:', spectral_energy) + call message(2, 'Horizontal spectrum Parseval absolute error:', abs(spectral_energy - physical_energy)) if (write_density) then spectral_x_energy = sum(spectrum_x_global)*dkx spectral_y_energy = sum(spectrum_y_global)*dky + spectral_height_energy = sum(spectrum_height_global)*dk/real(nz,rkind) else spectral_x_energy = sum(spectrum_x_global) spectral_y_energy = sum(spectrum_y_global) + spectral_height_energy = sum(spectrum_height_global)/real(nz,rkind) + end if + call message(2, 'Streamwise spectrum-integrated energy:', spectral_x_energy) + call message(2, 'Streamwise spectrum Parseval absolute error:', abs(spectral_x_energy - physical_energy)) + call message(2, 'Spanwise spectrum-integrated energy:', spectral_y_energy) + call message(2, 'Spanwise spectrum Parseval absolute error:', abs(spectral_y_energy - physical_energy)) + call message(2, 'Height-resolved horizontal spectrum-integrated energy:', spectral_height_energy) + call message(2, 'Height-resolved horizontal spectrum Parseval absolute error:', & + abs(spectral_height_energy - physical_energy)) + if (write_yz_plane_spectra) then + if (write_density) then + spectral_yzplane_energy = sum(spectrum_yzplane_global)*dky/real(nx,rkind) + else + spectral_yzplane_energy = sum(spectrum_yzplane_global)/real(nx,rkind) + end if + call message(2, 'Y-Z plane spectrum-integrated energy:', spectral_yzplane_energy) + call message(2, 'Y-Z plane spectrum Parseval absolute error:', & + abs(spectral_yzplane_energy - physical_energy)) end if - call message(0, 'Streamwise spectrum-integrated energy:', spectral_x_energy) - call message(0, 'Spanwise spectrum-integrated energy:', spectral_y_energy) end if end subroutine parseval_check @@ -606,7 +624,7 @@ subroutine export_csv(field_name) if (nrank /= 0) return outfile = trim(outputdir)//'/spectrum_'//trim(sanitize_field_name(field_name))//'.csv' - call message(0, 'Writing vertically averaged horizontal spectrum to '//trim(outfile)) + call message(1, 'Writing vertically averaged horizontal spectrum to '//trim(outfile)) open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') write(unit, '(A)') 'k,E' @@ -627,7 +645,7 @@ subroutine export_directional_csv(field_name) if (write_x_spectrum) then outfile = trim(outputdir)//'/spectrum_x_'//trim(clean_name)//'.csv' - call message(0, 'Writing streamwise spectrum to '//trim(outfile)) + call message(1, 'Writing streamwise spectrum to '//trim(outfile)) open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') write(unit, '(A)') 'kx,E' do b = 1, nbins_x @@ -638,7 +656,7 @@ subroutine export_directional_csv(field_name) if (write_y_spectrum) then outfile = trim(outputdir)//'/spectrum_y_'//trim(clean_name)//'.csv' - call message(0, 'Writing spanwise spectrum to '//trim(outfile)) + call message(1, 'Writing spanwise spectrum to '//trim(outfile)) open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') write(unit, '(A)') 'ky,E' do b = 1, nbins_y @@ -659,7 +677,7 @@ subroutine export_vertical_summary_csv(field_name) clean_name = sanitize_field_name(field_name) outfile = trim(outputdir)//'/spectrum_zsummary_'//trim(clean_name)//'.csv' - call message(0, 'Writing vertical spectrum summary to '//trim(outfile)) + call message(1, 'Writing vertical spectrum summary to '//trim(outfile)) open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') write(unit, '(A)') 'k,E,z_centroid,z_spread' @@ -699,7 +717,7 @@ subroutine export_height_spectra_csv(field_name) clean_name = sanitize_field_name(field_name) outfile = trim(outputdir)//'/spectrum_height_'//trim(clean_name)//'.csv' - call message(0, 'Writing height-resolved horizontal spectra to '//trim(outfile)) + call message(1, 'Writing height-resolved horizontal spectra to '//trim(outfile)) open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') write(unit, '(A)') 'z,k,E' @@ -724,7 +742,7 @@ subroutine export_yz_plane_spectra_csv(field_name) clean_name = sanitize_field_name(field_name) outfile = trim(outputdir)//'/spectrum_yzplane_'//trim(clean_name)//'.csv' - call message(0, 'Writing y spectra for each y-z plane to '//trim(outfile)) + call message(1, 'Writing y spectra for each y-z plane to '//trim(outfile)) open(newunit=unit, file=trim(outfile), status='replace', action='write', form='formatted') write(unit, '(A)') 'x,ky,E' From de544dc8b5e875fb041df1461b332a421b7d540e Mon Sep 17 00:00:00 2001 From: karimali5 Date: Tue, 2 Jun 2026 21:03:00 +0100 Subject: [PATCH 090/114] Make PadeOps compatible with AMD compiler on Archer2 --- CMakeLists.txt | 19 ++++++++++++++++ setup/SetupEnv_Archer.sh | 47 --------------------------------------- setup/SetupEnv_Archer2.sh | 31 +++++++++----------------- src/CMakeLists.txt | 4 ++++ src/utilities/random.F90 | 26 +++++++++++++--------- 5 files changed, 50 insertions(+), 77 deletions(-) delete mode 100644 setup/SetupEnv_Archer.sh diff --git a/CMakeLists.txt b/CMakeLists.txt index e79e7910..ed3207ca 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -92,6 +92,25 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) set(CMAKE_Fortran_FLAGS "-O0 -qsuffix=cpp=f90 -qxlf2003=polymorphic") endif() + +# AOCC / AMD compiler suite +elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD" ) + if ( DEFINED ENV{ARCH_OPT_FLAG} AND NOT "$ENV{ARCH_OPT_FLAG}" STREQUAL "" ) + set(OPTFLAG "$ENV{ARCH_OPT_FLAG}") + else() + # ARCHER2 CPU nodes are AMD EPYC Rome / Zen 2 + #set(OPTFLAG "-march=znver2") + set(OPTFLAG "") + endif() + if ( CMAKE_BUILD_TYPE MATCHES "Release" ) + set(CMAKE_Fortran_FLAGS + "${CMAKE_Fortran_FLAGS} -O3 ${OPTFLAG} -fopenmp -ffree-form -ffast-math -funroll-loops" + ) + elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) + set(CMAKE_Fortran_FLAGS + "${CMAKE_Fortran_FLAGS} -O0 -g -fopenmp -ffree-form -fcheck=all -fbounds-check -ffpe-trap=zero,overflow" + ) + endif() endif() diff --git a/setup/SetupEnv_Archer.sh b/setup/SetupEnv_Archer.sh deleted file mode 100644 index e8c22903..00000000 --- a/setup/SetupEnv_Archer.sh +++ /dev/null @@ -1,47 +0,0 @@ -#!/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 index 1bb7b5be..a4084627 100644 --- a/setup/SetupEnv_Archer2.sh +++ b/setup/SetupEnv_Archer2.sh @@ -1,18 +1,17 @@ #!/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 load PrgEnv-gnu +module restore +module load PrgEnv-aocc/8.4.0 +module load craype-x86-rome +module load craype-network-ofi +module load cray-libsci/23.09.1.1 +module load cray-fftw/3.3.10.5 +module load cray-hdf5-parallel/1.12.2.7 module list -# --- Compilers (use Cray wrappers) --- -export COMPILER_ID=GNU +export COMPILER_ID=AMD export CC=cc export CXX=CC export FC=ftn @@ -30,15 +29,7 @@ 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}" +export CMAKE_PREFIX_PATH="${HDF5_PATH}:${FFTW_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 +export ARCH_OPT_FLAG="-march=znver2" diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index e5da4f25..b976566f 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -24,6 +24,8 @@ if ( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) 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) +elseif( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD" ) + 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() # 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}) @@ -38,6 +40,8 @@ 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 ${MPI_LIBRARIES}) +elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD") + target_link_libraries(PadeOps fftw3 2decomp_fft ${MPI_LIBRARIES}) endif() if (MPI_Fortran_COMPILER_FLAGS) diff --git a/src/utilities/random.F90 b/src/utilities/random.F90 index e8e36536..e0b00daa 100644 --- a/src/utilities/random.F90 +++ b/src/utilities/random.F90 @@ -1,7 +1,7 @@ -#ifdef __GFORTRAN__ -module ifport -end module ifport -#endif +! #ifdef __GFORTRAN__ +! module ifport +! end module ifport +! #endif module random use kind_parameters, only: rkind @@ -70,7 +70,6 @@ subroutine grand2R(array,mu,sigma,seed) array = mu + sigma*array nullify(uarr1, uarr2) - nullify(uarr1, uarr2) deallocate(uarr) end subroutine @@ -98,7 +97,6 @@ subroutine grand1R(array,mu,sigma,seed) array = mu + sigma*array nullify(uarr1, uarr2) - nullify(uarr1, uarr2) deallocate(uarr) end subroutine @@ -189,12 +187,20 @@ subroutine unrand0R(val,left, right) subroutine init_random_seed() - ! Taken from GNU use iso_fortran_env, only: int64 - use ifport + use iso_c_binding, only: c_int implicit none + + interface + function c_getpid() bind(C, name="getpid") result(pid) + import :: c_int + integer(c_int) :: pid + end function c_getpid + end interface + integer, allocatable :: iseed(:) - integer :: i, n, un, istat, dt(8), pid + integer :: i, n, un, istat, dt(8) + integer(c_int) :: pid integer(int64) :: t call random_seed(size = n) @@ -219,7 +225,7 @@ subroutine init_random_seed() + dt(6) * 60 * 1000 + dt(7) * 1000 & + dt(8) end if - pid = getpid() + pid = c_getpid() t = ieor(t, int(pid, kind(t))) do i = 1, n iseed(i) = lcg(t) From 00129649f1886365283334837fbfd5dd06c33d19 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 4 Jun 2026 15:50:22 +0100 Subject: [PATCH 091/114] GNU compiler does not accept using a real as size indicator --- src/incompressible/actuatorDisk_filtered.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index 34c42743..72d5b2b1 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -371,7 +371,7 @@ subroutine get_R2(this, ys, zs, R2) 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 + real(rkind), dimension(int(this%npts)) :: xi, yi, zi ! integer :: k real(rkind) :: rcut, coef, rsq real(rkind) :: xmin, xmax, ymin, ymax, zmin, zmax From b2af2439ac61b3ef8edf1e40a8b6509dd37ac54a Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 4 Jun 2026 15:50:41 +0100 Subject: [PATCH 092/114] Switch Archer2 compilation to GNU --- setup/SetupEnv_Archer2.sh | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/setup/SetupEnv_Archer2.sh b/setup/SetupEnv_Archer2.sh index a4084627..6566358e 100644 --- a/setup/SetupEnv_Archer2.sh +++ b/setup/SetupEnv_Archer2.sh @@ -1,17 +1,16 @@ #!/usr/bin/env bash # --- Modules --- -#module load PrgEnv-gnu -module restore -module load PrgEnv-aocc/8.4.0 +module purge +module load PrgEnv-gnu +# module load PrgEnv-aocc/8.4.0 module load craype-x86-rome -module load craype-network-ofi -module load cray-libsci/23.09.1.1 -module load cray-fftw/3.3.10.5 -module load cray-hdf5-parallel/1.12.2.7 +module load cray-libsci +module load cray-fftw +module load cray-hdf5-parallel module list -export COMPILER_ID=AMD +export COMPILER_ID=GNU export CC=cc export CXX=CC export FC=ftn @@ -31,5 +30,7 @@ export DECOMP_PATH="${CWD}/dependencies/2decomp_fft" export CMAKE_PREFIX_PATH="${HDF5_PATH}:${FFTW_PATH}:${CMAKE_PREFIX_PATH}" +export MPICH_OFI_STARTUP_CONNECT=1 + # --- Architecture flags --- -export ARCH_OPT_FLAG="-march=znver2" +export ARCH_OPT_FLAG="" From 539538f63b39696f3a681e08c50e06768f04ed59 Mon Sep 17 00:00:00 2001 From: Karim Ali <41688083+karimali5@users.noreply.github.com> Date: Fri, 5 Jun 2026 13:09:27 -0400 Subject: [PATCH 093/114] Example of input file for refine_fields --- .../refine_fields_files/input.dat | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/problems/incompressible/refine_fields_files/input.dat b/problems/incompressible/refine_fields_files/input.dat index e69de29b..5e8a1013 100644 --- a/problems/incompressible/refine_fields_files/input.dat +++ b/problems/incompressible/refine_fields_files/input.dat @@ -0,0 +1,24 @@ +$INPUT +inputdir = "/mnt/lustre/a2fs-work3/work/e773/e773/pounds/PadeOpsSims/INV800-5K" +outputdir = "/mnt/lustre/a2fs-work3/work/e773/e773/pounds/PadeOpsSims/INV800-5K" +nx = 1200 ! Number of points in X +ny = 500 ! Number of points in Y +nz = 800 ! Number of points in Z +Lx = 761.904761904D0 ! Domain Length (appropriate dimesnions/non-dimensionalized) +Ly = 158.7301587D0 ! Domain Width (appropriate dimesnions/non-dimensionalized) +Lz = 63.49206349D0 ! Domain Height (appropriate dimesnions/non-dimensionalized) +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) +refine_x = 2 +refine_y = 2 +refine_z = 1 +inputFile_TID = --- +inputFile_RID = 4 +outputFile_TID = --- +outputFile_RID = 6 +isStratified = .TRUE. +botWall = 3 ! no_slip = 1, slip = 2, wall model = 3 +topWall = 2 ! no_slip = 1, slip = 2, wall model = 3 +botBC_Temp = 0 ! 0: Dirichlet (could be time dependent), 1: Homog. Neumann (no-flux) +topBC_Temp = 0 +/ From 54f5d7c98166181d59a0a54ee3bf63d846f54035 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 5 Jun 2026 18:45:16 -0400 Subject: [PATCH 094/114] fix staggOps --- src/incompressible/staggOps.F90 | 95 ++++++++++++++++++--------------- 1 file changed, 53 insertions(+), 42 deletions(-) diff --git a/src/incompressible/staggOps.F90 b/src/incompressible/staggOps.F90 index f4b3b966..e484cabf 100644 --- a/src/incompressible/staggOps.F90 +++ b/src/incompressible/staggOps.F90 @@ -70,7 +70,7 @@ pure subroutine ddz_E2C_Cmplx(this,fE,dfdzC) real(rkind) :: OneByDz OneByDz = one/this%dz - dfdzC(:,:,1:this%nzC) = fE(:,:,2:this%nzE) - fE(:,:,1:this%nzE-1) + dfdzC(:,:,1:this%nzC_cmplx) = fE(:,:,2:this%nzE_cmplx) - fE(:,:,1:this%nzE_cmplx-1) dfdzC = OneByDz*dfdzC end subroutine @@ -114,11 +114,11 @@ pure subroutine ddz_C2E_Cmplx(this,fC,dfdzE, isTopEven, isBotEven) logical, intent(in) :: isTopEven, isBotEven OneByDz = one/(this%dz) - dfdzE(:,:,2:this%nzE-1) = fC(:,:,2:this%nzC) - fC(:,:,1:this%nzC-1) + dfdzE(:,:,2:this%nzE_cmplx-1) = fC(:,:,2:this%nzC_cmplx) - fC(:,:,1:this%nzC_cmplx-1) if(this%isPeriodic) then - dfdzE(:,:,1) = fC(:,:,1) - fC(:,:,this%nzC) - dfdzE(:,:,this%nzE) = dfdzE(:,:,1) + dfdzE(:,:,1) = fC(:,:,1) - fC(:,:,this%nzC_cmplx) + dfdzE(:,:,this%nzE_cmplx) = dfdzE(:,:,1) else if (isBotEven) then dfdzE(:,:,1) = zero @@ -127,9 +127,9 @@ pure subroutine ddz_C2E_Cmplx(this,fC,dfdzE, isTopEven, isBotEven) end if if (isTopEven) then - dfdzE(:,:,this%nzE) = zero + dfdzE(:,:,this%nzE_cmplx) = zero else - dfdzE(:,:,this%nzE) = -two*fC(:,:,this%nzC) + dfdzE(:,:,this%nzE_cmplx) = -two*fC(:,:,this%nzC_cmplx) end if end if @@ -148,17 +148,28 @@ pure subroutine ddz_C2C_Real(this,fC,dfdzC, isTopEven, isBotEven) dfdzC(:,:,2:this%nzC-1) = fC(:,:,3:this%nzC) - fC(:,:,1:this%nzC-2) dfdzC(:,:,2:this%nzC-1) = OneBy2Dz*dfdzC(:,:,2:this%nzC-1) - if (isBotEven) then - dfdzC(:,:,1) = OneBy2Dz*(fC(:,:,2) - fC(:,:,1)) - else - dfdzC(:,:,1) = OneBy2Dz*(fC(:,:,2) + fC(:,:,1)) - end if + if (this%isBotSided) then + dfdzC(:,:,1) = (-half*fC(:,:,3) + two*fC(:,:,2) - three/two*fC(:,:,1))/this%dz + !dfdzC(:,:,1) = (fC(:,:,2) - fC(:,:,1))/this%dz + else + if (isBotEven) then + dfdzC(:,:,1) = OneBy2Dz*(fC(:,:,2) - fC(:,:,1)) + else + dfdzC(:,:,1) = OneBy2Dz*(fC(:,:,2) + fC(:,:,1)) + end if + end if - if (isTopEven) then - dfdzC(:,:,this%nzC) = OneBy2Dz*(fC(:,:,this%nzC) - fC(:,:,this%nzC-1)) - else - dfdzC(:,:,this%nzC) = -OneBy2Dz*(fC(:,:,this%nzC) + fC(:,:,this%nzC-1)) - end if + if (this%isTopSided) then + dfdzC(:,:,this%nzC) = (half*fC(:,:,this%nzC-2) - two*fC(:,:,this%nzC-1) & + + three/two*fC(:,:,this%nzC))/this%dz + !dfdzC(:,:,this%nzC) = (fC(:,:,this%nzC) - fC(:,:,this%nzC-1))/this%dz + else + if (isTopEven) then + dfdzC(:,:,this%nzC) = OneBy2Dz*(fC(:,:,this%nzC) - fC(:,:,this%nzC-1)) + else + dfdzC(:,:,this%nzC) = -OneBy2Dz*(fC(:,:,this%nzC) + fC(:,:,this%nzC-1)) + end if + end if end subroutine @@ -170,8 +181,8 @@ pure subroutine ddz_C2C_cmplx(this,fC,dfdzC, isTopEven, isBotEven) logical, intent(in) :: isTopEven, isBotEven OneBy2Dz = one/(two*this%dz) - dfdzC(:,:,2:this%nzC-1) = fC(:,:,3:this%nzC) - fC(:,:,1:this%nzC-2) - dfdzC(:,:,2:this%nzC-1) = OneBy2Dz*dfdzC(:,:,2:this%nzC-1) + dfdzC(:,:,2:this%nzC_cmplx-1) = fC(:,:,3:this%nzC_cmplx) - fC(:,:,1:this%nzC_cmplx-2) + dfdzC(:,:,2:this%nzC_cmplx-1) = OneBy2Dz*dfdzC(:,:,2:this%nzC_cmplx-1) if (this%isBotSided) then dfdzC(:,:,1) = (-half*fC(:,:,3) + two*fC(:,:,2) - three/two*fC(:,:,1))/this%dz @@ -185,14 +196,14 @@ pure subroutine ddz_C2C_cmplx(this,fC,dfdzC, isTopEven, isBotEven) end if if (this%isTopSided) then - dfdzC(:,:,this%nzC) = (half*fC(:,:,this%nzC-2) - two*fC(:,:,this%nzC-1) & - + three/two*fC(:,:,this%nzC))/this%dz - !dfdzC(:,:,this%nzC) = (fC(:,:,this%nzC) - fC(:,:,this%nzC-1))/this%dz + dfdzC(:,:,this%nzC_cmplx) = (half*fC(:,:,this%nzC_cmplx-2) - two*fC(:,:,this%nzC_cmplx-1) & + + three/two*fC(:,:,this%nzC_cmplx))/this%dz + !dfdzC(:,:,this%nzC_cmplx) = (fC(:,:,this%nzC_cmplx) - fC(:,:,this%nzC_cmplx-1))/this%dz else if (isTopEven) then - dfdzC(:,:,this%nzC) = OneBy2Dz*(fC(:,:,this%nzC) - fC(:,:,this%nzC-1)) + dfdzC(:,:,this%nzC_cmplx) = OneBy2Dz*(fC(:,:,this%nzC_cmplx) - fC(:,:,this%nzC_cmplx-1)) else - dfdzC(:,:,this%nzC) = -OneBy2Dz*(fC(:,:,this%nzC) + fC(:,:,this%nzC-1)) + dfdzC(:,:,this%nzC_cmplx) = -OneBy2Dz*(fC(:,:,this%nzC_cmplx) + fC(:,:,this%nzC_cmplx-1)) end if end if @@ -207,11 +218,11 @@ pure subroutine d2dz2_C2C_cmplx(this,fC,d2fdz2C, isTopEven, isBotEven) logical, intent(in) :: isTopEven, isBotEven OneByDzSq = one/(this%dz**2) - d2fdz2C(:,:,2:this%nzC-1) = fC(:,:,3:this%nzE) - two*fC(:,:,2:this%nzC-1) + fC(:,:,1:this%nzE-2) + d2fdz2C(:,:,2:this%nzC_cmplx-1) = fC(:,:,3:this%nzC_cmplx) - two*fC(:,:,2:this%nzC_cmplx-1) + fC(:,:,1:this%nzC_cmplx-2) if (this%isPeriodic) then - d2fdz2C(:,:,1) = fC(:,:,2) - two*fC(:,:,1) + fc(:,:,this%nzC) - d2fdz2C(:,:,this%nzC) = fC(:,:,1) - two*fC(:,:,this%nzC) + fc(:,:,this%nzC-1) + d2fdz2C(:,:,1) = fC(:,:,2) - two*fC(:,:,1) + fc(:,:,this%nzC_cmplx) + d2fdz2C(:,:,this%nzC_cmplx) = fC(:,:,1) - two*fC(:,:,this%nzC_cmplx) + fc(:,:,this%nzC_cmplx-1) else if (isBotEven) then d2fdz2C(:,:,1) = fC(:,:,2) - fC(:,:,1) @@ -220,9 +231,9 @@ pure subroutine d2dz2_C2C_cmplx(this,fC,d2fdz2C, isTopEven, isBotEven) end if if (isTopEven) then - d2fdz2C(:,:,this%nzC) = fC(:,:,this%nzC-1) - fC(:,:,this%nzC) + d2fdz2C(:,:,this%nzC_cmplx) = fC(:,:,this%nzC_cmplx-1) - fC(:,:,this%nzC_cmplx) else - d2fdz2C(:,:,this%nzC) = fC(:,:,this%nzC-1) - three*fC(:,:,this%nzC) + d2fdz2C(:,:,this%nzC_cmplx) = fC(:,:,this%nzC_cmplx-1) - three*fC(:,:,this%nzC_cmplx) end if end if @@ -240,7 +251,7 @@ pure subroutine d2dz2_C2C_real(this,fC,d2fdz2C, isTopEven, isBotEven) logical, intent(in) :: isTopEven, isBotEven OneByDzSq = one/(this%dz**2) - d2fdz2C(:,:,2:this%nzC-1) = fC(:,:,3:this%nzE) - two*fC(:,:,2:this%nzC-1) + fC(:,:,1:this%nzE-2) + d2fdz2C(:,:,2:this%nzC-1) = fC(:,:,3:this%nzC) - two*fC(:,:,2:this%nzC-1) + fC(:,:,1:this%nzC-2) if (this%isPeriodic) then d2fdz2C(:,:,1) = fC(:,:,2) - two*fC(:,:,1) + fc(:,:,this%nzC) @@ -271,11 +282,11 @@ pure subroutine d2dz2_E2E_cmplx(this,fE,d2fdz2E, isTopEven, isBotEven) logical, intent(in) :: isTopEven, isBotEven OneByDzSq = one/(this%dz**2) - d2fdz2E(:,:,2:this%nzE-1) = fE(:,:,3:this%nzE) - two*fE(:,:,2:this%nzE-1) + fE(:,:,1:this%nzE-2) + d2fdz2E(:,:,2:this%nzE_cmplx-1) = fE(:,:,3:this%nzE_cmplx) - two*fE(:,:,2:this%nzE_cmplx-1) + fE(:,:,1:this%nzE_cmplx-2) if (this%isPeriodic) then - d2fdz2E(:,:,1) = fE(:,:,2) - two*fE(:,:,1) + fE(:,:,this%nzE-1) - d2fdz2E(:,:,this%nzE) = fE(:,:,2) - two*fE(:,:,this%nzE) + fE(:,:,this%nzE-1) + d2fdz2E(:,:,1) = fE(:,:,2) - two*fE(:,:,1) + fE(:,:,this%nzE_cmplx-1) + d2fdz2E(:,:,this%nzE_cmplx) = fE(:,:,2) - two*fE(:,:,this%nzE_cmplx) + fE(:,:,this%nzE_cmplx-1) else if (isBotEven) then d2fdz2E(:,:,1) = two*(fE(:,:,2) - fE(:,:,1)) @@ -284,9 +295,9 @@ pure subroutine d2dz2_E2E_cmplx(this,fE,d2fdz2E, isTopEven, isBotEven) end if if (isTopEven) then - d2fdz2E(:,:,this%nzE) = two*(fE(:,:,this%nzE-1) - fE(:,:,this%nzE)) + d2fdz2E(:,:,this%nzE_cmplx) = two*(fE(:,:,this%nzE_cmplx-1) - fE(:,:,this%nzE_cmplx)) else - d2fdz2E(:,:,this%nzE) = zero + d2fdz2E(:,:,this%nzE_cmplx) = zero end if end if @@ -403,8 +414,8 @@ pure subroutine InterpZ_Edge2Cell_CMPLX(this, edgeArr, cellArr) complex(rkind), intent(in), dimension(this%nxE_cmplx, this%nyE_cmplx, this%nzE_cmplx) :: edgeArr complex(rkind), intent(out), dimension(this%nxC_cmplx, this%nyC_cmplx, this%nzC_cmplx) :: cellArr - cellArr = edgeArr(1:this%nxC,1:this%nyC,1:this%nzC) - cellArr = cellArr + edgeArr(:,:,2:this%nzC+1) + cellArr = edgeArr(1:this%nxC_cmplx,1:this%nyC_cmplx,1:this%nzC_cmplx) + cellArr = cellArr + edgeArr(:,:,2:this%nzC_cmplx+1) cellArr = half*cellArr end subroutine @@ -415,15 +426,15 @@ pure subroutine InterpZ_Cell2Edge_CMPLX(this, cellArr, edgeArr, BotVal, TopVal) complex(rkind), intent(out), dimension(this%nxE_cmplx, this%nyE_cmplx, this%nzE_cmplx) :: edgeArr complex(rkind), intent(in) :: BotVal, TopVal - edgeArr(:,:,2:this%nzE-1) = cellArr(:,:,1:this%nzC-1) - edgeArr(:,:,2:this%nzE-1) = edgeArr(:,:,2:this%nzE-1) + cellArr(:,:,2:this%nzC) - edgeArr(:,:,2:this%nzE-1) = half*edgeArr(:,:,2:this%nzE-1) + edgeArr(:,:,2:this%nzE_cmplx-1) = cellArr(:,:,1:this%nzC_cmplx-1) + edgeArr(:,:,2:this%nzE_cmplx-1) = edgeArr(:,:,2:this%nzE_cmplx-1) + cellArr(:,:,2:this%nzC_cmplx) + edgeArr(:,:,2:this%nzE_cmplx-1) = half*edgeArr(:,:,2:this%nzE_cmplx-1) if (this%isPeriodic) then - edgeArr(:,:,1) = half*(cellArr(:,:,1) + cellArr(:,:,this%nzC)) - edgeArr(:,:,this%nzE) = half*(cellArr(:,:,1) + cellArr(:,:,this%nzC)) + edgeArr(:,:,1) = half*(cellArr(:,:,1) + cellArr(:,:,this%nzC_cmplx)) + edgeArr(:,:,this%nzE_cmplx) = half*(cellArr(:,:,1) + cellArr(:,:,this%nzC_cmplx)) else - edgeArr(:,:,this%nzE) = TopVal + edgeArr(:,:,this%nzE_cmplx) = TopVal edgeArr(:,:,1 ) = BotVal end if end subroutine From b5eec11a5789ae57c1adefc72d3b4972ec8b35c1 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 5 Jun 2026 19:12:12 -0400 Subject: [PATCH 095/114] Preserve existing computeFbody state during SGS initialization unless dynamic procedure overrides it. --- src/incompressible/sgs_models/init_destroy_sgs_igrid.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incompressible/sgs_models/init_destroy_sgs_igrid.F90 b/src/incompressible/sgs_models/init_destroy_sgs_igrid.F90 index dbc2e5a3..91fe85a7 100644 --- a/src/incompressible/sgs_models/init_destroy_sgs_igrid.F90 +++ b/src/incompressible/sgs_models/init_destroy_sgs_igrid.F90 @@ -52,7 +52,7 @@ subroutine init(this, gpC, gpE, spectC, spectE, dx, dy, dz, inputfile, zMeshE, z character(len=*), intent(in) :: inputfile real(rkind), dimension(:), intent(in) :: zMeshE, zMeshC real(rkind), dimension(:,:,:), intent(in), target :: fBody_x, fBody_y, fBody_z - logical, intent(out) :: computeFbody + logical, intent(inout) :: computeFbody real(rkind), dimension(:,:,:,:), intent(in), target :: rbuffxC, rbuffyE, rbuffzE, rbuffyC, rbuffzC complex(rkind), dimension(:,:,:,:), intent(in), target :: cbuffyC, cbuffzC, cbuffyE, cbuffzE type(Pade6stagg), target, intent(in) :: PadeDer From 937c30b07f85dd81c46e4675afe2410d17838c4c Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 5 Jun 2026 19:14:03 -0400 Subject: [PATCH 096/114] Fix periodic fd02 cleanup and complex-pencil indexing in PadeDerOps. --- src/incompressible/PadeDerOps.F90 | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/incompressible/PadeDerOps.F90 b/src/incompressible/PadeDerOps.F90 index dd6e22f6..45068c18 100644 --- a/src/incompressible/PadeDerOps.F90 +++ b/src/incompressible/PadeDerOps.F90 @@ -135,9 +135,11 @@ subroutine destroy(this) class(Pade6stagg), intent(inout) :: this if (this%isPeriodic) then - if (this%scheme == cd06 .OR. this%scheme == fd02) then + if (this%scheme == cd06) then Call this%derPeriodic%destroy() Deallocate(this%derPeriodic) + else if (this%scheme == fd02) then + call this%fd02_periodic%destroy() else if (this%scheme == fourierColl) then nullify(this%spectC) end if @@ -984,10 +986,10 @@ subroutine interpz_C2E_cmplx(this,input,output,bot,top) call this%fd02_nn%interpZ_Cell2Edge(input,output,zeroC,zeroC) elseif (top == 0) then call this%fd02_nn%interpZ_Cell2Edge(input,output,zeroC,zeroC) - output(:,:,this%gp%zsz(3)+1) = two*input(:,:,this%gp%zsz(3)) - output(:,:,this%gp%zsz(3)) + output(:,:,this%sp_gp%zsz(3)+1) = two*input(:,:,this%sp_gp%zsz(3)) - output(:,:,this%sp_gp%zsz(3)) elseif (top == 1) then call this%fd02_nn%interpZ_Cell2Edge(input,output,zeroC,zeroC) - output(:,:,this%gp%zsz(3)+1) = input(:,:,this%gp%zsz(3)) + output(:,:,this%sp_gp%zsz(3)+1) = input(:,:,this%sp_gp%zsz(3)) end if case(0) ! bottom = sided if (top == -1) then @@ -996,11 +998,11 @@ subroutine interpz_C2E_cmplx(this,input,output,bot,top) elseif (top == 0) then call this%fd02_nn%interpZ_Cell2Edge(input,output,zeroC,zeroC) output(:,:,1) = two*input(:,:,1) - output(:,:,2) - output(:,:,this%gp%zsz(3)+1) = two*input(:,:,this%gp%zsz(3)) - output(:,:,this%gp%zsz(3)) + output(:,:,this%sp_gp%zsz(3)+1) = two*input(:,:,this%sp_gp%zsz(3)) - output(:,:,this%sp_gp%zsz(3)) elseif (top == 1) then call this%fd02_nn%interpZ_Cell2Edge(input,output,zeroC,zeroC) output(:,:,1) = two*input(:,:,1) - output(:,:,2) - output(:,:,this%gp%zsz(3)+1) = input(:,:,this%gp%zsz(3)) + output(:,:,this%sp_gp%zsz(3)+1) = input(:,:,this%sp_gp%zsz(3)) end if case(1) ! bottom = even if (top == -1) then @@ -1009,11 +1011,11 @@ subroutine interpz_C2E_cmplx(this,input,output,bot,top) elseif (top == 0) then call this%fd02_nn%interpZ_Cell2Edge(input,output,zeroC,zeroC) output(:,:,1) = input(:,:,1) - output(:,:,this%gp%zsz(3)+1) = two*input(:,:,this%gp%zsz(3)) - output(:,:,this%gp%zsz(3)) + output(:,:,this%sp_gp%zsz(3)+1) = two*input(:,:,this%sp_gp%zsz(3)) - output(:,:,this%sp_gp%zsz(3)) elseif (top == 1) then call this%fd02_nn%interpZ_Cell2Edge(input,output,zeroC,zeroC) output(:,:,1) = input(:,:,1) - output(:,:,this%gp%zsz(3)+1) = input(:,:,this%gp%zsz(3)) + output(:,:,this%sp_gp%zsz(3)+1) = input(:,:,this%sp_gp%zsz(3)) end if end select case (cd06) From ca04aa107f9535b3b5a3656af508e01141123507 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sat, 6 Jun 2026 00:16:22 +0100 Subject: [PATCH 097/114] avoid using a REAL in a do size with GNU --- src/incompressible/actuatorDisk_filtered.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index 72d5b2b1..c7d0bff8 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -408,7 +408,7 @@ subroutine get_R(this) coef = -6.d0 / this%delta**2 C1 = (6.d0/pi/this%delta**2)**(three/two) - do k = 1, this%npts + do k = 1, int(this%npts) ! bounds in physical space xmin = xi(k) - rcut xmax = xi(k) + rcut From 3f19d5413c1f98d3b940fb5971b05ff23b804ead Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sat, 6 Jun 2026 00:16:44 +0100 Subject: [PATCH 098/114] Update GNU build options --- CMakeLists.txt | 7 ++++++- setup/SetupEnv_Archer2.sh | 3 +-- src/CMakeLists.txt | 24 +++++++++++------------- 3 files changed, 18 insertions(+), 16 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index ed3207ca..6e9f9a6a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -73,7 +73,12 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") 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") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Wall -Wconversion -Wsurprising -Wextra -Waliasing \ + -ffree-form -ffree-line-length-none -ffast-math ${OPTFLAG} \ + -fopenmp -fallow-argument-mismatch \ + -finit-local-zero \ + ") + # -finit-integer=0 -finit-real=zero -finit-local-zero -finit-derived elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) 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() diff --git a/setup/SetupEnv_Archer2.sh b/setup/SetupEnv_Archer2.sh index 6566358e..4dab04f2 100644 --- a/setup/SetupEnv_Archer2.sh +++ b/setup/SetupEnv_Archer2.sh @@ -28,8 +28,7 @@ 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}:${CMAKE_PREFIX_PATH}" - +export CMAKE_PREFIX_PATH="${HDF5_PATH}:${FFTW_PATH}${CMAKE_PREFIX_PATH:+:${CMAKE_PREFIX_PATH}}" export MPICH_OFI_STARTUP_CONNECT=1 # --- Architecture flags --- diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index b976566f..7ee06568 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -26,23 +26,21 @@ 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) elseif( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD" ) 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) +elseif( CMAKE_Fortran_COMPILER_ID MATCHES "GNU" ) + target_link_libraries(PadeOps + fftw3 + 2decomp_fft + $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu_mpi.so + ${HDF5_LIBRARY_PATH}/libhdf5hl_fortran_parallel_gnu_91.so + ${HDF5_LIBRARY_PATH}/libhdf5_hl_parallel_gnu_91.so + ${HDF5_LIBRARY_PATH}/libhdf5_fortran_parallel_gnu_91.so + ${HDF5_LIBRARY_PATH}/libhdf5_parallel_gnu_91.so + -lz -ldl -lm -Wl,-rpath -Wl,${HDF5_LIBRARY_PATH} + ) else() # 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 ${MPI_LIBRARIES}) -elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - # 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 ${MPI_LIBRARIES}) -elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD") - target_link_libraries(PadeOps fftw3 2decomp_fft ${MPI_LIBRARIES}) -endif() if (MPI_Fortran_COMPILER_FLAGS) set_target_properties(PadeOps PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") From 879c5eef2a861a381aa05127dcf6ca347c1f0270 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 5 Jun 2026 19:17:43 -0400 Subject: [PATCH 099/114] Initialize WriteTurbineForce --- src/incompressible/turbineMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/incompressible/turbineMod.F90 b/src/incompressible/turbineMod.F90 index 36e12f35..74c75a99 100644 --- a/src/incompressible/turbineMod.F90 +++ b/src/incompressible/turbineMod.F90 @@ -176,7 +176,7 @@ subroutine init(this, inputFile, gpC, gpE, spectC, spectE, cbuffyC, cbuffYE, cbu real(rkind), intent(in) :: dx, dy, dz logical :: useWindTurbines = .TRUE., useDynamicYaw = .FALSE., useDynamicTurbine = .FALSE. real(rkind) :: xyzPads(6) - logical :: ADM = .TRUE., WriteTurbineForce ! .FALSE. implies ALM + logical :: ADM = .TRUE., WriteTurbineForce=.FALSE. ! .FALSE. implies ALM ! Dynamic yaw stuff character(len=clen) :: inputDirDyaw = "/home1/05294/mhowland/dynamicYawFiles/dynamicYaw.inp" real(rkind), dimension(:), allocatable :: xLoc, yLoc From 2ac2697a320ec270ec77e07e5eebd488e367eba4 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sun, 7 Jun 2026 22:47:42 -0400 Subject: [PATCH 100/114] Fix order of restarting MCG --- .../budget_time_avg_deficit_compact.F90 | 50 +++++++++++++------ 1 file changed, 35 insertions(+), 15 deletions(-) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index a18bccb5..83166cb1 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -111,10 +111,13 @@ subroutine init(this, pre_budget, primary_inputfile, prim_igrid_sim) this%tidx_compute = tidx_compute this%tidx_budget_start = tidx_budget_start this%time_budget_start = time_budget_start + ! Turbine-force budget terms are intentionally disabled in this compact + ! module. Re-enable this assignment together with terms 20-21 in Budget 3. !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 + ! Time weighting is intentionally disabled until the precursor and + ! compact-deficit accumulators use the same weighting convention. !this%time_weighted_average = use_time_weighted_average this%time_weighted_average = .False. this%forceDump = .false. @@ -258,6 +261,8 @@ subroutine updateBudget(this) 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 + ! All arrays remain in raw-sum mode between dumps. Assemble lower-order + ! moments before higher-order moments so they cover identical samples. if(this%doMCG) call this%AssembleMCG() if(this%do_budget0) call this%AssembleBudget0() if(this%do_budget1) call this%AssembleBudget1() @@ -281,7 +286,10 @@ subroutine DumpBudget(this) ! Buffers 1 and 2 are used locally inside getProductOfMeans buffer => this%prim_igrid_sim%rbuffxC(:,:,:,4) - ! Convert assembled budgets to mean instead of sum + ! Temporarily convert raw sums to means. getProductOfMeans assumes every + ! compact and precursor field used below is in mean mode. + ! The precursor counter is private, so matching sample counts are a + ! required configuration invariant. 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 @@ -347,7 +355,8 @@ subroutine DumpBudget(this) end if end if - ! Get the product of means. buffer is dealiased inside getProductOfMeans + ! Convert raw moments to fluctuation moments only in the + ! output buffer; keep the stored arrays as raw moments. call this%getProductOfMeans(budgetid, idx, buffer) ! Remove product of means. The original budget is not impacted @@ -359,7 +368,7 @@ subroutine DumpBudget(this) end if end do - ! Return to summing + ! Restore raw-sum mode so future samples can be accumulated directly. 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 @@ -372,6 +381,9 @@ subroutine DumpBudget(this) ! ---------------------- Mean Cell Gradients (MCG) ------------------------ subroutine AssembleMCG(this) class(budgets_time_avg_deficit_compact), intent(inout) :: this + ! Components 1:9 are grad(delta u), ordered + ! (du/dx,du/dy,du/dz,dv/dx,...,dw/dz). Components 10:18 use + ! the same ordering for the precursor velocity. 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 @@ -887,6 +899,10 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) bf2 => this%prim_igrid_sim%rbuffxC(:,:,:,2) buffer = 0.d0 + ! Return the complete mean-field correction to subtract from the raw + ! moment. For triple moments this groups the three negative pair/mean + ! products and the -2*mean(a)*mean(b)*mean(c) quantity; subtracting + ! buffer therefore produces the required +2 triple-mean contribution. if(budgetid.eq.1)then select case(idx) case(1) @@ -1300,13 +1316,14 @@ subroutine RestartBudget(this, dir, rid, tid, cid) 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 + ! The precursor budget must already be restarted and in raw-sum mode, + ! with the same historical sample count as this compact budget. this%pre_budget%budget_0 = this%pre_budget%budget_0/totalWeight this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight - ! Budget 0 + ! Restart files contain means/fluctuation moments. Keep all fields in + ! mean mode while rebuilding the raw moments used for accumulation. + ! Budget 0 if(this%do_budget0)then do idx = 1, this%size_budget_0 if((idx.eq.15).or.(idx.eq.16))then @@ -1320,6 +1337,10 @@ subroutine RestartBudget(this, dir, rid, tid, cid) end do end if + ! MCG is not written to file. Reconstruct its mean values before + ! restoring Budget 2 or 3, whose corrections depend on these gradients. + if(this%doMCG) call this%restartMCG() + ! Budget 1 if(this%do_budget1)then do idx = 1, this%size_budget_1 @@ -1351,20 +1372,17 @@ subroutine RestartBudget(this, dir, rid, tid, cid) end do end if - ! Return to summing + ! Convert every reconstructed raw mean back to its historical sum. + ! restartMCG produced mean gradients above, so MCG needs the same + ! multiplication as the stored budget arrays. 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 - ! 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 @@ -1393,6 +1411,8 @@ subroutine restartMCG(this) dwdy_pre => this%MCG(:,:,:,17) dwdz_pre => this%MCG(:,:,:,18) + ! Inputs must be in mean mode. The resulting MCG fields are mean + ! gradients and are converted to raw sums by RestartBudget afterward. 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) From bdf9c26097d0b63e26a174fd2b776d9ac1c55855 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 8 Jun 2026 01:13:18 -0400 Subject: [PATCH 101/114] AI sweep and cleanup --- .../initialize.F90 | 36 ++++++-- .../temporalHook.F90 | 19 +++-- src/incompressible/PadePoisson.F90 | 49 ++++++++--- src/incompressible/actuatorDisk_filtered.F90 | 19 ++++- src/incompressible/angleContol.F90 | 26 ++++-- .../budget_time_avg_deficit_compact.F90 | 3 + src/incompressible/forcingIsotropic.F90 | 35 ++++++-- src/incompressible/fringemethod.F90 | 47 +++++++++-- src/incompressible/igrid.F90 | 31 +++++-- src/incompressible/igrid_files/io_stuff.F90 | 4 + .../igrid_files/prep_wrapup_stuff.F90 | 42 ++++++---- src/incompressible/igrid_files/rhs_stuff.F90 | 3 +- .../igrid_files/stats_stuff.F90 | 5 +- .../igrid_files/timestepping_stuff.F90 | 54 ++++++++---- src/incompressible/igrid_operators.F90 | 32 +++++-- .../igrid_operators_periodic.F90 | 14 +++- src/incompressible/interpolator.F90 | 55 +++++++----- src/incompressible/scalar_igrid.F90 | 22 +++-- src/incompressible/sgs_models/AMD.F90 | 3 +- .../sgs_models/init_destroy_sgs_igrid.F90 | 28 ++++++- .../sgs_models/scalar_bounding.F90 | 9 +- src/incompressible/sgs_models/wallmodel.F90 | 83 ++++++++++++++----- src/incompressible/spectral.F90 | 39 +++++++-- src/incompressible/staggOps.F90 | 7 ++ src/incompressible/turbineMod.F90 | 23 ++++- 25 files changed, 527 insertions(+), 161 deletions(-) diff --git a/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 index ca3396a7..161ff2b1 100644 --- a/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 +++ b/problems/turbines/pre_conc_compact_budgets_files/initialize.F90 @@ -23,8 +23,9 @@ subroutine compute_xdim_udim(inputfile) character(len=*), intent(in) :: inputfile character(len=:), allocatable :: buffer character(len=clen) :: line - real(rkind) :: Ro, Fr - integer :: iunit + real(rkind) :: Ro = 1._rkind, Fr = 1._rkind + integer :: iunit, ios + character(len=clen) :: adjusted namelist /PHYSICS/Ro, Fr ! ignore all other variables @@ -32,12 +33,21 @@ subroutine compute_xdim_udim(inputfile) ! 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') + open(unit=10, file=trim(inputfile), form='formatted', status='old', action='read', iostat=ios) + if (ios /= 0) then + call message(0, "WARNING: could not open physics input; using defaults Ro=Fr=1.") + xdim = g * (Fr / Ro / omega)**2 + udim = g * Fr**2 / omega / Ro + timeDim = xdim/udim + return + end if 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 + adjusted = adjustl(line) + ! Accept both "Fr = ..." and compact "Fr=..." namelist syntax. + if (index(adjusted, "Fr ") == 1 .or. index(adjusted, "Fr=") == 1 .or. & + index(adjusted, "Ro ") == 1 .or. index(adjusted, "Ro=") == 1) then ! strip comments: if (index(line, "!") > 0) line = line(:index(line, "!")-1) buffer = buffer // trim(adjustl(line)) // new_line('a') @@ -46,7 +56,12 @@ subroutine compute_xdim_udim(inputfile) buffer = buffer // "/" // new_line('a') close(10) - read(buffer, NML=PHYSICS) + read(buffer, NML=PHYSICS, iostat=ios) + if (ios /= 0) then + call message(0, "WARNING: could not parse Ro/Fr; using defaults Ro=Fr=1.") + Ro = 1._rkind + Fr = 1._rkind + end if xdim = g * (Fr / Ro / omega)**2 udim = g * Fr**2 / omega / Ro @@ -164,7 +179,7 @@ subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) implicit none character(len=*), intent(in) :: inputfile - real(rkind), intent(out) :: wTh_surf + real(rkind), intent(inout) :: 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 @@ -174,7 +189,10 @@ subroutine setInhomogeneousNeumannBC_Temp(inputfile, wTh_surf) read(unit=ioUnit, NML=PROBLEM_INPUT) close(ioUnit) - ! Do nothing since temperature BC is dirichlet + ! igrid passes the current simulation time in this argument so hooks may + ! prescribe a time-dependent flux. This problem defines no such flux; + ! retaining the input would incorrectly use time as a heat flux. + wTh_surf = zero end subroutine subroutine setDirichletBC_Temp(inputfile, Tsurf, dTsurf_dt) @@ -349,4 +367,4 @@ subroutine setScalar_source(decompC, inpDirectory, mesh, scalar_id, scalarSource real(rkind), dimension(:,:,:), intent(out) :: scalarSource scalarSource = 0.d0 -end subroutine \ No newline at end of file +end subroutine diff --git a/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 b/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 index 784529eb..32963b1c 100644 --- a/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 +++ b/problems/turbines/pre_conc_compact_budgets_files/temporalHook.F90 @@ -23,7 +23,7 @@ subroutine doTemporalStuff(gp, simid) real(rkind) :: global_min, global_max, maxu if (mod(gp%step,nt_print2screen) == 0) then - maxDiv = maxval(gp%divergence) + maxDiv = maxval(abs(gp%divergence)) DomMaxDiv = p_maxval(maxDiv) select case (simid) case (1) @@ -40,7 +40,7 @@ subroutine doTemporalStuff(gp, simid) global_min = p_minval(minval(gp%u)) global_max = p_maxval(maxval(gp%u)) - maxu = global_max + maxu = max(abs(global_min), abs(global_max)) call message_min_max(1,"Bounds for u:", global_min, global_max) global_min = p_minval(minval(gp%v)) @@ -68,17 +68,26 @@ subroutine doTemporalStuff(gp, simid) call message(0,"------------------------------------------") if (simid == 1) then if (allocated(gp%scalars)) then + if (size(gp%scalars) < 3) then + call message(1, "Fewer than three passive scalars are allocated; printing available fields only.") + end if + end if + if (allocated(gp%scalars)) then + if (size(gp%scalars) >= 1) 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) - + end if + if (size(gp%scalars) >= 2) then 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) - + end if + if (size(gp%scalars) >= 3) then 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 end if if (maxu>4.) then @@ -87,7 +96,7 @@ subroutine doTemporalStuff(gp, simid) 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 gp%dumpFullField(gp%pressure, "prss") call GracefulExit("u-velocity has blown up",1) end if elseif (simid == 2) then diff --git a/src/incompressible/PadePoisson.F90 b/src/incompressible/PadePoisson.F90 index eca9bd20..e131b5c4 100644 --- a/src/incompressible/PadePoisson.F90 +++ b/src/incompressible/PadePoisson.F90 @@ -52,8 +52,8 @@ module PadePoissonMod complex(rkind), dimension(:,:,:), allocatable :: dwdzHATz_Periodic, div real(rkind) :: mfact - integer(kind=8) :: plan_c2c_fwd_z - integer(kind=8) :: plan_c2c_bwd_z + integer(kind=8) :: plan_c2c_fwd_z = 0 + integer(kind=8) :: plan_c2c_bwd_z = 0 type(decomp_info), pointer :: gpC logical :: computeStokesPressure = .false. @@ -647,16 +647,45 @@ subroutine PressureProjection(this, uhat, vhat, what) subroutine destroy(this) class(Padepoisson), intent(inout) :: this - call dfftw_destroy_plan (this%plan_c2c_fwd_z) - call dfftw_destroy_plan (this%plan_c2c_bwd_z) - deallocate(this%kradsq_inv) - deallocate(this%f2dext, this%wext) - deallocate(this%k3modcm, this%k3modcp) - deallocate(this%f2d, this%f2dy, this%w2) + ! Periodic-z initialization does not create the extended-domain plans + ! or arrays, so every optional resource must be tested independently. + if ((.not. this%PeriodicInZ) .and. this%plan_c2c_fwd_z /= 0) then + call dfftw_destroy_plan (this%plan_c2c_fwd_z) + end if + if ((.not. this%PeriodicInZ) .and. this%plan_c2c_bwd_z /= 0) then + call dfftw_destroy_plan (this%plan_c2c_bwd_z) + end if + if (allocated(this%kradsq_inv)) deallocate(this%kradsq_inv) + if (allocated(this%f2dext)) deallocate(this%f2dext) + if (allocated(this%wext)) deallocate(this%wext) + if (allocated(this%k3modcm)) deallocate(this%k3modcm) + if (allocated(this%k3modcp)) deallocate(this%k3modcp) + if (allocated(this%f2d)) deallocate(this%f2d) + if (allocated(this%f2dy)) deallocate(this%f2dy) + if (allocated(this%w2)) deallocate(this%w2) + if (allocated(this%dwdzHATz_Periodic)) deallocate(this%dwdzHATz_Periodic) if (allocated(this%phat_z1)) deallocate(this%phat_z1) if (allocated(this%phat_z2)) deallocate(this%phat_z2) - nullify( this%sp_gp, this%sp_gpE, this%sp, this%spE) - deallocate(this%derZ) + if (allocated(this%lambda)) deallocate(this%lambda) + if (allocated(this%k1inZ)) deallocate(this%k1inZ) + if (allocated(this%k2inZ)) deallocate(this%k2inZ) + if (allocated(this%chat)) deallocate(this%chat) + if (allocated(this%phat)) deallocate(this%phat) + if (allocated(this%dpdzhat)) deallocate(this%dpdzhat) + if (allocated(this%denFact)) deallocate(this%denFact) + if (allocated(this%sinh_top)) deallocate(this%sinh_top) + if (allocated(this%cosh_top)) deallocate(this%cosh_top) + if (allocated(this%sinh_bot)) deallocate(this%sinh_bot) + if (allocated(this%cosh_bot)) deallocate(this%cosh_bot) + if (allocated(this%zCell)) deallocate(this%zCell) + if (allocated(this%zEdge)) deallocate(this%zEdge) + if (allocated(this%uhatinZ)) deallocate(this%uhatinZ) + if (allocated(this%vhatinZ)) deallocate(this%vhatinZ) + if (allocated(this%whatinZ)) deallocate(this%whatinZ) + if (allocated(this%div)) deallocate(this%div) + nullify(this%k1_2d, this%k2_2d) + nullify(this%sp_gp, this%sp_gpE, this%sp, this%spE, this%gpC, this%derivZ) + if (allocated(this%derZ)) deallocate(this%derZ) end subroutine subroutine GetStokesPressure(this,uhat,vhat,what) diff --git a/src/incompressible/actuatorDisk_filtered.F90 b/src/incompressible/actuatorDisk_filtered.F90 index c7d0bff8..0a67dd89 100644 --- a/src/incompressible/actuatorDisk_filtered.F90 +++ b/src/incompressible/actuatorDisk_filtered.F90 @@ -132,6 +132,13 @@ subroutine init(this, inputDir, ActuatorDisk_ID, xG, yG, zG, dx, dy, dz) ! use the turbine diameter to dimensionalize the filterwidth this%delta = filterWidth * this%diam endif + if ((this%diam <= zero) .or. (this%delta <= zero) .or. & + (this%upsample_fact <= zero)) then + call GracefulExit("Filtered ADM requires positive diameter, filter width, and upsample factor.", 123) + end if + if (quickDecomp .and. this%thick <= zero) then + call GracefulExit("Filtered ADM quick decomposition requires positive thickness.", 123) + end if ! Thickness is only used if quickDecomp = .TRUE. this%quickDecomp = quickDecomp if (quickDecomp) then @@ -447,7 +454,7 @@ 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 + real(rkind) :: smax, kernelIntegral this%scalarsource = zero if ((abs(this%yaw) < 1e-3) .and. (abs(this%tilt) < 1e-3)) then @@ -483,10 +490,14 @@ subroutine get_weights(this) ! normalize so R integrates to 1 exactly if(this%Am_I_Split)then - this%scalarsource = this%scalarsource / (p_sum(this%scalarsource, this%mycomm)*this%dV) + kernelIntegral = p_sum(this%scalarsource, this%mycomm)*this%dV else - this%scalarsource = this%scalarsource / (SUM(this%scalarsource)*this%dV) - end if + kernelIntegral = SUM(this%scalarsource)*this%dV + end if + if (kernelIntegral <= tiny(one)) then + call GracefulExit("Filtered ADM kernel has zero integral on its active communicator.", 123) + end if + this%scalarsource = this%scalarsource/kernelIntegral end subroutine ! sample a circle with points spaced dx, dy apart and centered at xcen, ycen diff --git a/src/incompressible/angleContol.F90 b/src/incompressible/angleContol.F90 index 72370ba4..6e1a025a 100644 --- a/src/incompressible/angleContol.F90 +++ b/src/incompressible/angleContol.F90 @@ -2,8 +2,8 @@ module angleControl use kind_parameters, only: rkind, clen use decomp_2d use spectralMod, only: spectral - use exits, only: message - use constants, only: pi + use exits, only: message, gracefulExit + use constants, only: pi, zero, one use reductions, only: p_sum implicit none @@ -64,6 +64,12 @@ subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, p !real(rkind), intent(out) :: totalAngle nx = this%gpC%xsz(1) ny = this%gpC%ysz(2) + ! Define every output even for dummy controllers and non-triggered steps. + phi_n = this%phi_n + wFilt_n = this%wFilt_n + deltaGalpha = this%deltaGalpha + z_hub = this%z_ref + trigger = zero ! Only do the following if it is not a dummy controller if (.NOT. dumcntl) then @@ -102,6 +108,9 @@ subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, p this%phi = phi_n ! First order time filter !wFilt_n = (dt*wControl_n + dt*this%wControl + this%wFilt*(2.d0*this%sigma - dt)) / (this%sigma*2.d0 + dt) + if (abs(this%sigma + dt) <= tiny(one)) then + call gracefulExit("Controller sigma + dt must be nonzero.", 123) + end if wFilt_n = (1.d0 - (dt/(this%sigma+dt))) * this%wFilt + dt/(this%sigma + dt) * wControl_n this%wFilt = wFilt_n this%wFilt_n = this%alpha * wFilt_n + this%beta * (phi_n - this%phi_ref) @@ -110,7 +119,10 @@ subroutine update_RHS_control(this, dt, urhs, vrhs, wrhs, uC, vC, newTimestep, p ! Control geostrophic velocity directly wControl_n = (phi_n - this%phi) this%phi = phi_n - deltaGalpha = (1.d0 - (dt/(this%sigma+dt))) * this%wFilt + dt/(this%sigma + dt) * wControl_n + if (abs(this%sigma + dt) <= tiny(one)) then + call gracefulExit("Controller sigma + dt must be nonzero.", 123) + end if + deltaGalpha = (1.d0 - (dt/(this%sigma+dt))) * this%wFilt + dt/(this%sigma + dt) * wControl_n this%wFilt = deltaGalpha deltaGalpha = this%alpha * deltaGalpha + this%beta * (phi_n - this%phi_ref) deltaGalpha = deltaGalpha * pi / 180.d0 @@ -131,8 +143,12 @@ 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 + ! Type 1 returns the frame-angle increment. Type 2 already computed + ! a geostrophic-angle increment above and must not be overwritten. + if (this%controlType == 1) then + deltaGalpha = 2.d0 * this%wFilt_n * dt * 180.d0 / pi + this%deltaGalpha = deltaGalpha + end if end subroutine diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index 83166cb1..f506d101 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -109,6 +109,9 @@ subroutine init(this, pre_budget, primary_inputfile, prim_igrid_sim) this%do_budgets = do_budgets this%tidx_dump = tidx_dump this%tidx_compute = tidx_compute + if ((this%tidx_compute <= 0) .or. (this%tidx_dump <= 0)) then + call GracefulExit("Compact-budget compute and dump frequencies must be positive.", 123) + end if this%tidx_budget_start = tidx_budget_start this%time_budget_start = time_budget_start ! Turbine-force budget terms are intentionally disabled in this compact diff --git a/src/incompressible/forcingIsotropic.F90 b/src/incompressible/forcingIsotropic.F90 index 73251088..69139313 100644 --- a/src/incompressible/forcingIsotropic.F90 +++ b/src/incompressible/forcingIsotropic.F90 @@ -73,10 +73,17 @@ subroutine init(this, inputfile, sp_gpC, sp_gpE, spectC, cbuffyE, cbuffyC, cbuff this%DomAspectRatioZ = spectC%nz_g / nxmin this%A_force = A_force + if (useLinearForcing .and. abs(A_force) <= tiny(one)) then + call GracefulExit("HIT linear-forcing amplitude A_force must be nonzero.", 111) + end if this%kmin = kmin this%kmax = kmax this%EpsAmplitude = EpsAmplitude this%Nwaves = Nwaves + this%alpha_t = alpha_t + if ((this%alpha_t < zero) .or. (this%alpha_t > one)) then + call GracefulExit("HIT forcing alpha_t must lie in [0,1].", 111) + end if this%sp_gpC => sp_gpC this%sp_gpE => sp_gpE @@ -155,13 +162,21 @@ subroutine pick_random_wavenumbers(this) subroutine destroy(this) class(HIT_shell_forcing), intent(inout) :: this - deallocate(this%uhat, this%vhat, this%what) - nullify(this%fxhat, this%fyhat, this%fzhat, this%cbuffzE) - if (nrank == 0) then - deallocate(this%kabs_sample, this%theta_sample, this%zeta_sample) - end if - deallocate(this%wave_x, this%wave_y, this%wave_z) - nullify(this%sp_gpC, this%spectC) + if (allocated(this%uhat)) deallocate(this%uhat) + if (allocated(this%vhat)) deallocate(this%vhat) + if (allocated(this%what)) deallocate(this%what) + if (allocated(this%fxhat_old)) deallocate(this%fxhat_old) + if (allocated(this%fyhat_old)) deallocate(this%fyhat_old) + if (allocated(this%fzhat_old)) deallocate(this%fzhat_old) + if (allocated(this%kabs_sample)) deallocate(this%kabs_sample) + if (allocated(this%theta_sample)) deallocate(this%theta_sample) + if (allocated(this%zeta_sample)) deallocate(this%zeta_sample) + if (allocated(this%tmpModes)) deallocate(this%tmpModes) + if (allocated(this%wave_x)) deallocate(this%wave_x) + if (allocated(this%wave_y)) deallocate(this%wave_y) + if (allocated(this%wave_z)) deallocate(this%wave_z) + nullify(this%fxhat, this%fyhat, this%fzhat, this%cbuffzE, this%cbuffyE, this%cbuffyC) + nullify(this%sp_gpC, this%sp_gpE, this%spectC) end subroutine @@ -232,6 +247,7 @@ subroutine embed_forcing_mode(this, kx, ky, kz) gid_x = this%DomAspectRatioX*kx + 1 gid_y = this%DomAspectRatioY*ky + 1 gid_z = this%DomAspectRatioZ*kz + 1 + if ((gid_z < 1) .or. (gid_z > this%sp_gpC%zsz(3))) return ! Get local ID of the mode and conjugate lid_x = gid_x - this%sp_gpC%zst(1) + 1 @@ -311,7 +327,10 @@ subroutine getRHS_HITforcing(this, urhs_xy, vrhs_xy, wrhs_xy, uhat_xy, vhat_xy, this%fxhat_old = this%fxhat this%fyhat_old = this%fyhat this%fzhat_old = this%fzhat - end if + ! Only the first generated forcing field bypasses temporal + ! blending; later timesteps retain the previous field. + this%firstCall = .false. + end if ! STEP 3b: Time filter this%fxhat = this%alpha_t*this%fxhat + (1.d0 - this%alpha_t)*this%fxhat_old diff --git a/src/incompressible/fringemethod.F90 b/src/incompressible/fringemethod.F90 index 6e1423d7..b66d6c06 100644 --- a/src/incompressible/fringemethod.F90 +++ b/src/incompressible/fringemethod.F90 @@ -37,7 +37,8 @@ module fringeMethod procedure :: getLambdaFact procedure :: link_igrid_pointers procedure :: update_fringe_shifts - procedure :: phaseshift + procedure, private :: phaseshift_cell + procedure, private :: phaseshift_edge end type contains @@ -403,9 +404,11 @@ subroutine init(this, inputfile, dx, x, dy, y, spectC, spectE, gpC, gpE, rbuffxC subroutine link_igrid_pointers(this, uhat, vhat, what, That) class(fringe), intent(inout) :: this - complex(rkind), dimension(this%gpC%ysz(1),this%gpC%ysz(2),this%gpC%ysz(3)), intent(in), target :: uhat, vhat - complex(rkind), dimension(this%gpE%ysz(1),this%gpE%ysz(2),this%gpE%ysz(3)), intent(in), target :: what - complex(rkind), dimension(this%gpC%ysz(1),this%gpC%ysz(2),this%gpC%ysz(3)), intent(in), optional, target :: That + ! These are Fourier-space y-pencil arrays. Their x extent is nx/2+1, + ! so the physical gpC/gpE descriptors are not shape-compatible. + complex(rkind), dimension(this%sp_gpC%ysz(1),this%sp_gpC%ysz(2),this%sp_gpC%ysz(3)), intent(in), target :: uhat, vhat + complex(rkind), dimension(this%sp_gpE%ysz(1),this%sp_gpE%ysz(2),this%sp_gpE%ysz(3)), intent(in), target :: what + complex(rkind), dimension(this%sp_gpC%ysz(1),this%sp_gpC%ysz(2),this%sp_gpC%ysz(3)), intent(in), optional, target :: That this%uhat => uhat this%vhat => vhat @@ -461,14 +464,18 @@ subroutine getLambdaFact(this, output) subroutine update_fringe_shifts(this) class(fringe), intent(inout) :: this ! Perform lateral shifting here - call this%phaseshift(this%uhat, this%u_for_shifts, this%xshift, this%yshift) - call this%phaseshift(this%vhat, this%v_for_shifts, this%xshift, this%yshift) - call this%phaseshift(this%what, this%w_for_shifts, this%xshift, this%yshift) - call this%phaseshift(this%That, this%T_for_shifts, this%xshift, this%yshift) + call this%phaseshift_cell(this%uhat, this%u_for_shifts, this%xshift, this%yshift) + call this%phaseshift_cell(this%vhat, this%v_for_shifts, this%xshift, this%yshift) + call this%phaseshift_edge(this%what, this%w_for_shifts, this%xshift, this%yshift) + ! Temperature storage is absent in unstratified runs. The association + ! flag is a more reliable guard than passing another flow-state logical. + if (this%T_linked_for_shifts) then + call this%phaseshift_cell(this%That, this%T_for_shifts, this%xshift, this%yshift) + end if end subroutine - subroutine phaseshift(this, uhat, uFilt, xshift, yshift) + subroutine phaseshift_cell(this, uhat, uFilt, xshift, yshift) use constants, only: imi class(fringe), intent(inout) :: this complex(rkind), dimension(this%sp_gpC%ysz(1),this%sp_gpC%ysz(2), this%sp_gpC%ysz(3)), intent(in) :: uhat @@ -489,4 +496,26 @@ subroutine phaseshift(this, uhat, uFilt, xshift, yshift) end subroutine + subroutine phaseshift_edge(this, what, wFilt, xshift, yshift) + use constants, only: imi + class(fringe), intent(inout) :: this + complex(rkind), dimension(this%sp_gpE%ysz(1),this%sp_gpE%ysz(2),this%sp_gpE%ysz(3)), intent(in) :: what + complex(rkind), dimension(size(what,1),size(what,2),size(what,3)) :: tmp + real(rkind), dimension(this%spectE%physdecomp%xsz(1),this%spectE%physdecomp%xsz(2), & + this%spectE%physdecomp%xsz(3)), intent(out) :: wFilt + real(rkind), intent(in) :: xshift, yshift + integer :: i, j, k + + tmp = what + do k = 1,size(tmp,3) + do j = 1,size(tmp,2) + do i = 1,size(tmp,1) + tmp(i,j,k) = what(i,j,k)*exp(-imi*(this%spectE%k1(i,1,1)*xshift + & + this%spectE%k2(1,j,1)*yshift)) + end do + end do + end do + call this%spectE%ifft(tmp, wFilt) + end subroutine + end module diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index 137c095f..a5db06e3 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -462,7 +462,7 @@ subroutine init(this,inputfile, initialize2decomp) 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, useFringeAD namelist /WINDTURBINES/ useWindTurbines, num_turbines, ADM, turbInfoDir, ADM_Type, powerDumpDir, useDynamicYaw, & - yawUpdateInterval, inputDirDyaw, useDynamicTurbine + yawUpdateInterval, inputDirDyaw, useDynamicTurbine, WriteTurbineForce namelist /NUMERICS/ AdvectionTerm, ComputeStokesPressure, NumericalSchemeVert, & UseDealiasFilterVert, t_DivergenceCheck, TimeSteppingScheme, InitSpinUp, & useExhaustiveFFT, dealiasFact, scheme_xy, donot_dealias, dealiasType @@ -515,10 +515,10 @@ subroutine init(this,inputfile, initialize2decomp) this%donot_dealias = donot_dealias; this%ioType = ioType; this%HITForceTimeScale = HITForceTimeScale this%moistureFactor = moistureFactor; this%useHITRealSpaceLinearForcing = useHITRealSpaceLinearForcing - if (this%CFL > zero) this%useCFL = .true. - if ((this%CFL < zero) .and. (this%dt < zero)) then - call GracefulExit("Both CFL and dt cannot be negative. Have you & - & specified either one of these in the input file?", 124) + this%useCFL = this%CFL > zero + ! Fixed-step mode requires a strictly positive dt; CFL <= 0 disables CFL mode. + if ((.not. this%useCFL) .and. (this%dt <= zero)) then + call GracefulExit("Specify either CFL > 0 or a fixed dt > 0.", 124) end if this%t_restartDump = t_restartDump; this%tid_statsDump = tid_statsDump; this%useCoriolis = useCoriolis; this%tSimStartStats = tSimStartStats; this%useWindTurbines = useWindTurbines @@ -633,6 +633,9 @@ subroutine init(this,inputfile, initialize2decomp) allocate(this%spectE) call this%spectE%init("x", nx, ny, nz+1, this%dx, this%dy, this%dz, & scheme_xy, this%filter_x, 2 , fixOddball=.false., exhaustiveFFT=useExhaustiveFFT, init_periodicInZ=.false., dealiasF=dealiasfact, dealiasType=dealiasType) + ! gpC/gpE describe real physical arrays of global sizes nz/nz+1. + ! Each spectral object independently constructs an x-R2C descriptor + ! with global x extent nx/2+1; these pointers must size Fourier arrays. this%sp_gpC => this%spectC%spectdecomp this%sp_gpE => this%spectE%spectdecomp @@ -794,7 +797,8 @@ subroutine init(this,inputfile, initialize2decomp) call this%spectC%ifft(this%uhat,this%u) call this%spectC%ifft(this%vhat,this%v) call this%spectE%ifft(this%what,this%w) - if (this%isStratified) call this%spectC%ifft(this%That,this%T) + ! InitSpinUp advances the same scalar storage even when isStratified is false. + if (this%isStratified .or. this%initspinup) call this%spectC%ifft(this%That,this%T) ! STEP 8: Interpolate the cell center values of w !if (this%useSGS) then @@ -816,7 +820,7 @@ subroutine init(this,inputfile, initialize2decomp) ! STEP 9: Compute duidxj call this%compute_duidxj() - if (this%isStratified) call this%compute_dTdxi() + if (this%isStratified .or. this%initspinup) call this%compute_dTdxi() ! STEP 10a: Compute Coriolis Term if (this%useCoriolis) then @@ -898,6 +902,8 @@ subroutine init(this,inputfile, initialize2decomp) if (this%useSponge) then allocate(this%RdampC(this%sp_gpC%ysz(1), this%sp_gpC%ysz(2), this%sp_gpC%ysz(3))) allocate(this%RdampE(this%sp_gpE%ysz(1), this%sp_gpE%ysz(2), this%sp_gpE%ysz(3))) + ! Associate the cell y-buffer here; the SGS setup above may not run. + zinY => this%rbuffyC(:,:,:,1) zinZ => this%rbuffzC(:,:,:,1) zEinZ => this%rbuffzE(:,:,:,1); call transpose_x_to_y(this%mesh(:,:,:,3),zinY,this%gpC) @@ -924,7 +930,8 @@ subroutine init(this,inputfile, initialize2decomp) do idx = 1,size(zEinZ,3) tmpzE(:,:,idx) = zEinZ(1,1,idx) end do - call transpose_z_to_y(tmpzE,zEinY, this%sp_gpC) + ! Edge coordinates must follow the edge-grid spectral decomposition. + call transpose_z_to_y(tmpzE,zEinY, this%sp_gpE) deallocate(tmpzE) nullify(zEinZ, zinZ) @@ -1329,6 +1336,14 @@ subroutine init(this,inputfile, initialize2decomp) this%DumpThisStep = .false. this%DumpRestartThisStep = .false. if (this%vizDump_Schedule == 1) then + if ((deltaT_dump <= zero) .or. (deltaT_restartdump <= zero)) then + call GracefulExit("deltaT_dump and deltaT_restartdump must be positive for vizDump_Schedule=1.", 123) + end if + ! Reject intervals too small to advance a floating-point time at tsim. + if ((this%tsim + deltaT_dump <= this%tsim) .or. & + (this%tsim + deltaT_restartdump <= this%tsim)) then + call GracefulExit("Timed dump interval is too small relative to the current simulation time.", 123) + end if this%deltaT_dump = deltaT_dump this%deltaT_restartdump = deltaT_restartdump if (useRestartFile) then diff --git a/src/incompressible/igrid_files/io_stuff.F90 b/src/incompressible/igrid_files/io_stuff.F90 index 1b083757..458d6247 100644 --- a/src/incompressible/igrid_files/io_stuff.F90 +++ b/src/incompressible/igrid_files/io_stuff.F90 @@ -517,6 +517,10 @@ subroutine readRestartFile(this, tid, rid) end if call mpi_barrier(mpi_comm_world, ierr) call mpi_bcast(this%tsim,1,mpirkind,0,mpi_comm_world,ierr) + if (this%useControl) then + ! The angle controller must restart from identical state on every rank. + call mpi_bcast(this%restartPhi,1,mpirkind,0,mpi_comm_world,ierr) + end if call mpi_barrier(mpi_comm_world, ierr) call message("================= RESTART FILE USED ======================") call message(0, "Simulation Time at restart:", this%tsim) diff --git a/src/incompressible/igrid_files/prep_wrapup_stuff.F90 b/src/incompressible/igrid_files/prep_wrapup_stuff.F90 index ee03ad33..af4e5230 100644 --- a/src/incompressible/igrid_files/prep_wrapup_stuff.F90 +++ b/src/incompressible/igrid_files/prep_wrapup_stuff.F90 @@ -50,7 +50,7 @@ subroutine dealias_rhs(this, uin, vin, win) subroutine dealiasRealField_C(this, field) class(igrid), intent(inout) :: this - real(rkind), dimension(this%gpC%xsz(1),this%gpC%xsz(1),this%gpC%xsz(1)), intent(inout) :: field + real(rkind), dimension(this%gpC%xsz(1),this%gpC%xsz(2),this%gpC%xsz(3)), intent(inout) :: field if (this%donot_dealias) then return @@ -286,7 +286,8 @@ subroutine interpolate_cellField_to_edgeField(this, rxC, rxE, bc1, bc2) call transpose_x_to_y(rxC, this%rbuffyC(:,:,:,1), this%gpC) call transpose_y_to_z(this%rbuffyC(:,:,:,1), this%rbuffzC(:,:,:,1), this%gpC) - call this%Pade6opZ%interpz_E2C(this%rbuffzC(:,:,:,1), this%rbuffzE(:,:,:,1), bc1,bc2) + ! The input is cell-centered and the destination has nz+1 edge points. + call this%Pade6opZ%interpz_C2E(this%rbuffzC(:,:,:,1), this%rbuffzE(:,:,:,1), bc1,bc2) call transpose_z_to_y(this%rbuffzE(:,:,:,1), this%rbuffyE(:,:,:,1), this%gpE) call transpose_y_to_x(this%rbuffyE(:,:,:,1), rxE, this%gpE) @@ -357,21 +358,22 @@ subroutine ApplyCompactFilter(this) zbuff4 => this%cbuffzE(:,:,:,2) call transpose_y_to_z(this%uhat,zbuff1, this%sp_gpC) - call this%filzC%filter3(zbuff1,zbuff2,this%nxZ, this%nyZ) - call transpose_z_to_y(zbuff1,this%uhat, this%sp_gpC) + call this%filzC%filter3(zbuff1,zbuff2,size(zbuff1,1),size(zbuff1,2)) + ! filter3 leaves its input unchanged and returns the filtered field in arg 2. + call transpose_z_to_y(zbuff2,this%uhat, this%sp_gpC) call transpose_y_to_z(this%vhat,zbuff1, this%sp_gpC) - call this%filzC%filter3(zbuff1,zbuff2,this%nxZ, this%nyZ) - call transpose_z_to_y(zbuff1,this%vhat, this%sp_gpC) + call this%filzC%filter3(zbuff1,zbuff2,size(zbuff1,1),size(zbuff1,2)) + call transpose_z_to_y(zbuff2,this%vhat, this%sp_gpC) call transpose_y_to_z(this%what,zbuff3, this%sp_gpE) - call this%filzE%filter3(zbuff3,zbuff4,this%nxZ, this%nyZ) + call this%filzE%filter3(zbuff3,zbuff4,size(zbuff3,1),size(zbuff3,2)) call transpose_z_to_y(zbuff4,this%what, this%sp_gpE) if (this%isStratified .or. this%initspinup) then call transpose_y_to_z(this%That,zbuff1, this%sp_gpC) - call this%filzC%filter3(zbuff1,zbuff2,this%nxZ, this%nyZ) - call transpose_z_to_y(zbuff1,this%That, this%sp_gpC) + call this%filzC%filter3(zbuff1,zbuff2,size(zbuff1,1),size(zbuff1,2)) + call transpose_z_to_y(zbuff2,this%That, this%sp_gpC) end if nullify(zbuff1, zbuff2, zbuff3, zbuff4) @@ -594,12 +596,15 @@ subroutine compute_duidxj(this) call this%Pade6opZ%ddz_E2C(ctmpz2,ctmpz1,uBC_bottom,uBC_top) call transpose_z_to_y(ctmpz1,dudzH,this%sp_gpC) call this%spectC%ifft(dudzH,dudzC) - ! Now compute d2udz2C - call this%Pade6opZ%ddz_C2C(ctmpz1,ctmpz3,-uBC_bottom,-uBC_top) - call transpose_z_to_y(ctmpz3,this%d2udz2hatC,this%sp_gpC) + if (.not. this%isInviscid) then + ! Viscous second-derivative storage is not allocated for inviscid runs. + call this%Pade6opZ%ddz_C2C(ctmpz1,ctmpz3,-uBC_bottom,-uBC_top) + call transpose_z_to_y(ctmpz3,this%d2udz2hatC,this%sp_gpC) + end if ! Now compute dudzE call this%Pade6opZ%interpz_C2E(ctmpz1,ctmpz4,-uBC_bottom,-uBC_top) - call transpose_z_to_y(ctmpz4,dudzEH,this%sp_gpC) + ! ctmpz4 and dudzEH are edge-grid quantities. + call transpose_z_to_y(ctmpz4,dudzEH,this%sp_gpE) call this%spectE%ifft(dudzEH,dudz) else call transpose_y_to_z(this%uhat,ctmpz1,this%sp_gpC) @@ -627,12 +632,15 @@ subroutine compute_duidxj(this) call this%Pade6opZ%ddz_E2C(ctmpz2,ctmpz1,vBC_bottom,vBC_top) call transpose_z_to_y(ctmpz1,dvdzH,this%sp_gpC) call this%spectC%ifft(dvdzH,dvdzC) - ! Now compute d2udz2C - call this%Pade6opZ%ddz_C2C(ctmpz1,ctmpz3,-vBC_bottom,-vBC_top) - call transpose_z_to_y(ctmpz3,this%d2vdz2hatC,this%sp_gpC) + if (.not. this%isInviscid) then + ! Viscous second-derivative storage is not allocated for inviscid runs. + call this%Pade6opZ%ddz_C2C(ctmpz1,ctmpz3,-vBC_bottom,-vBC_top) + call transpose_z_to_y(ctmpz3,this%d2vdz2hatC,this%sp_gpC) + end if ! Now compute dvdzE call this%Pade6opZ%interpz_C2E(ctmpz1,ctmpz4,-vBC_bottom,-vBC_top) - call transpose_z_to_y(ctmpz4,dvdzEH,this%sp_gpC) + ! ctmpz4 and dvdzEH are edge-grid quantities. + call transpose_z_to_y(ctmpz4,dvdzEH,this%sp_gpE) call this%spectE%ifft(dvdzEH,dvdz) else call transpose_y_to_z(this%vhat,ctmpz1,this%sp_gpC) diff --git a/src/incompressible/igrid_files/rhs_stuff.F90 b/src/incompressible/igrid_files/rhs_stuff.F90 index 550b96b3..fddade25 100644 --- a/src/incompressible/igrid_files/rhs_stuff.F90 +++ b/src/incompressible/igrid_files/rhs_stuff.F90 @@ -220,7 +220,8 @@ subroutine addNonLinearTerm_Rot(this, u_rhs, v_rhs, w_rhs) call this%spectC%fft(T1c,fT1C) T1E = -this%w*this%dTdzE call this%spectE%fft(T1E,fT1E) - call transpose_y_to_z(fT2E,tzE, this%sp_gpE) + ! fT1E contains the vertical scalar-advection flux transformed above. + call transpose_y_to_z(fT1E,tzE, this%sp_gpE) call this%Pade6opZ%interpz_E2C(tzE,tzC,WdTdzBC_bottom,WdTdzBC_top) call transpose_z_to_y(tzC,this%T_rhs, this%sp_gpC) this%T_rhs = this%T_rhs + fT1C diff --git a/src/incompressible/igrid_files/stats_stuff.F90 b/src/incompressible/igrid_files/stats_stuff.F90 index 98b8d445..0f84d9da 100644 --- a/src/incompressible/igrid_files/stats_stuff.F90 +++ b/src/incompressible/igrid_files/stats_stuff.F90 @@ -1179,7 +1179,8 @@ subroutine dump_stats3D(this) if(this%useWindTurbines) then !----Turbine work term in MKE budget------- - rbuff1 = ( this%u_mean3D*this%turbfx_mean3D + this%v_mean3D*this%turbfy_mean3D + this%w_mean3D*this%turbfy_mean3D ) / tidSUMreal**2 + ! Contract each mean velocity component with its matching force component. + rbuff1 = ( this%u_mean3D*this%turbfx_mean3D + this%v_mean3D*this%turbfy_mean3D + this%w_mean3D*this%turbfz_mean3D ) / tidSUMreal**2 call transpose_x_to_y(rbuff1, rbuff2, this%gpC) call transpose_y_to_z(rbuff2, rbuff3, this%gpC) call this%compute_z_mean(rbuff3, this%mketurbf_mean) @@ -1190,7 +1191,7 @@ subroutine dump_stats3D(this) !----Turbine work term in TKE budget------- rbuff1 = this%uturbf_mean3D/tidSUMreal - ( this%u_mean3D*this%turbfx_mean3D + & - this%v_mean3D*this%turbfy_mean3D + this%w_mean3D*this%turbfy_mean3D ) / tidSUMreal**2 + this%v_mean3D*this%turbfy_mean3D + this%w_mean3D*this%turbfz_mean3D ) / tidSUMreal**2 call transpose_x_to_y(rbuff1, rbuff2, this%gpC) call transpose_y_to_z(rbuff2, rbuff3, this%gpC) call this%compute_z_mean(rbuff3, this%tketurbf_mean) diff --git a/src/incompressible/igrid_files/timestepping_stuff.F90 b/src/incompressible/igrid_files/timestepping_stuff.F90 index b42d9439..089d61c0 100644 --- a/src/incompressible/igrid_files/timestepping_stuff.F90 +++ b/src/incompressible/igrid_files/timestepping_stuff.F90 @@ -633,7 +633,7 @@ function get_dt(this, recompute) result(val) subroutine compute_deltaT(this) use reductions, only: p_maxval class(igrid), intent(inout), target :: this - real(rkind) :: TSmax, Tsim_next + real(rkind) :: TSmax, Tsim_next, nextEvent, timeTol real(rkind), dimension(:,:,:), pointer :: rb1, rb2 real(rkind), dimension(5) :: dtmin integer :: idx @@ -651,7 +651,12 @@ subroutine compute_deltaT(this) rb2 = abs(rb2) rb1 = rb1 + rb2 TSmax = p_maxval(rb1) - dtmin(1)= this%CFL/TSmax + if (TSmax > tiny(one)) then + dtmin(1) = this%CFL/TSmax + else + ! A quiescent field has no convective CFL restriction. + dtmin(1) = 1.d15 + end if if (.not. this%isInviscid) then dtmin(2) = this%CviscDT*0.5d0*this%Re*(min(this%dx,this%dy,this%dz)**2) @@ -700,19 +705,40 @@ subroutine compute_deltaT(this) if (this%vizDump_Schedule == 1) then this%DumpThisStep = .false. - this%DumpRestartThisStep = .false. + this%DumpRestartThisStep = .false. + + ! A restart can land on an old event time within roundoff. Advance + ! stale schedules before selecting an event to avoid a zero dt. + timeTol = 100.d0*epsilon(one)*max(one, abs(this%tsim), & + abs(this%t_NextDump), & + abs(this%t_NextRestartDump)) + do while (this%t_NextDump <= this%tsim + timeTol) + this%t_NextDump = this%t_NextDump + this%deltaT_dump + end do + do while (this%t_NextRestartDump <= this%tsim + timeTol) + this%t_NextRestartDump = this%t_NextRestartDump + this%deltaT_restartdump + end do + + ! Truncate to the earliest event only. If visualization and restart + ! times coincide within roundoff, both are emitted after this step. + nextEvent = min(this%t_NextDump, this%t_NextRestartDump) Tsim_next = this%tsim + this%dt - if (Tsim_next > this%t_NextDump) then - this%dt = this%t_nextDump - this%tsim - this%t_NextDump = this%t_NextDump + this%deltaT_dump - this%t_NextDump = this%t_NextDump + this%deltaT_dump - this%DumpThisStep = .true. - end if - if (Tsim_next > this%t_NextRestartDump) then - this%dt = this%t_nextRestartDump - this%tsim - this%t_NextRestartDump = this%t_NextRestartDump + this%deltaT_restartdump - this%t_NextRestartDump = this%t_NextRestartDump + this%deltaT_restartdump - this%DumpRestartThisStep = .true. + timeTol = 100.d0*epsilon(one)*max(one, abs(this%tsim), & + abs(Tsim_next), abs(nextEvent)) + if (Tsim_next >= nextEvent - timeTol) then + this%dt = nextEvent - this%tsim + this%DumpThisStep = abs(this%t_NextDump - nextEvent) <= timeTol + this%DumpRestartThisStep = & + abs(this%t_NextRestartDump - nextEvent) <= timeTol + + ! Advance each triggered schedule exactly once. + if (this%DumpThisStep) then + this%t_NextDump = this%t_NextDump + this%deltaT_dump + end if + if (this%DumpRestartThisStep) then + this%t_NextRestartDump = this%t_NextRestartDump + & + this%deltaT_restartdump + end if end if end if diff --git a/src/incompressible/igrid_operators.F90 b/src/incompressible/igrid_operators.F90 index 620b8888..17206b8f 100644 --- a/src/incompressible/igrid_operators.F90 +++ b/src/incompressible/igrid_operators.F90 @@ -136,7 +136,12 @@ subroutine create_turbine_array(this, inputfile) subroutine destroy_turbine_array(this) class(igrid_ops), intent(inout) :: this - if (allocated(this%turbArray)) deallocate(this%turbArray) + if (allocated(this%turbArray)) then + ! Filtered ADM elements may own MPI communicators; invoke their + ! destructor before releasing the containing object. + call this%turbArray%destroy() + deallocate(this%turbArray) + end if if (allocated(this%mesh)) deallocate(this%mesh) if (allocated(this%cbuffyC)) deallocate(this%cbuffyC) if (allocated(this%cbuffzC)) deallocate(this%cbuffzC) @@ -156,9 +161,11 @@ subroutine get_turbine_RHS(this, u, v, w, urhs, vrhs, wrhs) class(igrid_ops), intent(inout) :: this real(rkind), dimension(this%gp%xsz(1),this%gp%xsz(2),this%gp%xsz(3)), intent(in) :: u, v, w real(rkind), dimension(this%gp%xsz(1),this%gp%xsz(2),this%gp%xsz(3)), intent(out) :: urhs, vrhs, wrhs - real(rkind) :: inst_horz_avg_turb(8) + real(rkind), dimension(:), allocatable :: inst_horz_avg_turb real(rkind) :: dt = 1.d0 + allocate(inst_horz_avg_turb(8*this%turbArray%nTurbines)) + inst_horz_avg_turb = 0.d0 this%urhshat = 0.d0 + imi*0.d0 this%vrhshat = 0.d0 + imi*0.d0 this%wrhshat = 0.d0 + imi*0.d0 @@ -171,6 +178,7 @@ subroutine get_turbine_RHS(this, u, v, w, urhs, vrhs, wrhs) call this%spect%ifft(this%urhshat, urhs) call this%spect%ifft(this%vrhshat, vrhs) call this%spect%ifft(this%cbuffyC(:,:,:,1), wrhs) + deallocate(inst_horz_avg_turb) end subroutine @@ -218,6 +226,10 @@ subroutine FilterField(this, f, fout) call transpose_x_to_y(fout,this%rbuffy,this%gp) call transpose_y_to_z(this%rbuffy,this%rbuffz1,this%gp) + if (this%vfilt_times == 0) then + ! With no vertical passes, the horizontally filtered z-pencil is final. + this%rbuffz2 = this%rbuffz1 + end if do fid = 1,this%vfilt_times call this%gfilt%filter3(this%rbuffz1,this%rbuffz2,size(this%rbuffz1,1),size(this%rbuffz1,2)) this%rbuffz1 = this%rbuffz2 @@ -245,6 +257,7 @@ subroutine initFilter(this, nx_filt, ny_filt, vfilt_times) real(rkind) :: kx_co, ky_co, dxf, dyf integer :: i, j, ierr + if (vfilt_times < 0) call GracefulExit("vfilt_times must be nonnegative.", 34) allocate(this%gxfilt(this%spect%spectdecomp%ysz(1))) allocate(this%gyfilt(this%spect%spectdecomp%ysz(2))) @@ -308,7 +321,10 @@ subroutine Read_VizSummary(this, times, timesteps) allocate(times(nr), timesteps(nr)) do i=1, nr read (10, *) times(i), timesteps(i) - end do + end do + ! The summary is fully consumed here; no later routine reuses this + ! connection, and leaving unit 10 open breaks later fixed-unit I/O. + close(10) else call GracefulExit("Summary file not found.", 34) end if @@ -649,6 +665,9 @@ function check_dump_existence(this, label, tidx) result(file_found) open(777,file=trim(fname),status='old',iostat=ierr) if (ierr == 0) then file_found = .true. + ! This routine only probes existence; the actual reader opens the file + ! separately, so do not retain this fixed-unit connection. + close(777) else file_found = .false. end if @@ -716,10 +735,11 @@ subroutine WriteSummingRestartInfo(this,tidx,nsum) OPEN(UNIT=10, FILE=trim(fname)) write(10,"(I7.7)") nsum close(10) - end if + end if end subroutine subroutine ReadSummingRestartInfo(this,tidx,nsum) + use mpi class(igrid_ops), intent(inout) :: this integer, intent(in) :: tidx integer, intent(out) :: nsum @@ -737,7 +757,9 @@ subroutine ReadSummingRestartInfo(this,tidx,nsum) read(10,"(I7.7)") nsum end if close(10) - end if + end if + ! All ranks normalize the same distributed restart fields with this count. + call MPI_BCAST(nsum, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr) end subroutine subroutine allocate3Dfield(this, field) diff --git a/src/incompressible/igrid_operators_periodic.F90 b/src/incompressible/igrid_operators_periodic.F90 index 9cc8ab64..176e8365 100644 --- a/src/incompressible/igrid_operators_periodic.F90 +++ b/src/incompressible/igrid_operators_periodic.F90 @@ -112,8 +112,18 @@ subroutine init(this, nx, ny, nz, dx, dy, dz, gp, InputDir, OutputDir) subroutine destroy(this) class(Ops_Periodic), intent(inout), target :: this - - deallocate(this%rbuffy, this%rbuffz1) + + call this%poiss%destroy() + call this%spect%destroy() + if (allocated(this%cbuffy1)) deallocate(this%cbuffy1) + if (allocated(this%cbuffy2)) deallocate(this%cbuffy2) + if (allocated(this%cbuffz)) deallocate(this%cbuffz) + if (allocated(this%rbuffy)) deallocate(this%rbuffy) + if (allocated(this%rbuffz1)) deallocate(this%rbuffz1) + if (allocated(this%rbuffz2)) deallocate(this%rbuffz2) + if (allocated(this%zarr1d_1)) deallocate(this%zarr1d_1) + if (allocated(this%zarr1d_2)) deallocate(this%zarr1d_2) + nullify(this%gp) end subroutine subroutine ddx(this,f, dfdx) diff --git a/src/incompressible/interpolator.F90 b/src/incompressible/interpolator.F90 index fe893646..728d2cd7 100644 --- a/src/incompressible/interpolator.F90 +++ b/src/incompressible/interpolator.F90 @@ -27,7 +27,7 @@ subroutine init(this, gpSource, gpDest, xSource, ySource, zSource, xDest, yDest, type(decomp_info), intent(in), target :: gpSource, gpDest real(rkind), dimension(:), intent(in) :: xSource, ySource, zSource, xDest, yDest, zDest integer :: nxS, nyS, nzS, nxD, nyD, nzD, idx - real(rkind) :: delta, start + real(rkind) :: delta, start, coordinate this%gpSource => gpSource this%gpDest => gpDest @@ -71,25 +71,35 @@ subroutine init(this, gpSource, gpDest, xSource, ySource, zSource, xDest, yDest, ! Get interpolation indices and weights - delta = xSource(2) - xSource(1) - start = xSource(1) - do idx = 1,size(this%wx) - this%xInd(idx) = ceiling((xDest(idx) - start)/delta) - this%wx(idx) = (xSource(this%xInd(idx) + 1) - xDest(idx))/delta - end do - - delta = ySource(2) - ySource(1) - start = ySource(1) - do idx = 1,size(this%wy) - this%yInd(idx) = ceiling((yDest(idx) - start)/delta) - this%wy(idx) = (ySource(this%yInd(idx) + 1) - yDest(idx))/delta - end do - - delta = zSource(2) - zSource(1) - start = zSource(1) - do idx = 1,size(this%wz) - this%zInd(idx) = ceiling((zDest(idx) - start)/delta) - this%wz(idx) = (zSource(this%zInd(idx) + 1) - zDest(idx))/delta + if ((size(xSource) < 2) .or. (size(ySource) < 2) .or. (size(zSource) < 2)) then + call GracefulExit("Interpolator source axes require at least two points.",34) + end if + + delta = xSource(2) - xSource(1) + if (delta <= 0._rkind) call GracefulExit("Interpolator x-axis must be strictly increasing.",34) + start = xSource(1) + do idx = 1,size(this%wx) + coordinate = (xDest(idx) - start)/delta + this%xInd(idx) = max(1, min(size(xSource)-1, floor(coordinate) + 1)) + this%wx(idx) = (xSource(this%xInd(idx) + 1) - xDest(idx))/delta + end do + + delta = ySource(2) - ySource(1) + if (delta <= 0._rkind) call GracefulExit("Interpolator y-axis must be strictly increasing.",34) + start = ySource(1) + do idx = 1,size(this%wy) + coordinate = (yDest(idx) - start)/delta + this%yInd(idx) = max(1, min(size(ySource)-1, floor(coordinate) + 1)) + this%wy(idx) = (ySource(this%yInd(idx) + 1) - yDest(idx))/delta + end do + + delta = zSource(2) - zSource(1) + if (delta <= 0._rkind) call GracefulExit("Interpolator z-axis must be strictly increasing.",34) + start = zSource(1) + do idx = 1,size(this%wz) + coordinate = (zDest(idx) - start)/delta + this%zInd(idx) = max(1, min(size(zSource)-1, floor(coordinate) + 1)) + this%wz(idx) = (zSource(this%zInd(idx) + 1) - zDest(idx))/delta end do ! Create 2 intermediate transposers and buffer arrays @@ -107,7 +117,8 @@ subroutine init(this, gpSource, gpDest, xSource, ySource, zSource, xDest, yDest, subroutine destroy(this) class(interpolator), intent(inout) :: this deallocate(this%wx, this%wy, this%wz, this%xInd, this%yInd, this%zInd) - deallocate(this%fx_X, this%fx_Y, this%fxy_Y, this%fxy_Z) + deallocate(this%fx_X, this%fx_Y, this%fxy_Y, this%fxy_Z, this%fxyz_Z, this%fxyz_Y) + nullify(this%gpSource, this%gpDest) end subroutine subroutine LinInterp3D(this, fS, fD) @@ -151,4 +162,4 @@ subroutine LinInterp3D(this, fS, fD) call transpose_y_to_x(this%fxyz_Y,fD, this%gpDest) ! DONE! end subroutine -end module \ No newline at end of file +end module diff --git a/src/incompressible/scalar_igrid.F90 b/src/incompressible/scalar_igrid.F90 index 6794f61a..97a17e6a 100644 --- a/src/incompressible/scalar_igrid.F90 +++ b/src/incompressible/scalar_igrid.F90 @@ -53,7 +53,7 @@ module scalar_igridMod type(sgs_igrid), pointer :: sgsmodel logical :: useSource, isinviscid, useSGS, usefringe, usedoublefringe - real(rkind) :: lowbound, highbound + real(rkind) :: lowbound = 0.d0, highbound = 1.d0 contains procedure :: init procedure :: destroy @@ -168,8 +168,16 @@ subroutine populateRHS(this, dt) subroutine destroy(this) class(scalar_igrid), intent(inout) :: this - deallocate(this%F, this%Fhat, this%dFdxC, this%dFdyC, this%dFdzC, this%dFdzE, this%rhs) - deallocate(this%fhat1, this%fhat2, this%fhat3) + ! Fhat/rhs/Fhat1:3 are aliases into Sfields/rhs_storage. Deallocating the + ! aliases can free the same owner more than once, so release owners only. + nullify(this%Fhat, this%rhs, this%Fhat1, this%Fhat2, this%Fhat3, this%Fhat4) + if (allocated(this%F)) deallocate(this%F) + if (allocated(this%dFdxC)) deallocate(this%dFdxC) + if (allocated(this%dFdyC)) deallocate(this%dFdyC) + if (allocated(this%dFdzC)) deallocate(this%dFdzC) + if (allocated(this%dFdzE)) deallocate(this%dFdzE) + if (allocated(this%Sfields)) deallocate(this%Sfields) + if (allocated(this%rhs_storage)) deallocate(this%rhs_storage) if (allocated(this%source_hat)) deallocate(this%source_hat) if (allocated(this%d2Fdz2)) deallocate(this%d2Fdz2) @@ -204,12 +212,14 @@ subroutine init(this,gpC,gpE,spectC,spectE,sgsmodel,der,inputFile, inputDir,mesh integer, intent(in) :: scalar_number, RunID, tid_restart integer :: ierr logical :: useSource = .false., RejectScalarRestart = .false. - real(rkind) :: PrandtlNum = 1.d0, TurbPrandtlNum = 1.d0, Cy = 100.d0 + real(rkind) :: PrandtlNum = 1.d0, TurbPrandtlNum = 1.d0, Cy = 100.d0 + real(rkind) :: lowbound = 0.d0, highbound = 1.d0 integer :: bc_bottom = 1, bc_top = 1 character(len=clen) :: tempname, fname - namelist /SCALAR_INFO/ useSource, PrandtlNum, bc_bottom, bc_top,TurbPrandtlNum, Cy, RejectScalarRestart + namelist /SCALAR_INFO/ useSource, PrandtlNum, bc_bottom, bc_top,TurbPrandtlNum, Cy, & + lowbound, highbound, RejectScalarRestart this%InputDataDir = InputDataDir @@ -226,6 +236,8 @@ subroutine init(this,gpC,gpE,spectC,spectE,sgsmodel,der,inputFile, inputDir,mesh this%TurbPrandtlNum = TurbPrandtlNum this%Re = Re this%Cy = Cy + this%lowbound = lowbound + this%highbound = highbound this%der => der diff --git a/src/incompressible/sgs_models/AMD.F90 b/src/incompressible/sgs_models/AMD.F90 index 77eba649..8c9c4447 100644 --- a/src/incompressible/sgs_models/AMD.F90 +++ b/src/incompressible/sgs_models/AMD.F90 @@ -19,7 +19,8 @@ subroutine init_amd(this, dx, dy, dz, Csgs) subroutine destroy_amd(this) class(sgs_igrid), intent(inout) :: this - this%isEddyViscosityModel = .true. + this%isEddyViscosityModel = .false. + if (allocated(this%rbuffxE)) deallocate(this%rbuffxE) end subroutine diff --git a/src/incompressible/sgs_models/init_destroy_sgs_igrid.F90 b/src/incompressible/sgs_models/init_destroy_sgs_igrid.F90 index 91fe85a7..2bc054b8 100644 --- a/src/incompressible/sgs_models/init_destroy_sgs_igrid.F90 +++ b/src/incompressible/sgs_models/init_destroy_sgs_igrid.F90 @@ -4,14 +4,31 @@ subroutine destroy(this) nullify(this%cbuffyC, this%cbuffzC, this%rbuffxC, this%Tsurf, this%fyC, this%fzE, this%wTh_surf) if (this%isEddyViscosityModel) call this%destroyMemory_EddyViscosity() if (this%DynamicProcedureType .ne. 0) call this%destroyMemory_DynamicProcedure() + if (this%useWallModel) call this%destroyWallModel() + if (this%useScalarBounding) then + call this%gaussianX%destroy() + call this%gaussianY%destroy() + call this%gaussianZ%destroy() + end if select case (this%mid) case (0) call this%destroy_smagorinsky() case (1) call this%destroy_sigma() + case (2) + call this%destroy_amd() end select - nullify(this%tau_11, this%tau_12, this%tau_22, this%tau_33) - deallocate(this%tau_13, this%tau_23) + nullify(this%tau_11, this%tau_12, this%tau_13C, this%tau_22, this%tau_23C, this%tau_33) + if (allocated(this%tau_ij)) deallocate(this%tau_ij) + if (allocated(this%tau_13)) deallocate(this%tau_13) + if (allocated(this%tau_23)) deallocate(this%tau_23) + if (allocated(this%q1C)) deallocate(this%q1C) + if (allocated(this%q2C)) deallocate(this%q2C) + if (allocated(this%q3E)) deallocate(this%q3E) + if (allocated(this%kappa_boundingC)) deallocate(this%kappa_boundingC) + if (allocated(this%kappa_boundingE)) deallocate(this%kappa_boundingE) + if (allocated(this%cmodelC)) deallocate(this%cmodelC) + if (allocated(this%cmodelE)) deallocate(this%cmodelE) end subroutine @@ -29,11 +46,11 @@ subroutine link_pointers(this, nuSGS, tauSGS_ij, tau13, tau23, q1, q2, q3, kappa tauSGS_ij => this%tau_ij - if (this%isStratified) then + if (this%isStratified .or. this%initSpinUp) then q1 => this%q1C q2 => this%q2C q3 => this%q3E - kappaSGS => this%kappa_sgs_C + if (this%isStratified) kappaSGS => this%kappa_sgs_C end if if (this%useScalarBounding) then @@ -169,6 +186,9 @@ subroutine init(this, gpC, gpE, spectC, spectE, dx, dy, dz, inputfile, zMeshE, z this%WallModel = WallModelType this%WM_matchingIndex = WM_matchingIndex if (this%WallModel .ne. 0) then + if ((this%WM_matchingIndex < 1) .or. (this%WM_matchingIndex > gpC%zsz(3))) then + call GracefulExit("Wall-model matching index is outside the cell-centered z grid.", 12) + end if if (this%PadeDer%isPeriodic) then call GracefulExit("You cannot use a wall model if the problem is periodic in Z",12) else diff --git a/src/incompressible/sgs_models/scalar_bounding.F90 b/src/incompressible/sgs_models/scalar_bounding.F90 index 740960d9..d5f33977 100644 --- a/src/incompressible/sgs_models/scalar_bounding.F90 +++ b/src/incompressible/sgs_models/scalar_bounding.F90 @@ -13,7 +13,14 @@ subroutine compute_Tscale(this, u, v, w) rb2 = (one/this%dz)*w rb2 = abs(rb2) rb1 = rb1 + rb2 - this%Tscale = one/p_maxval(rb1) + this%Tscale = p_maxval(rb1) + if (this%Tscale > tiny(one)) then + this%Tscale = one/this%Tscale + else + ! A quiescent field has no advective time scale. Use a zero inverse + ! scale so the added bounding diffusivity remains finite and inactive. + this%Tscale = zero + end if end subroutine diff --git a/src/incompressible/sgs_models/wallmodel.F90 b/src/incompressible/sgs_models/wallmodel.F90 index ad018b9f..08df16cc 100644 --- a/src/incompressible/sgs_models/wallmodel.F90 +++ b/src/incompressible/sgs_models/wallmodel.F90 @@ -1,7 +1,18 @@ subroutine destroyWallModel(this) class(sgs_igrid), intent(inout) :: this - deallocate(this%tauijWM, this%tauijWMhat_inZ, this%tauijWMhat_inY) + if (allocated(this%tauijWM)) deallocate(this%tauijWM) + if (allocated(this%tauijWMhat_inZ)) deallocate(this%tauijWMhat_inZ) + if (allocated(this%tauijWMhat_inY)) deallocate(this%tauijWMhat_inY) if (allocated(this%filteredSpeedSq)) deallocate(this%filteredSpeedSq) + if (allocated(this%usurf_filt)) deallocate(this%usurf_filt) + if (allocated(this%vsurf_filt)) deallocate(this%vsurf_filt) + if (allocated(this%Tmatch_filt)) deallocate(this%Tmatch_filt) + if (allocated(this%ustar_surf)) deallocate(this%ustar_surf) + if (allocated(this%wTheta_surf)) deallocate(this%wTheta_surf) + if (allocated(this%PsiM_surf)) deallocate(this%PsiM_surf) + if (allocated(this%Linv_surf)) deallocate(this%Linv_surf) + if (allocated(this%T_surf)) deallocate(this%T_surf) + if (allocated(this%q3HAT_AtWall)) deallocate(this%q3HAT_AtWall) end subroutine subroutine initWallModel(this, SurfaceFilterFact) @@ -33,7 +44,10 @@ subroutine initWallModel(this, SurfaceFilterFact) allocate(this%PsiM_surf(this%gpC%zsz(1),this%gpC%zsz(2))) allocate(this%Linv_surf(this%gpC%zsz(1),this%gpC%zsz(2))) allocate(this%T_surf(this%gpC%zsz(1),this%gpC%zsz(2))) - allocate(this%filteredSpeedSq(this%gpC%xsz(1),this%gpC%xsz(2),this%gpC%xsz(3))) ! Howland: Added 1/25/21 + ! Wall-model type 2 already owns this workspace. + if (.not. allocated(this%filteredSpeedSq)) then + allocate(this%filteredSpeedSq(this%gpC%xsz(1),this%gpC%xsz(2),this%gpC%xsz(3))) + end if call this%spectC%ResetSurfaceFilter(SurfaceFilterFact) call message(2,"Fully local wall model set up with a filter factor:", SurfaceFilterFact) end if @@ -92,12 +106,14 @@ subroutine computeWallStress(this, u, v, T, uhat, vhat, That) call transpose_y_to_z(cbuffy, cbuffz, this%sp_gpC) ! tau_13 - this%tauijWMhat_inZ(:,:,1,1) = (this%WallMFactor*this%umn/this%Uspmn) * cbuffz(:,:,this%WM_matchingIndex) + this%tauijWMhat_inZ(:,:,1,1) = (this%WallMFactor*this%umn/(this%Uspmn + tiny(one))) * & + cbuffz(:,:,this%WM_matchingIndex) call transpose_z_to_y(this%tauijWMhat_inZ(:,:,:,1), this%tauijWMhat_inY(:,:,:,1), this%sp_gpE) call this%spectE%ifft(this%tauijWMhat_inY(:,:,:,1), this%tauijWM(:,:,:,1)) ! tau_23 - this%tauijWMhat_inZ(:,:,1,2) = (this%WallMFactor*this%vmn/this%Uspmn) * cbuffz(:,:,this%WM_matchingIndex) + this%tauijWMhat_inZ(:,:,1,2) = (this%WallMFactor*this%vmn/(this%Uspmn + tiny(one))) * & + cbuffz(:,:,this%WM_matchingIndex) call transpose_z_to_y(this%tauijWMhat_inZ(:,:,:,2), this%tauijWMhat_inY(:,:,:,2), this%sp_gpE) call this%spectE%ifft(this%tauijWMhat_inY(:,:,:,2), this%tauijWM(:,:,:,2)) end select @@ -172,12 +188,13 @@ subroutine getfilteredSpeedSqAtWall(this, uhatC, vhatC) rbuffx1 => this%filteredSpeedSq; rbuffx2 => this%rbuffxC(:,:,:,1) call transpose_y_to_z(uhatC,tauWallH,this%sp_gpC) - call this%spectC%SurfaceFilter_ip(tauWallH(:,:,1)) + call this%spectC%SurfaceFilter_ip(tauWallH(:,:,this%WM_matchingIndex)) call transpose_z_to_y(tauWallH,cbuffy, this%sp_gpC) call this%spectC%ifft(cbuffy,rbuffx1) call transpose_y_to_z(vhatC,tauWallH,this%sp_gpC) - call this%spectC%SurfaceFilter_ip(tauWallH(:,:,1)) + ! Both horizontal components must be filtered on the same matching plane. + call this%spectC%SurfaceFilter_ip(tauWallH(:,:,this%WM_matchingIndex)) call transpose_z_to_y(tauWallH,cbuffy, this%sp_gpC) call this%spectC%ifft(cbuffy,rbuffx2) @@ -198,30 +215,30 @@ subroutine getfilteredMatchingVelocity(this, uhatC, vhatC, That) rbuffx1 => this%filteredSpeedSq; rbuffx2 => this%rbuffxC(:,:,:,1) call transpose_y_to_z(uhatC,tauWallH,this%sp_gpC) - call this%spectC%SurfaceFilter_ip(tauWallH(:,:,1)) + call this%spectC%SurfaceFilter_ip(tauWallH(:,:,this%WM_matchingIndex)) call transpose_z_to_y(tauWallH,cbuffy, this%sp_gpC) call this%spectC%ifft(cbuffy,rbuffx1) call transpose_x_to_y(rbuffx1,this%rbuffyC(:,:,:,1),this%gpC) call transpose_y_to_z(this%rbuffyC(:,:,:,1),this%rbuffzC(:,:,:,1), this%gpC) - this%usurf_filt = this%rbuffzC(:,:,1,1) + this%usurf_filt = this%rbuffzC(:,:,this%WM_matchingIndex,1) call transpose_y_to_z(vhatC,tauWallH,this%sp_gpC) - call this%spectC%SurfaceFilter_ip(tauWallH(:,:,1)) + call this%spectC%SurfaceFilter_ip(tauWallH(:,:,this%WM_matchingIndex)) call transpose_z_to_y(tauWallH,cbuffy, this%sp_gpC) call this%spectC%ifft(cbuffy,rbuffx2) call transpose_x_to_y(rbuffx2,this%rbuffyC(:,:,:,1),this%gpC) call transpose_y_to_z(this%rbuffyC(:,:,:,1),this%rbuffzC(:,:,:,1), this%gpC) - this%vsurf_filt = this%rbuffzC(:,:,1,1) + this%vsurf_filt = this%rbuffzC(:,:,this%WM_matchingIndex,1) if (this%isStratified) then ! Filter for temperature call transpose_y_to_z(That,tauWallH,this%sp_gpC) - call this%spectC%SurfaceFilter_ip(tauWallH(:,:,1)) + call this%spectC%SurfaceFilter_ip(tauWallH(:,:,this%WM_matchingIndex)) call transpose_z_to_y(tauWallH,cbuffy, this%sp_gpC) call this%spectC%ifft(cbuffy,rbuffx1) call transpose_x_to_y(rbuffx1,this%rbuffyC(:,:,:,1),this%gpC) call transpose_y_to_z(this%rbuffyC(:,:,:,1),this%rbuffzC(:,:,:,1), this%gpC) - this%Tmatch_filt = this%rbuffzC(:,:,1,1) + this%Tmatch_filt = this%rbuffzC(:,:,this%WM_matchingIndex,1) ! No filter for temperature !call transpose_x_to_y(T,this%rbuffyC(:,:,:,1),this%gpC) @@ -273,14 +290,29 @@ subroutine compute_local_wallmodel(this, ux, uy, Tmn, wTh_surf, ustar, Linv, Psi integer, parameter :: itermax = 100 integer :: idx - hwm = this%dz/two + hwm = this%dz/two + (this%WM_matchingIndex - 1)*this%dz + if ((this%z0 <= zero) .or. (this%z0t <= zero) .or. (hwm <= this%z0) .or. & + (this%isStratified .and. hwm <= this%z0t)) then + call gracefulExit("Wall-model roughness lengths must be positive and below the matching height.", 324) + end if + u = sqrt(ux*ux + uy*uy) + if (u <= tiny(one)) then + ! The limiting wall stress and heat transfer are zero for calm flow. + wTh_surf = zero + ustar = zero + Linv = zero + PsiM = zero + T_surf = Tmn + this%T_surf_mean = T_surf + return + end if if (this%isStratified) then select case (this%botBC_Temp) case(0) ! Dirichlet BC for temperature dTheta = this%Tsurf - Tmn; Linv = zero ustarDiff = one; wTh = zero a=log(hwm/this%z0); b=beta_h*hwm; c=beta_m*hwm - PsiM = zero; PsiH = zero; idx = 0; ustar = one; u = sqrt(ux*ux + uy*uy) + PsiM = zero; PsiH = zero; idx = 0; ustar = one at=log(hwm/this%z0t) do while ( (ustarDiff > 1d-12) .and. (idx < itermax)) @@ -300,7 +332,7 @@ subroutine compute_local_wallmodel(this, ux, uy, Tmn, wTh_surf, ustar, Linv, Psi PsiH = two*log(half*(one+xisq)); endif end if - ustarDiff = abs((ustarNew - ustar)/ustarNew) + ustarDiff = abs(ustarNew - ustar)/max(abs(ustarNew), tiny(one)) ustar = ustarNew; idx = idx + 1 end do wTh_surf = wTh @@ -315,7 +347,7 @@ subroutine compute_local_wallmodel(this, ux, uy, Tmn, wTh_surf, ustar, Linv, Psi Linv = zero; !dTheta = this%Tsurf - this%Tmn; ustarDiff = one; wTh = this%wTh_surf a=log(hwm/this%z0); b=beta_h*hwm; c=beta_m*hwm - PsiM = zero; PsiH = zero; idx = 0; ustar = one; u = sqrt(ux*ux + uy*uy) + PsiM = zero; PsiH = zero; idx = 0; ustar = one at=log(hwm/this%z0t) do while ( (ustarDiff > 1d-12) .and. (idx < itermax)) @@ -334,7 +366,7 @@ subroutine compute_local_wallmodel(this, ux, uy, Tmn, wTh_surf, ustar, Linv, Psi PsiH = two*log(half*(one+xisq)); endif end if - ustarDiff = abs((ustarNew - ustar)/ustarNew) + ustarDiff = abs(ustarNew - ustar)/max(abs(ustarNew), tiny(one)) ustar = ustarNew; idx = idx + 1 end do wTh_surf = this%wTh_surf @@ -379,6 +411,19 @@ subroutine getSurfaceQuantities(this) real(rkind) :: hwm hwm = this%dz/two + (this%WM_matchingIndex - 1)*this%dz + if ((this%z0 <= zero) .or. (this%z0t <= zero) .or. (hwm <= this%z0) .or. & + (this%isStratified .and. hwm <= this%z0t)) then + call gracefulExit("Wall-model roughness lengths must be positive and below the matching height.", 324) + end if + if (this%Uspmn <= tiny(one)) then + ! Avoid 0/0 in Monin-Obukhov iterations when the mean matching + ! velocity is calm. + this%ustar = zero + this%invObLength = zero + this%wTh_surf = zero + this%PsiM = zero + return + end if if (this%isStratified) then select case (this%botBC_Temp) case(0) ! Dirichlet BC for temperature @@ -401,7 +446,7 @@ subroutine getSurfaceQuantities(this) PsiM = two*log(half*(one+xi)) + log(half*(one+xisq)) - two*atan(xi) + piby2; PsiH = two*log(half*(one+xisq)); endif - ustarDiff = abs((ustarNew - ustar)/ustarNew) + ustarDiff = abs(ustarNew - ustar)/max(abs(ustarNew), tiny(one)) ustar = ustarNew; idx = idx + 1 end do this%ustar = ustar; this%invObLength = Linv; this%wTh_surf = wTh @@ -430,7 +475,7 @@ subroutine getSurfaceQuantities(this) PsiM = two*log(half*(one+xi)) + log(half*(one+xisq)) - two*atan(xi) + piby2; PsiH = two*log(half*(one+xisq)); endif - ustarDiff = abs((ustarNew - ustar)/ustarNew) + ustarDiff = abs(ustarNew - ustar)/max(abs(ustarNew), tiny(one)) ustar = ustarNew; idx = idx + 1 end do this%ustar = ustar; this%invObLength = Linv; diff --git a/src/incompressible/spectral.F90 b/src/incompressible/spectral.F90 index 8a4ff9f4..e885dcad 100644 --- a/src/incompressible/spectral.F90 +++ b/src/incompressible/spectral.F90 @@ -57,11 +57,11 @@ module spectralMod logical :: BandPassFilterInitialized = .false. logical :: TestFilterInitialized = .false. logical :: initPostProcessor = .false. - integer(kind=8) :: plan_c2c_fwd_z_oop - integer(kind=8) :: plan_c2c_fwd_z_ip - integer(kind=8) :: plan_c2c_bwd_z_oop - integer(kind=8) :: plan_c2c_bwd_z_ip - integer(kind=8) :: plan_r2c_z, plan_c2r_z + integer(kind=8) :: plan_c2c_fwd_z_oop = 0 + integer(kind=8) :: plan_c2c_fwd_z_ip = 0 + integer(kind=8) :: plan_c2c_bwd_z_oop = 0 + integer(kind=8) :: plan_c2c_bwd_z_ip = 0 + integer(kind=8) :: plan_r2c_z = 0, plan_c2r_z = 0 complex(rkind), dimension(:), allocatable :: k3_C2Cder, k3_C2Eshift, k3_E2Cshift, E2Cshift, C2Eshift, xshiftfact real(rkind), dimension(:), allocatable, public :: k1inZ, k2inZ, k3inZ @@ -1633,7 +1633,7 @@ subroutine InitTestFilter(this, filtfact) !end if kdealiasx = ((two/three)*pi/this%dx) kdealiasy = ((two/three)*pi/this%dy) - kdealiasy = ((two/three)*pi/this%dz) + kdealiasz = ((two/three)*pi/this%dz) kfiltx = kdealiasx/filtfact kfilty = kdealiasy/filtfact @@ -1701,6 +1701,33 @@ subroutine destroy(this) if (allocated(this%arr1Up)) deallocate(this%arr1Up) if (allocated(this%arr2Up)) deallocate(this%arr2Up) + if (allocated(this%GTestFilt)) deallocate(this%GTestFilt) + if (allocated(this%GksPrep1)) deallocate(this%GksPrep1) + if (allocated(this%GksPrep2)) deallocate(this%GksPrep2) + if (allocated(this%GhitForcing)) deallocate(this%GhitForcing) + if (allocated(this%G_bandpass)) deallocate(this%G_bandpass) + if (allocated(this%G_PostProcess)) deallocate(this%G_PostProcess) + if (allocated(this%fhatz)) deallocate(this%fhatz) + if (allocated(this%ctmpz)) deallocate(this%ctmpz) + if (allocated(this%k3_C2Cder)) deallocate(this%k3_C2Cder) + if (allocated(this%k3_C2Eshift)) deallocate(this%k3_C2Eshift) + if (allocated(this%k3_E2Cshift)) deallocate(this%k3_E2Cshift) + if (allocated(this%E2Cshift)) deallocate(this%E2Cshift) + if (allocated(this%C2Eshift)) deallocate(this%C2Eshift) + if (allocated(this%xshiftfact)) deallocate(this%xshiftfact) + if (allocated(this%k1inZ)) deallocate(this%k1inZ) + if (allocated(this%k2inZ)) deallocate(this%k2inZ) + if (allocated(this%k3inZ)) deallocate(this%k3inZ) + if (allocated(this%mk3sq)) deallocate(this%mk3sq) + if (this%plan_c2c_fwd_z_oop /= 0) call dfftw_destroy_plan(this%plan_c2c_fwd_z_oop) + if (this%plan_c2c_fwd_z_ip /= 0) call dfftw_destroy_plan(this%plan_c2c_fwd_z_ip) + if (this%plan_c2c_bwd_z_oop /= 0) call dfftw_destroy_plan(this%plan_c2c_bwd_z_oop) + if (this%plan_c2c_bwd_z_ip /= 0) call dfftw_destroy_plan(this%plan_c2c_bwd_z_ip) + if (this%plan_r2c_z /= 0) call dfftw_destroy_plan(this%plan_r2c_z) + if (this%plan_c2r_z /= 0) call dfftw_destroy_plan(this%plan_c2r_z) + nullify(this%cbuffz_bp, this%cbuffy_bp) + if (allocated(this%physdecomp)) deallocate(this%physdecomp) + if (allocated(this%dealiasdecomp)) deallocate(this%dealiasdecomp) if (allocated(this%spectdecomp)) deallocate(this%spectdecomp) this%isInitialized = .false. diff --git a/src/incompressible/staggOps.F90 b/src/incompressible/staggOps.F90 index e484cabf..e63d0dc2 100644 --- a/src/incompressible/staggOps.F90 +++ b/src/incompressible/staggOps.F90 @@ -338,6 +338,7 @@ pure subroutine d2dz2_E2E_real(this,fE,d2fdz2E, isTopEven, isBotEven) subroutine init(this, gpC, gpE, stagg_scheme , dx, dy, dz, gpCspect, gpEspect, isTopSided, isBotSided, isPeriodic) + use exits, only: GracefulExit class(staggOps), intent(inout) :: this class(decomp_info), intent(in), target:: gpC, gpE integer, intent(in) :: stagg_scheme @@ -358,6 +359,12 @@ subroutine init(this, gpC, gpE, stagg_scheme , dx, dy, dz, gpCspect, gpEspect, i this%nxE = gpE%zsz(1) this%nyE = gpE%zsz(2) this%nzE = gpE%zsz(3) + if (this%nzC < 3) then + call GracefulExit("Staggered z operators require at least three cell-centered planes.", 123) + end if + if (this%nzE /= this%nzC + 1) then + call GracefulExit("Staggered z descriptors require nzE = nzC + 1.", 123) + end if this%nxC_cmplx = 0 this%nyC_cmplx = 0 diff --git a/src/incompressible/turbineMod.F90 b/src/incompressible/turbineMod.F90 index 74c75a99..67c46069 100644 --- a/src/incompressible/turbineMod.F90 +++ b/src/incompressible/turbineMod.F90 @@ -365,11 +365,17 @@ subroutine destroy(this) class(TurbineArray), intent(inout) :: this integer :: i - nullify(this%gpC, this%gpE, this%spectC, this%sp_gpC) + nullify(this%gpC, this%gpE, this%sp_gpC, this%sp_gpE, this%spectC, this%spectE) nullify(this%zbuffC, this%zbuffE, this%fChat, this%fEhat) - deallocate(this%fx, this%fy, this%fz) - - deallocate(this%OpsNU) + nullify(this%u_ref_sim, this%v_ref_sim, this%gpC_ref_sim) + if (allocated(this%fx)) deallocate(this%fx) + if (allocated(this%fy)) deallocate(this%fy) + if (allocated(this%fz)) deallocate(this%fz) + + if (allocated(this%OpsNU)) then + call this%OpsNU%destroy() + deallocate(this%OpsNU) + end if !if(ADM) then select case (this%ADM_Type) @@ -393,11 +399,16 @@ subroutine destroy(this) do i = 1, this%nTurbines call this%turbArrayADM_fil(i)%destroy() end do + if (allocated(this%turbArrayADM_fil)) deallocate(this%turbArrayADM_fil) + if (allocated(this%dynamicArray)) deallocate(this%dynamicArray) case (6) do i = 1, this%nTurbines call this%turbArrayADM_ct(i)%destroy() end do end select + if (allocated(this%gamma)) deallocate(this%gamma) + if (allocated(this%gamma_nm1)) deallocate(this%gamma_nm1) + if (allocated(this%theta)) deallocate(this%theta) !deallocate(this%turbArrayADM) !else ! call this%destroy_halo_communication() @@ -571,6 +582,10 @@ subroutine getForceRHS(this, dt, u, v, wC, urhs, vrhs, wrhs, newTimeStep, inst_h integer :: alpha_index logical :: callTimeAdvance + ! Filtered ADM does not produce the legacy eight-value diagnostic block. + ! Zero is safer for time accumulation than leaving INTENT(OUT) undefined. + inst_horz_avg = zero + if (newTimeStep) then this%fx = zero; this%fy = zero; this%fz = zero select case (this%ADM_Type) From 5b809527ca66b531f658bfcad05b82a54da0c8de Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 8 Jun 2026 15:43:59 +0100 Subject: [PATCH 102/114] GNU compiler works well now --- CMakeLists.txt | 11 +++-------- setup/SetupEnv_Archer2.sh | 6 ++++-- src/CMakeLists.txt | 20 ++++++++++---------- 3 files changed, 17 insertions(+), 20 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 6e9f9a6a..27becbb1 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -68,17 +68,12 @@ elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU_OSX") elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") if ( CMAKE_BUILD_TYPE MATCHES "Release" ) if ($ENV{ARCH_OPT_FLAG}) - # set(OPTFLAG "-march=native") set(OPTFLAG $ENV{ARCH_OPT_FLAG}) else() - set(OPTFLAG $ENV{ARCH_OPT_FLAG}) + set(OPTFLAG "-march=native") endif() - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Wall -Wconversion -Wsurprising -Wextra -Waliasing \ - -ffree-form -ffree-line-length-none -ffast-math ${OPTFLAG} \ - -fopenmp -fallow-argument-mismatch \ - -finit-local-zero \ - ") - # -finit-integer=0 -finit-real=zero -finit-local-zero -finit-derived + #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O3 -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") + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O3 -Wall -Wconversion -Wextra -Waliasing -ffree-form -ffree-line-length-none ${OPTFLAG} -funroll-loops -fopenmp -fallow-argument-mismatch -finit-integer=0 -finit-real=zero") elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) 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() diff --git a/setup/SetupEnv_Archer2.sh b/setup/SetupEnv_Archer2.sh index 4dab04f2..0a65e167 100644 --- a/setup/SetupEnv_Archer2.sh +++ b/setup/SetupEnv_Archer2.sh @@ -7,6 +7,7 @@ module load PrgEnv-gnu module load craype-x86-rome module load cray-libsci module load cray-fftw +module load cmake module load cray-hdf5-parallel module list @@ -29,7 +30,8 @@ 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}${CMAKE_PREFIX_PATH:+:${CMAKE_PREFIX_PATH}}" -export MPICH_OFI_STARTUP_CONNECT=1 # --- Architecture flags --- -export ARCH_OPT_FLAG="" +export ARCH_OPT_FLAG="-march=native" + +export OMP_NUM_THREADS=1 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7ee06568..20f2af30 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -27,20 +27,20 @@ elseif( CMAKE_Fortran_COMPILER_ID MATCHES "Cray" ) elseif( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD" ) 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) elseif( CMAKE_Fortran_COMPILER_ID MATCHES "GNU" ) - target_link_libraries(PadeOps - fftw3 - 2decomp_fft - $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu_mpi.so - ${HDF5_LIBRARY_PATH}/libhdf5hl_fortran_parallel_gnu_91.so - ${HDF5_LIBRARY_PATH}/libhdf5_hl_parallel_gnu_91.so - ${HDF5_LIBRARY_PATH}/libhdf5_fortran_parallel_gnu_91.so - ${HDF5_LIBRARY_PATH}/libhdf5_parallel_gnu_91.so - -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}) else() # 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}) +elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") + # 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_mpi.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}) +endif() if (MPI_Fortran_COMPILER_FLAGS) set_target_properties(PadeOps PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") From 463d0bb1e071c75ef86d7a9216eebf126d396599 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 8 Jun 2026 11:23:01 -0400 Subject: [PATCH 103/114] remove vtk from intel CMake --- src/CMakeLists.txt | 17 +++++------------ 1 file changed, 5 insertions(+), 12 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 20f2af30..c9f61f43 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -20,27 +20,20 @@ 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 ${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) elseif( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD" ) 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) elseif( CMAKE_Fortran_COMPILER_ID MATCHES "GNU" ) - 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}) + target_link_libraries(PadeOps fftw3 2decomp_fft $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu_mpi.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}) +elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU_OSX") + target_link_libraries(PadeOps fftw3 2decomp_fft blas lapack ${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}) else() - # 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}) -elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "GNU") - # 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_mpi.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}) -endif() if (MPI_Fortran_COMPILER_FLAGS) set_target_properties(PadeOps PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") From 4be57752891ac44786db80bd2292aa2741012ad5 Mon Sep 17 00:00:00 2001 From: Karim Ali <41688083+karimali5@users.noreply.github.com> Date: Wed, 10 Jun 2026 11:56:08 -0400 Subject: [PATCH 104/114] Rename parameters p_row and p_col to prow and pool in refine_fields --- problems/incompressible/refine_fields.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/problems/incompressible/refine_fields.F90 b/problems/incompressible/refine_fields.F90 index 2ed4b7dd..4a8b5525 100644 --- a/problems/incompressible/refine_fields.F90 +++ b/problems/incompressible/refine_fields.F90 @@ -557,11 +557,11 @@ subroutine refine_z_physical(field_c, field_f, dz_c, staggered, bottom_flag, top end subroutine refine_z_physical - subroutine initializeEverything(Lx, Ly, Lz, nx, ny, nz, p_row, p_col, & + subroutine initializeEverything(Lx, Ly, Lz, nx, ny, nz, prow, pcol, & 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) :: nx, ny, nz, prow, pcol integer, intent(in) :: NumericalSchemeVert, botWall, TopWall, botBC_Temp, topBC_Temp integer :: nx_f, ny_f, nz_f real(rkind) :: dx, dy, dz @@ -578,7 +578,7 @@ subroutine initializeEverything(Lx, Ly, Lz, nx, ny, nz, p_row, p_col, & !----------------------------------------------------------------------------- ! Initialize decomp2d for the original (coarse) grid !----------------------------------------------------------------------------- - call decomp_2d_init(nx, ny, nz, p_row, p_col) + call decomp_2d_init(nx, ny, nz, prow, pcol) ! Get local decomposition info for array allocation ! Cell-centered grids @@ -736,7 +736,7 @@ program refine_fields ! Grid parameters integer :: nx, ny, nz - integer :: ierr, ioUnit, p_row=0, p_col=0 + integer :: ierr, ioUnit, prow=0, pcol=0 real(rkind) :: Lx, Ly, Lz, dz character(len=clen) :: inputfile character(len=clen) :: outputdir, inputdir @@ -746,7 +746,7 @@ program refine_fields 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, & + outputFile_TID, outputFile_RID, isStratified, prow, pcol, & NumericalSchemeVert, botWall, TopWall, botBC_Temp, topBC_Temp call MPI_Init(ierr) !<-- Begin MPI @@ -759,7 +759,7 @@ program refine_fields dz = Lz / real(nz, rkind) - call initializeEverything(Lx, Ly, Lz, nx, ny, nz, p_row, p_col, & + call initializeEverything(Lx, Ly, Lz, nx, ny, nz, prow, pcol, & NumericalSchemeVert, botWall, TopWall, botBC_Temp, topBC_Temp) !---------------------------------------------------------- @@ -792,4 +792,4 @@ program refine_fields call cleanup() call MPI_FINALIZE(ierr) -end program refine_fields \ No newline at end of file +end program refine_fields From 47201fdbb49470817a89582c2080dbfc13e5323d Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 18 Jun 2026 15:49:20 -0400 Subject: [PATCH 105/114] overload budget0 in time_avg_budget with fields from budget1 when squeeze is on --- src/incompressible/budget_time_avg.F90 | 154 ++++++++++++++++--------- 1 file changed, 98 insertions(+), 56 deletions(-) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 25fda7da..8f5f1c73 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -471,28 +471,28 @@ subroutine DumpBudget(this) class(budgets_time_avg), intent(inout) :: this ! MKE budget is only assembled before dumping - if (this%budgetType>1) call this%AssembleBudget2() + if ((this%budgetType>1) .and. (.not. this%squeeze)) call this%AssembleBudget2() ! Budget 0: call this%dumpbudget0() ! Budget 1: - if (this%budgetType>0) then + if ((this%budgetType>0) .and. (.not. this%squeeze)) then call this%dumpbudget1() end if ! Budget 2: - if (this%budgetType>1) then + if ((this%budgetType>1) .and. (.not. this%squeeze)) then call this%dumpbudget2() end if ! Budget 3: - if (this%budgetType>2) then + if ((this%budgetType>2) .and. (.not. this%squeeze)) then call this%dumpbudget3() end if ! Budget 4: - if (this%budgetType>3) then + if ((this%budgetType>3) .and. (.not. this%squeeze)) then call this%dumpbudget4_11() call this%dumpbudget4_22() call this%dumpbudget4_33() @@ -520,29 +520,31 @@ subroutine DumpBudget0(this) this%budget_0(:,:,:,8) = this%budget_0(:,:,:,8) - this%budget_0(:,:,:,2)*this%budget_0(:,:,:,3) ! R23 this%budget_0(:,:,:,9) = this%budget_0(:,:,:,9) - this%budget_0(:,:,:,3)*this%budget_0(:,:,:,3) ! R33 - ! Step 3: Pressure transport for TKE budget - this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) - this%budget_0(:,:,:,1)*this%budget_0(:,:,:,10) - this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) - this%budget_0(:,:,:,2)*this%budget_0(:,:,:,10) - this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) - this%budget_0(:,:,:,3)*this%budget_0(:,:,:,10) - - ! Step 4: Turbulent convective transport for TKE budget - this%igrid_sim%rbuffxC(:,:,:,1) = half*(this%budget_0(:,:,:,4) + this%budget_0(:,:,:,7) + this%budget_0(:,:,:,9)) - this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) - this%budget_0(:,:,:,1)*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(:,:,:,22) = this%budget_0(:,:,:,22) - this%budget_0(:,:,:,3)*this%igrid_sim%rbuffxC(:,:,:,1) - - ! STEP 5: SGS flux for TKE transport - 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%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(:,:,:,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) + if (.not. this%squeeze) then + ! Step 3: Pressure transport for TKE budget + this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) - this%budget_0(:,:,:,1)*this%budget_0(:,:,:,10) + this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) - this%budget_0(:,:,:,2)*this%budget_0(:,:,:,10) + this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) - this%budget_0(:,:,:,3)*this%budget_0(:,:,:,10) + + ! Step 4: Turbulent convective transport for TKE budget + this%igrid_sim%rbuffxC(:,:,:,1) = half*(this%budget_0(:,:,:,4) + this%budget_0(:,:,:,7) + this%budget_0(:,:,:,9)) + this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) - this%budget_0(:,:,:,1)*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(:,:,:,22) = this%budget_0(:,:,:,22) - this%budget_0(:,:,:,3)*this%igrid_sim%rbuffxC(:,:,:,1) + + ! STEP 5: SGS flux for TKE transport + 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%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(:,:,:,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) + end if ! STEP 6a: Potential temperature terms for stratified flow if (this%isStratified) then @@ -564,7 +566,7 @@ 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 + if((idx <= 26) .or. (idx == 31))then continue else cycle @@ -574,26 +576,28 @@ subroutine DumpBudget0(this) end do ! Step 8: Go back to summing - 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 @@ -657,7 +661,49 @@ 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 - if(.not. this%squeeze)then + if(this%squeeze)then + call this%igrid_sim%spectC%ifft(this%px,this%igrid_sim%rbuffxC(:,:,:,1)) + this%budget_0(:,:,:,17) = this%budget_0(:,:,:,17) - this%igrid_sim%rbuffxC(:,:,:,1) ! px (sign is reversed here) + call this%igrid_sim%spectC%ifft(this%py,this%igrid_sim%rbuffxC(:,:,:,1)) + + this%budget_0(:,:,:,18) = this%budget_0(:,:,:,18) - this%igrid_sim%rbuffxC(:,:,:,1) ! py (sign is reversed here) + call this%igrid_sim%spectE%ifft(this%pz,this%igrid_sim%rbuffxE(:,:,:,1)) + + call this%interp_Edge2Cell(this%igrid_sim%rbuffxE(:,:,:,1), this%igrid_sim%rbuffxC(:,:,:,1)) + this%budget_0(:,:,:,19) = this%budget_0(:,:,:,19) - this%igrid_sim%rbuffxC(:,:,:,1) ! pz (sign is reversed here) + + call this%igrid_sim%spectC%ifft(this%usgs,this%igrid_sim%rbuffxC(:,:,:,1)) + this%budget_0(:,:,:,20) = this%budget_0(:,:,:,20) - this%igrid_sim%rbuffxC(:,:,:,1) ! usgs (sign is reversed here) + + call this%igrid_sim%spectC%ifft(this%vsgs,this%igrid_sim%rbuffxC(:,:,:,1)) + this%budget_0(:,:,:,21) = this%budget_0(:,:,:,21) - this%igrid_sim%rbuffxC(:,:,:,1) ! vsgs (sign is reversed here) + + call this%igrid_sim%spectE%ifft(this%wsgs,this%igrid_sim%rbuffxE(:,:,:,1)) + call this%interp_Edge2Cell(this%igrid_sim%rbuffxE(:,:,:,1), this%igrid_sim%rbuffxC(:,:,:,1)) + this%budget_0(:,:,:,22) = this%budget_0(:,:,:,22) - this%igrid_sim%rbuffxC(:,:,:,1) ! wsgs (sign is reversed here) + + if (this%useCoriolis) then + ! Get the geostrophic forcing + call this%igrid_sim%get_geostrophic_forcing(this%igrid_sim%rbuffxC(:,:,:,2), this%igrid_sim%rbuffxC(:,:,:,3)) ! Forcing in x and y directions respectively + + ! Coriolis term, X + call this%igrid_sim%spectC%ifft(this%ucor,this%igrid_sim%rbuffxC(:,:,:,1)) + this%budget_0(:,:,:,23) = this%budget_0(:,:,:,23) + this%igrid_sim%rbuffxC(:,:,:,1) - this%igrid_sim%rbuffxC(:,:,:,2) ! Remove the geostrophic forcing term + + ! Coriolis term, Y + call this%igrid_sim%spectC%ifft(this%vcor,this%igrid_sim%rbuffxC(:,:,:,1)) + this%budget_0(:,:,:,24) = this%budget_0(:,:,:,24) + this%igrid_sim%rbuffxC(:,:,:,1) - this%igrid_sim%rbuffxC(:,:,:,3) ! Remove the geostrophic forcing term + + end if + + ! Buoyancy + if (this%isStratified) then + 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(:,:,:,25) = this%budget_0(:,:,:,25) + this%igrid_sim%rbuffxC(:,:,:,1) + end if + + else 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 @@ -2192,11 +2238,7 @@ subroutine restartBudget(this, dir, rid, tid, cid) 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 + if(.not. ((idx <= 26) .or. (idx == 31)))cycle end if call this%restart_budget_field(this%budget_0(:,:,:,idx), dir, rid, tid, cid, 0, idx) end do @@ -2241,7 +2283,7 @@ subroutine restartBudget(this, dir, rid, tid, cid) this%budget_0(:,:,:,30) = this%budget_0(:,:,:,30) + this%budget_0(:,:,:,26)*this%budget_0(:,:,:,26) end if ! Step 10b: Scalar variances - if (this%HaveScalars) then + if (this%HaveScalars .and. (.not. this%squeeze)) then do idx = 1,this%igrid_sim%n_scalars this%budget_0(:,:,:,30+this%igrid_sim%n_scalars+idx) = & this%budget_0(:,:,:,30+this%igrid_sim%n_scalars+idx) + & From fd04d7a1bc011157136a728bdaea83746f4b6d22 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Thu, 18 Jun 2026 17:34:35 -0400 Subject: [PATCH 106/114] Add MKE budget --- .../ConstructDeficitBudgets.F90 | 289 ++++++++++++++---- 1 file changed, 225 insertions(+), 64 deletions(-) diff --git a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 index 78d62471..616914a4 100644 --- a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 @@ -35,13 +35,14 @@ module constructDeficitBudgets_mod 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 + integer :: budgettype=1 ! 1: x-Momentum, 2: y-Momentum, 3: z-Momentum, 4: TKE, 5: MKE 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 + real(rkind), dimension(:,:,:), pointer :: du, dv, dw, ubase, vbase, wbase character(len=:), allocatable :: sorted_keys(:), sorted_stamps(:) logical :: do_box_averaging=.true. @@ -70,6 +71,8 @@ subroutine export_csv(key, stamp) name = 'Z' case(4) name = 'TKE' + case(5) + name = 'MKE' end select write(crid, '(I2.2)') RID @@ -146,6 +149,9 @@ subroutine compute_budgets(key, stamp) case(4) call compute_TKE_budget_component(idx, buffer) additional = '4' + case(5) + call compute_MKE_budget_component(idx, buffer) + additional = '8' end select ! Average this budget term across the box @@ -173,6 +179,9 @@ function depedent_variable(idx) elseif(budgettype == 4)then ! TKE equation if(idx <= 12) depedent_variable = .true. + elseif(budgettype == 5)then + ! MKE equation + depedent_variable = .true. end if end function depedent_variable @@ -189,31 +198,31 @@ subroutine compute_X_budget_component(idx, buffer) select case(idx) case(1) ! Advection: delta u_1 * partial_1 (delta u_1) - buffer = budget0(:,:,:,1) * dudx + buffer = du * dudx case(2) ! Advection: delta u_2 * partial_2 (delta u_1) - buffer = budget0(:,:,:,2) * dudy + buffer = dv * dudy case(3) ! Advection: delta u_3 * partial_3 (delta u_1) - buffer = budget0(:,:,:,3) * dudz + buffer = dw * dudz case(4) ! Advection: delta u_1 * partial_1 (base u_1) - buffer = budget0(:,:,:,1) * dudx_base + buffer = du * dudx_base case(5) ! Advection: delta u_2 * partial_2 (base u_1) - buffer = budget0(:,:,:,2) * dudy_base + buffer = dv * dudy_base case(6) ! Advection: delta u_3 * partial_3 (base u_1) - buffer = budget0(:,:,:,3) * dudz_base + buffer = dw * dudz_base case(7) ! Advection: base u_1 * partial_1 (delta u_1) - buffer = baseBudget0(:,:,:,1) * dudx + buffer = ubase * dudx case(8) ! Advection: base u_2 * partial_2 (delta u_1) - buffer = baseBudget0(:,:,:,2) * dudy + buffer = vbase * dudy case(9) ! Advection: base u_3 * partial_3 (delta u_1) - buffer = baseBudget0(:,:,:,3) * dudz + buffer = wbase * dudz case(10) ! pressure gradient: partial_1 (delta p) buffer = budget0(:,:,:,18) @@ -278,31 +287,31 @@ subroutine compute_Y_budget_component(idx, buffer) select case(idx) case(1) ! Advection: delta u_1 * partial_1 (delta u_2) - buffer = budget0(:,:,:,1) * dvdx + buffer = du * dvdx case(2) ! Advection: delta u_2 * partial_2 (delta u_2) - buffer = budget0(:,:,:,2) * dvdy + buffer = dv * dvdy case(3) ! Advection: delta u_3 * partial_3 (delta u_2) - buffer = budget0(:,:,:,3) * dvdz + buffer = dw * dvdz case(4) ! Advection: delta u_1 * partial_1 (base u_2) - buffer = budget0(:,:,:,1) * dvdx_base + buffer = du * dvdx_base case(5) ! Advection: delta u_2 * partial_2 (base u_2) - buffer = budget0(:,:,:,2) * dvdy_base + buffer = dv * dvdy_base case(6) ! Advection: delta u_3 * partial_3 (base u_2) - buffer = budget0(:,:,:,3) * dvdz_base + buffer = dw * dvdz_base case(7) ! Advection: base u_1 * partial_1 (delta u_2) - buffer = baseBudget0(:,:,:,1) * dvdx + buffer = ubase * dvdx case(8) ! Advection: base u_2 * partial_2 (delta u_2) - buffer = baseBudget0(:,:,:,2) * dvdy + buffer = vbase * dvdy case(9) ! Advection: base u_3 * partial_3 (delta u_2) - buffer = baseBudget0(:,:,:,3) * dvdz + buffer = wbase * dvdz case(10) ! pressure gradient: partial_2 (delta p) buffer = budget0(:,:,:,19) @@ -367,31 +376,31 @@ subroutine compute_Z_budget_component(idx, buffer) select case(idx) case(1) ! Advection: delta u_1 * partial_1 (delta u_3) - buffer = budget0(:,:,:,1) * dwdx + buffer = du * dwdx case(2) ! Advection: delta u_2 * partial_2 (delta u_3) - buffer = budget0(:,:,:,2) * dwdy + buffer = dv * dwdy case(3) ! Advection: delta u_3 * partial_3 (delta u_3) - buffer = budget0(:,:,:,3) * dwdz + buffer = dw * dwdz case(4) ! Advection: delta u_1 * partial_1 (base u_3) - buffer = budget0(:,:,:,1) * dwdx_base + buffer = du * dwdx_base case(5) ! Advection: delta u_2 * partial_2 (base u_3) - buffer = budget0(:,:,:,2) * dwdy_base + buffer = dv * dwdy_base case(6) ! Advection: delta u_3 * partial_3 (base u_3) - buffer = budget0(:,:,:,3) * dwdz_base + buffer = dw * dwdz_base case(7) ! Advection: base u_1 * partial_1 (delta u_3) - buffer = baseBudget0(:,:,:,1) * dwdx + buffer = ubase * dwdx case(8) ! Advection: base u_2 * partial_2 (delta u_3) - buffer = baseBudget0(:,:,:,2) * dwdy + buffer = vbase * dwdy case(9) ! Advection: base u_3 * partial_3 (delta u_3) - buffer = baseBudget0(:,:,:,3) * dwdz + buffer = wbase * dwdz case(10) ! pressure gradient: partial_3 (delta p) buffer = budget0(:,:,:,20) @@ -457,37 +466,37 @@ subroutine compute_TKE_budget_component(idx, buffer) 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 + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*du + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*dv + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*dw ! 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 + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*du + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*dv + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*dw ! 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 + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*du + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*dv + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*dw ! 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 + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*ubase + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*vbase + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*wbase ! 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 + call ddx_R2R(BF1, BF2); buffer = buffer + BF2*ubase + call ddy_R2R(BF1, BF2); buffer = buffer + BF2*vbase + call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*wbase ! BF1 is even case(6) ! Production: mean(delta u_i' delta u_j') partial_j mean(delta u_i) @@ -605,6 +614,143 @@ subroutine compute_TKE_budget_component(idx, buffer) nullify(BF1, BF2) end subroutine + subroutine compute_MKE_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_i base u_j partial_j base u_i + buffer = du * (dudx_base * ubase + dudy_base * vbase + dudz_base * wbase) + & + dv * (dvdx_base * ubase + dvdy_base * vbase + dvdz_base * wbase) + & + dw * (dwdx_base * ubase + dwdy_base * vbase + dwdz_base * wbase) + case(2) + ! Advection: base u_i base u_j partial_j delta u_i + buffer = ubase * (dudx * ubase + dudy * vbase + dudz * wbase) + & + vbase * (dvdx * ubase + dvdy * vbase + dvdz * wbase) + & + wbase * (dwdx * ubase + dwdy * vbase + dwdz * wbase) + + case(3) + ! Advection: delta u_i base u_j partial_j delta u_i + buffer = du * (dudx * ubase + dudy * vbase + dudz * wbase) + & + dv * (dvdx * ubase + dvdy * vbase + dvdz * wbase) + & + dw * (dwdx * ubase + dwdy * vbase + dwdz * wbase) + + case(4) + ! Advection: base u_i delta u_j partial_j base u_i + buffer = ubase * (dudx_base * du + dudy_base * dv + dudz_base * dw) + & + vbase * (dvdx_base * du + dvdy_base * dv + dvdz_base * dw) + & + wbase * (dwdx_base * du + dwdy_base * dv + dwdz_base * dw) + + case(5) + ! Advection: delta u_i delta u_j partial_j base u_i + buffer = du * (dudx_base * du + dudy_base * dv + dudz_base * dw) + & + dv * (dvdx_base * du + dvdy_base * dv + dvdz_base * dw) + & + dw * (dwdx_base * du + dwdy_base * dv + dwdz_base * dw) + + case(6) + ! Advection: base u_i delta u_j partial_j delta u_i + buffer = ubase * (dudx * du + dudy * dv + dudz * dw) + & + vbase * (dvdx * du + dvdy * dv + dvdz * dw) + & + wbase * (dwdx * du + dwdy * dv + dwdz * dw) + + case(7) + ! Advection: delta u_i delta u_j partial_j delta u_i + buffer = du * (dudx * du + dudy * dv + dudz * dw) + & + dv * (dvdx * du + dvdy * dv + dvdz * dw) + & + dw * (dwdx * du + dwdy * dv + dwdz * dw) + + case(8) + ! Buoyancy: delta wb * delta w + buffer = budget0(:,:,:,17) * dw + + case(9) + ! Buoyancy: delta wb * base w + buffer = budget0(:,:,:,17) * wbase + + case(10) + ! Buoyancy: base wb * delta w + ! Make sure that squeeze was .true. in the main simulation + ! This is overloading an existing budget term in budget0. + buffer = baseBudget0(:,:,:,25) * dw + + case(11) + ! Pressure gradient: delta u_i * d_i delta p + buffer = du * budget0(:,:,:,18) + dv * budget0(:,:,:,19) + dw * budget0(:,:,:,20) + + case(12) + ! Pressure gradient: base u_i * d_i delta p + buffer = ubase * budget0(:,:,:,18) + vbase * budget0(:,:,:,19) + wbase * budget0(:,:,:,20) + + case(13) + ! Pressure gradient: delta u_i * d_i base p + ! Make sure that squeeze was .true. in the main simulation + buffer = du * baseBudget0(:,:,:,17) + dv * baseBudget0(:,:,:,18) + dw * baseBudget0(:,:,:,19) + + case(14) + ! SGS stresses: delta u_i * d_j delta tau_ij + buffer = du * budget0(:,:,:,12) + dv * budget0(:,:,:,13) + dw * budget0(:,:,:,14) + + case(15) + ! SGS stresses: base u_i * d_j delta tau_ij + buffer = ubase * budget0(:,:,:,12) + vbase * budget0(:,:,:,13) + wbase * budget0(:,:,:,14) + + case(16) + ! SGS stresses: delta u_i * d_j base tau_ij + ! Make sure that squeeze was .true. in the main simulation + buffer = du * baseBudget0(:,:,:,20) + dv * baseBudget0(:,:,:,21) + dw * baseBudget0(:,:,:,22) + + case(17) + ! Production: delta u_i * mean(delta u_j' d_j delta u_i') + buffer = du * budget2(:,:,:,1) + dv * budget2(:,:,:,2) + dw * budget2(:,:,:,3) + + case(18) + ! Production: delta u_i * mean(delta u_j' d_j base u_i') + buffer = du * budget2(:,:,:,4) + dv * budget2(:,:,:,5) + dw * budget2(:,:,:,6) + + case(19) + ! Production: delta u_i * mean(base u_j' d_j delta u_i') + buffer = du * budget2(:,:,:,7) + dv * budget2(:,:,:,8) + dw * budget2(:,:,:,9) + + case(20) + ! Production: delta u_i * mean(base u_j' d_j base u_i') + buffer = du * budget2(:,:,:,10) + dv * budget2(:,:,:,11) + dw * budget2(:,:,:,12) + + case(21) + ! Production: base u_i * mean(delta u_j' d_j delta u_i') + buffer = ubase * budget2(:,:,:,1) + vbase * budget2(:,:,:,2) + wbase * budget2(:,:,:,3) + + case(22) + ! Production: base u_i * mean(delta u_j' d_j base u_i') + buffer = ubase * budget2(:,:,:,4) + vbase * budget2(:,:,:,5) + wbase * budget2(:,:,:,6) + + case(23) + ! Production: base u_i * mean(base u_j' d_j delta u_i') + buffer = ubase * budget2(:,:,:,7) + vbase * budget2(:,:,:,8) + wbase * budget2(:,:,:,9) + + case(24) + ! Coriolis: delta u_i * delta ucor_i + buffer = du * budget0(:,:,:,15) + dv * budget0(:,:,:,16) + + case(25) + ! Coriolis: delta u_i * base ucor_i + ! Make sure that squeeze was .true. in the main simulation + buffer = du * baseBudget0(:,:,:,23) + dv * baseBudget0(:,:,:,24) + + case(26) + ! Coriolis: base u_i * delta ucor_i + buffer = ubase * budget0(:,:,:,15) + vbase * budget0(:,:,:,16) + end select + + nullify(BF1, BF2) + end subroutine + subroutine resetEverything() implicit none @@ -744,25 +890,25 @@ 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) + call ddx_R2R(du, dudx) + call ddy_R2R(du, dudy) + call ddz_R2R(du, dudz, uBC_bottom, uBC_top) + call ddx_R2R(dv, dvdx) + call ddy_R2R(dv, dvdy) + call ddz_R2R(dv, dvdz, vBC_bottom, vBC_top) + call ddx_R2R(dw, dwdx) + call ddy_R2R(dw, dwdy) + call ddz_R2R(dw, dwdz, wBC_bottom, wBC_top) + + call ddx_R2R(ubase, dudx_base) + call ddy_R2R(ubase, dudy_base) + call ddz_R2R(ubase, dudz_base, uBC_bottom, uBC_top) + call ddx_R2R(vbase, dvdx_base) + call ddy_R2R(vbase, dvdy_base) + call ddz_R2R(vbase, dvdz_base, vBC_bottom, vBC_top) + call ddx_R2R(wbase, dwdx_base) + call ddy_R2R(wbase, dwdy_base) + call ddz_R2R(wbase, dwdz_base, wBC_bottom, wBC_top) end subroutine subroutine get_boundary_conditions_stencil() @@ -854,7 +1000,12 @@ subroutine readBudgets(key, stamp) end do call message(1, 'Reading base flow budget 0') - do idx = 1,9 + do idx = 1,31 + if((idx <= 26) .or. (idx == 31))then + continue + else + cycle + end if pattern = getPattern(BRID, 0, idx, key=key, stamp=stamp, isBase=.True.) filename = trim(inputdir)//'/'//trim(pattern) inquire(file=trim(filename), exist=exists) @@ -1335,7 +1486,7 @@ subroutine initializeEverything() 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(baseBudget0(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 31)) ! Allocate Buffers allocate(rbuffxC(gpC%xsz(1),gpC%xsz(2),gpC%xsz(3), 3)) @@ -1381,6 +1532,8 @@ subroutine initializeEverything() num_profiles = 24 case(4) num_profiles = 31 + case(5) + num_profiles = 26 end select allocate(profiles(nx_box, num_profiles)) @@ -1405,6 +1558,13 @@ subroutine initializeEverything() dwdy_base => duidxj_base(:,:,:,8) dwdz_base => duidxj_base(:,:,:,9) + du => budget0(:,:,:,1) + dv => budget0(:,:,:,2) + dw => budget0(:,:,:,3) + ubase => baseBudget0(:,:,:,1) + vbase => baseBudget0(:,:,:,2) + wbase => baseBudget0(:,:,:,3) + call resetEverything() end subroutine @@ -1421,6 +1581,7 @@ subroutine release_memory() 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) + nullify(du, dv, dw, ubase, vbase, wbase) call spectC%destroy() call spectE%destroy() From 55a85ba8f38aafd20571a0185b868c60ac1146fd Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 19 Jun 2026 03:16:23 +0100 Subject: [PATCH 107/114] Safeguard initialzing unallocated budgets --- src/incompressible/budget_time_avg.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 8f5f1c73..4127b9e9 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -2512,15 +2512,15 @@ subroutine ResetBudget(this) class(budgets_time_avg), intent(inout) :: this this%counter = 0 - this%budget_0 = 0.d0 - this%budget_1 = 0.d0 - this%budget_2 = 0.d0 - this%budget_3 = 0.d0 - this%budget_4_11 = 0.d0 - this%budget_4_22 = 0.d0 - this%budget_4_33 = 0.d0 - this%budget_4_13 = 0.d0 - this%budget_4_23 = 0.d0 + if(allocated(this%budget_0)) this%budget_0 = 0.d0 + if(allocated(this%budget_1)) this%budget_1 = 0.d0 + if(allocated(this%budget_2)) this%budget_2 = 0.d0 + if(allocated(this%budget_3)) this%budget_3 = 0.d0 + if(allocated(this%budget_4_11)) this%budget_4_11 = 0.d0 + if(allocated(this%budget_4_22)) this%budget_4_22 = 0.d0 + if(allocated(this%budget_4_33)) this%budget_4_33 = 0.d0 + if(allocated(this%budget_4_13)) this%budget_4_13 = 0.d0 + if(allocated(this%budget_4_23)) this%budget_4_23 = 0.d0 end subroutine @@ -2535,7 +2535,7 @@ subroutine destroy(this) 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(allocated(this%budget_0)) deallocate(this%budget_0) if (this%budgetType>0) then deallocate(this%budget_1) end if From e8f29afdff07514e610f46ca5b1786f30dc54da8 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Fri, 19 Jun 2026 23:25:24 -0500 Subject: [PATCH 108/114] Build GNU+mvapich on Stampede3 --- CMakeLists.txt | 4 ++-- setup/SetupEnv_Stampede3.sh | 17 ----------------- setup/SetupEnv_Stampede3_gcc.sh | 23 +++++++++++++++++++++++ setup/SetupEnv_Stampede3_impi.sh | 17 +++++++++++++++++ src/CMakeLists.txt | 15 +++++++++++++-- src/incompressible/PadePoisson.F90 | 2 +- src/incompressible/budget_vol_avg.F90 | 2 +- src/incompressible/budget_xy_avg.F90 | 2 +- src/incompressible/igrid.F90 | 2 +- src/incompressible/sgsmod_igrid.F90 | 2 +- src/incompressible/spectral.F90 | 2 +- src/incompressible/turbineMod.F90 | 2 +- src/io/io_hdf5.F90 | 2 +- src/utilities/reductions.F90 | 2 +- 14 files changed, 64 insertions(+), 30 deletions(-) delete mode 100644 setup/SetupEnv_Stampede3.sh create mode 100644 setup/SetupEnv_Stampede3_gcc.sh create mode 100644 setup/SetupEnv_Stampede3_impi.sh diff --git a/CMakeLists.txt b/CMakeLists.txt index 27becbb1..ec318bd3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -47,9 +47,9 @@ set(CMAKE_Fortran_COMPILER_ID $ENV{COMPILER_ID}) if ( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) if ( CMAKE_BUILD_TYPE MATCHES "Release" ) if ($ENV{ARCH_OPT_FLAG}) - set(OPTFLAG "-xhost") + set(OPTFLAG $ENV{ARCH_OPT_FLAG}) else() - set(OPTFLAG $ENV{ARCH_OPT_FLAG}) + set(OPTFLAG "-xhost") endif() set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O3 -traceback -qmkl -heap-arrays 1024 -warn all ${OPTFLAG} -dynamic -qopt-report=2 -qopt-report-phase=vec -qopenmp") elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) diff --git a/setup/SetupEnv_Stampede3.sh b/setup/SetupEnv_Stampede3.sh deleted file mode 100644 index 5141946b..00000000 --- a/setup/SetupEnv_Stampede3.sh +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/bash -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=$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" \ No newline at end of file diff --git a/setup/SetupEnv_Stampede3_gcc.sh b/setup/SetupEnv_Stampede3_gcc.sh new file mode 100644 index 00000000..c9dd9ec2 --- /dev/null +++ b/setup/SetupEnv_Stampede3_gcc.sh @@ -0,0 +1,23 @@ +#!/bin/bash +module purge +module load cmake/3.31.9 +module load gcc +module load mvapich-plus-cpu/4.0b +module load mkl + +CWD=`pwd` +export COMPILER_ID=GNU +export CC="mpicc -fno-lto" +export CXX="mpicxx -fno-lto" +export FC="mpif90 -fno-lto" +export CFLAGS="-O3 -fno-lto" +export CXXFLAGS="-O3 -fno-lto" +export FFLAGS="-O3 -fno-lto" +export FCFLAGS="-O3 -fno-lto" +export LDFLAGS="-fno-lto" + +export FFTW_PATH=${CWD}/dependencies/gcc/fftw-3.3.10 +export DECOMP_PATH=${CWD}/dependencies/gcc/2decomp_fft +export HDF5_PATH=${CWD}/dependencies/gcc/hdf5-1.14.3/build +export FFTPACK_PATH=dummy +export ARCH_OPT_FLAG="-march=skylake-avx512" diff --git a/setup/SetupEnv_Stampede3_impi.sh b/setup/SetupEnv_Stampede3_impi.sh new file mode 100644 index 00000000..46106af5 --- /dev/null +++ b/setup/SetupEnv_Stampede3_impi.sh @@ -0,0 +1,17 @@ +#!/bin/bash +module purge +module load cmake/3.31.9 +module load intel impi +module load fftw3/3.3.10 +module load phdf5/2.0.0 + +CWD=`pwd` +export COMPILER_ID=Intel +export FC=mpiifort +export CC=mpiicc +export CXX=mpiicpc +export FFTW_PATH=${TACC_FFTW3_DIR} +export DECOMP_PATH=${CWD}/dependencies/impi/2decomp_fft +export HDF5_PATH=${TACC_HDF5_DIR} +export FFTPACK_PATH=dummy +export ARCH_OPT_FLAG="-xCORE-AVX512" diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c9f61f43..72157776 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -12,6 +12,9 @@ file(GLOB incompressible_source_files incompressible/*.F90) set(FFTW_LIBRARY_PATH "${FFTW_PATH}/lib") set(FFTW_INCLUDE_PATH "${FFTW_PATH}/include") +# LAPACK +find_package(LAPACK REQUIRED) + # Include directories include_directories(${MPI_INCLUDE_PATH} ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${HDF5_INCLUDE_PATH}) @@ -22,13 +25,21 @@ link_directories(${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${HDF5_LIBRARY_PATH 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 ${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}/libhdf5_hl_fortran.a + ${HDF5_LIBRARY_PATH}/libhdf5_hl_f90cstub.a + ${HDF5_LIBRARY_PATH}/libhdf5_hl.a + ${HDF5_LIBRARY_PATH}/libhdf5_fortran.a + ${HDF5_LIBRARY_PATH}/libhdf5_f90cstub.a + ${HDF5_LIBRARY_PATH}/libhdf5.a + -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) elseif( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD" ) 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) elseif( CMAKE_Fortran_COMPILER_ID MATCHES "GNU" ) - target_link_libraries(PadeOps fftw3 2decomp_fft $ENV{CRAY_LIBSCI_PREFIX_DIR}/lib/libsci_gnu_mpi.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 ${LAPACK_LIBRARIES} ${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 "GNU_OSX") target_link_libraries(PadeOps fftw3 2decomp_fft blas lapack ${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}) else() diff --git a/src/incompressible/PadePoisson.F90 b/src/incompressible/PadePoisson.F90 index e131b5c4..325e1ecd 100644 --- a/src/incompressible/PadePoisson.F90 +++ b/src/incompressible/PadePoisson.F90 @@ -16,7 +16,7 @@ module PadePoissonMod public :: Padepoisson - external :: MPI_CART_GET, DFFTW_PLAN_MANY_DFT_R2C, DFFTW_PLAN_MANY_DFT_C2R, & + external :: DFFTW_PLAN_MANY_DFT_R2C, DFFTW_PLAN_MANY_DFT_C2R, & DFFTW_PLAN_MANY_DFT, DFFTW_DESTROY_PLAN, DFFTW_EXECUTE, DFFTW_EXECUTE_DFT, & DFFTW_EXECUTE_DFT_C2R, DFFTW_EXECUTE_DFT_R2C diff --git a/src/incompressible/budget_vol_avg.F90 b/src/incompressible/budget_vol_avg.F90 index e465833c..bfe8e23f 100644 --- a/src/incompressible/budget_vol_avg.F90 +++ b/src/incompressible/budget_vol_avg.F90 @@ -13,7 +13,7 @@ module budgets_vol_avg_mod private public :: budgets_vol_avg - external :: MPI_REDUCE, MPI_BCAST + ! external :: MPI_REDUCE, MPI_BCAST ! BUDGET TYPE: ! BUDGET_0: 6 Reynolds stress terms + 3 temp fluxes + meanU + meanV + meanT diff --git a/src/incompressible/budget_xy_avg.F90 b/src/incompressible/budget_xy_avg.F90 index a5cd9c89..a9353a58 100644 --- a/src/incompressible/budget_xy_avg.F90 +++ b/src/incompressible/budget_xy_avg.F90 @@ -13,7 +13,7 @@ module budgets_xy_avg_mod private public :: budgets_xy_avg - external :: MPI_REDUCE, MPI_BCAST + ! external :: MPI_REDUCE, MPI_BCAST ! BUDGET TYPE: ! BUDGET_0: 6 Reynolds stress terms + 3 temp fluxes + meanU + meanV + meanT diff --git a/src/incompressible/igrid.F90 b/src/incompressible/igrid.F90 index a5db06e3..93da34ae 100644 --- a/src/incompressible/igrid.F90 +++ b/src/incompressible/igrid.F90 @@ -30,7 +30,7 @@ module IncompressibleGrid implicit none - external :: MPI_BCAST, MPI_RECV, MPI_SEND, MPI_REDUCE, MPI_GATHER + ! external :: MPI_BCAST, MPI_RECV, MPI_SEND, MPI_REDUCE, MPI_GATHER private public :: igrid diff --git a/src/incompressible/sgsmod_igrid.F90 b/src/incompressible/sgsmod_igrid.F90 index 2443b03f..d0cfd489 100644 --- a/src/incompressible/sgsmod_igrid.F90 +++ b/src/incompressible/sgsmod_igrid.F90 @@ -13,7 +13,7 @@ module sgsmod_igrid use PadeDerOps, only: Pade6stagg implicit none - external :: MPI_BCAST, MPI_REDUCE + ! external :: MPI_BCAST, MPI_REDUCE private public :: sgs_igrid diff --git a/src/incompressible/spectral.F90 b/src/incompressible/spectral.F90 index e885dcad..8506da81 100644 --- a/src/incompressible/spectral.F90 +++ b/src/incompressible/spectral.F90 @@ -15,7 +15,7 @@ module spectralMod private public :: spectral, GetWaveNums, useExhaustiveFFT - external :: MPI_CART_GET, DFFTW_PLAN_MANY_DFT_R2C, DFFTW_PLAN_MANY_DFT_C2R, & + external :: DFFTW_PLAN_MANY_DFT_R2C, DFFTW_PLAN_MANY_DFT_C2R, & DFFTW_PLAN_MANY_DFT, DFFTW_DESTROY_PLAN, DFFTW_EXECUTE, DFFTW_EXECUTE_DFT, & DFFTW_EXECUTE_DFT_C2R, DFFTW_EXECUTE_DFT_R2C diff --git a/src/incompressible/turbineMod.F90 b/src/incompressible/turbineMod.F90 index 67c46069..fecaee7d 100644 --- a/src/incompressible/turbineMod.F90 +++ b/src/incompressible/turbineMod.F90 @@ -24,7 +24,7 @@ module turbineMod private public :: TurbineArray - external :: MPI_CART_GET, MPI_IRECV, MPI_ISSEND, MPI_WAITALL + ! external :: MPI_CART_GET, MPI_IRECV, MPI_ISSEND, MPI_WAITALL ! default initializations integer :: num_turbines = 1 diff --git a/src/io/io_hdf5.F90 b/src/io/io_hdf5.F90 index 74d668ee..dcae8a29 100644 --- a/src/io/io_hdf5.F90 +++ b/src/io/io_hdf5.F90 @@ -6,7 +6,7 @@ module io_hdf5_stuff use exits, only: GracefulExit implicit none - external :: MPI_ALLREDUCE, MPI_BCAST + ! external :: MPI_ALLREDUCE, MPI_BCAST type :: io_hdf5 diff --git a/src/utilities/reductions.F90 b/src/utilities/reductions.F90 index 8afc691e..4c67d602 100644 --- a/src/utilities/reductions.F90 +++ b/src/utilities/reductions.F90 @@ -9,7 +9,7 @@ module reductions private public :: P_MAXVAL, P_MINVAL, P_SUM, P_MEAN, P_AVGZ - external :: MPI_ALLREDUCE + ! external :: MPI_ALLREDUCE interface P_MAXVAL 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 From 7bec5f25709408de74c12c153f7369d716b99699 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Sun, 21 Jun 2026 21:01:07 +0100 Subject: [PATCH 109/114] fix precursor budget 1 path when squeeze is on. --- src/incompressible/budget_time_avg.F90 | 7 +++ .../budget_time_avg_deficit_compact.F90 | 55 ++++++++++++++----- 2 files changed, 48 insertions(+), 14 deletions(-) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index 4127b9e9..c35da44a 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -191,6 +191,7 @@ module budgets_time_avg_mod procedure :: destroy procedure :: ResetBudget procedure :: DoBudgets + procedure :: isSqueezed procedure, private :: updateBudget procedure, private :: DumpBudget @@ -242,6 +243,12 @@ module budgets_time_avg_mod contains + logical function isSqueezed(this) + class(budgets_time_avg), intent(in) :: this + + isSqueezed = this%squeeze + end function + subroutine init(this, inputfile, igrid_sim) class(budgets_time_avg), intent(inout) :: this character(len=*), intent(in) :: inputfile diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index f506d101..ec536aa1 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -281,8 +281,9 @@ subroutine DumpBudget(this) integer :: idx, budgetid, budgetsize real(rkind), dimension(:,:,:), pointer :: buffer real(rkind), dimension(:,:,:,:), pointer :: budget - logical :: doBudget + logical :: doBudget, preBudgetSqueezed + preBudgetSqueezed = this%pre_budget%isSqueezed() totalWeight = real(this%counter,rkind) + 1.d-18 ! Cell x-pencil buffers @@ -299,7 +300,7 @@ subroutine DumpBudget(this) 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 + if(.not. preBudgetSqueezed) this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight ! Budget 0 if(this%do_budget0)then @@ -378,7 +379,7 @@ subroutine DumpBudget(this) 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 + if(.not. preBudgetSqueezed) this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight end subroutine ! ---------------------- Mean Cell Gradients (MCG) ------------------------ @@ -1017,10 +1018,17 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) 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) + if(this%pre_budget%isSqueezed())then + ! Squeezed base-flow budget_0 stores pressure gradients sign-reversed. + buffer = this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,17) & + + this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,18) & + + this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,19) + else + ! px, py, pz signs are reversed here to match the squeezed layout. + 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) + end if case(4) ! d_j(base u_i' delta tau_ij') [SGS transport] buffer = this%pre_budget%budget_0(:,:,:,1)*this%budget_0(:,:,:,12) + & @@ -1037,11 +1045,26 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) 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) + & + if(this%pre_budget%isSqueezed())then + ! Squeezed base-flow budget_0 stores SGS gradients sign-reversed. + buffer = this%budget_0(:,:,:,1)*this%pre_budget%budget_0(:,:,:,20) & + + this%budget_0(:,:,:,2)*this%pre_budget%budget_0(:,:,:,21) & + + this%budget_0(:,:,:,3)*this%pre_budget%budget_0(:,:,:,22) + & + 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) + else + ! The sign of ui_sgs in this%pre_budget%budget_1 is reversed here to match the squeezed layout. + 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) + & @@ -1050,6 +1073,7 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) 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) + end if case(6) ! d_j(delta u_i' * delta tau_ij') [SGS transport] buffer = this%budget_0(:,:,:,1)*this%budget_0(:,:,:,12) + & @@ -1313,6 +1337,9 @@ subroutine RestartBudget(this, dir, rid, tid, cid) integer :: idx real(rkind), dimension(:,:,:), pointer :: buffer real(rkind) :: totalWeight + logical :: preBudgetSqueezed + + preBudgetSqueezed = this%pre_budget%isSqueezed() ! Cell x-pencil buffers buffer => this%prim_igrid_sim%rbuffxC(:,:,:,4) @@ -1322,7 +1349,7 @@ subroutine RestartBudget(this, dir, rid, tid, cid) ! The precursor budget must already be restarted and in raw-sum mode, ! with the same historical sample count as this compact budget. this%pre_budget%budget_0 = this%pre_budget%budget_0/totalWeight - this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight + if(.not. preBudgetSqueezed) this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight ! Restart files contain means/fluctuation moments. Keep all fields in ! mean mode while rebuilding the raw moments used for accumulation. @@ -1384,7 +1411,7 @@ subroutine RestartBudget(this, dir, rid, tid, cid) 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 + if(.not. preBudgetSqueezed) this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight nullify(buffer) end subroutine From 62d86da0b2060cdbcf20b61522d01a835c2f665d Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 22 Jun 2026 22:17:14 -0400 Subject: [PATCH 110/114] some fixes for deficit budget2 + safe guards --- src/incompressible/budget_time_avg.F90 | 70 ++++++++++-------- .../budget_time_avg_deficit_compact.F90 | 72 +++++++++++-------- 2 files changed, 85 insertions(+), 57 deletions(-) diff --git a/src/incompressible/budget_time_avg.F90 b/src/incompressible/budget_time_avg.F90 index c35da44a..fdde9202 100644 --- a/src/incompressible/budget_time_avg.F90 +++ b/src/incompressible/budget_time_avg.F90 @@ -441,31 +441,35 @@ subroutine updateBudget(this) call this%igrid_sim%getMomentumTerms() - select case (this%budgetType) - case(0) + if(this%squeeze) then call this%AssembleBudget0() - case(1) - call this%AssembleBudget0() - call this%AssembleBudget1() - case(2) - call this%AssembleBudget0() - call this%AssembleBudget1() - ! Budget 2 need not be assembled now; it only needs to be assembled - ! before writing to disk - case(3) - call this%AssembleBudget0() - call this%AssembleBudget1() - call this%AssembleBudget3() - case(4) - call this%AssembleBudget0() - call this%AssembleBudget1() - call this%AssembleBudget3() - call this%AssembleBudget4_11() - call this%AssembleBudget4_22() - call this%AssembleBudget4_33() - call this%AssembleBudget4_13() - call this%AssembleBudget4_23() - end select + else + select case (this%budgetType) + case(0) + call this%AssembleBudget0() + case(1) + call this%AssembleBudget0() + call this%AssembleBudget1() + case(2) + call this%AssembleBudget0() + call this%AssembleBudget1() + ! Budget 2 need not be assembled now; it only needs to be assembled + ! before writing to disk + case(3) + call this%AssembleBudget0() + call this%AssembleBudget1() + call this%AssembleBudget3() + case(4) + call this%AssembleBudget0() + call this%AssembleBudget1() + call this%AssembleBudget3() + call this%AssembleBudget4_11() + call this%AssembleBudget4_22() + call this%AssembleBudget4_33() + call this%AssembleBudget4_13() + call this%AssembleBudget4_23() + end select + end if call this%AssembleScalarStats() @@ -2241,6 +2245,16 @@ subroutine restartBudget(this, dir, rid, tid, cid) buff => this%igrid_sim%rbuffxC(:,:,:,1) + if(allocated(this%budget_0)) this%budget_0 = 0.d0 + if(allocated(this%budget_1)) this%budget_1 = 0.d0 + if(allocated(this%budget_2)) this%budget_2 = 0.d0 + if(allocated(this%budget_3)) this%budget_3 = 0.d0 + if(allocated(this%budget_4_11)) this%budget_4_11 = 0.d0 + if(allocated(this%budget_4_22)) this%budget_4_22 = 0.d0 + if(allocated(this%budget_4_33)) this%budget_4_33 = 0.d0 + if(allocated(this%budget_4_13)) this%budget_4_13 = 0.d0 + if(allocated(this%budget_4_23)) this%budget_4_23 = 0.d0 + ! Budget 0: do idx = 1,size(this%budget_0,4) ! if (allocated(this%budget_0)) deallocate(this%budget_0) @@ -2301,7 +2315,7 @@ subroutine restartBudget(this, dir, rid, tid, cid) ! Step 11: Go back to summing instead of averaging this%budget_0 = this%budget_0*(real(cid,rkind) + 1.d-18) ! Budget 1: - if (this%budgetType>0) then + if ((this%budgetType>0) .and. (.not. this%squeeze)) then do idx = 1,size(this%budget_1,4) ! if (allocated(this%budget_1)) deallocate(this%budget_1) call this%restart_budget_field(this%budget_1(:,:,:,idx), dir, rid, tid, cid, 1, idx) @@ -2310,7 +2324,7 @@ subroutine restartBudget(this, dir, rid, tid, cid) end if ! Budget 2 - if (this%budgetType>1) then + if ((this%budgetType>1) .and. (.not. this%squeeze)) then do idx = 1,size(this%budget_2,4) call this%restart_budget_field(this%budget_2(:,:,:,idx), dir, rid, tid, cid, 2, idx) end do @@ -2318,7 +2332,7 @@ subroutine restartBudget(this, dir, rid, tid, cid) end if ! Budget 3: - if (this%budgetType>2) then + if ((this%budgetType>2) .and. (.not. this%squeeze)) then this%budget_0 = this%budget_0/(real(cid,rkind) + 1.d-18) this%budget_1 = this%budget_1/(real(cid,rkind) + 1.d-18) do idx = 1,size(this%budget_3,4) @@ -2339,7 +2353,7 @@ subroutine restartBudget(this, dir, rid, tid, cid) end if ! Budget 4 - if (this%budgetType>3) then + if ((this%budgetType>3) .and. (.not. this%squeeze)) then do idx = 1,size(this%budget_4_11,4) ! if (allocated(this%budget_4_11)) deallocate(this%budget_4_11) call this%restart_budget_4_field(this%budget_4_11(:,:,:,idx), dir, rid, tid, cid, 4, idx, 11) diff --git a/src/incompressible/budget_time_avg_deficit_compact.F90 b/src/incompressible/budget_time_avg_deficit_compact.F90 index ec536aa1..b8e54ef1 100644 --- a/src/incompressible/budget_time_avg_deficit_compact.F90 +++ b/src/incompressible/budget_time_avg_deficit_compact.F90 @@ -44,7 +44,7 @@ module budgets_time_avg_deficit_compact_mod logical :: do_budgets logical :: forceDump - ! Avoid allocating a new holder of delta_tauij with every call to AssembleBudget3 + ! Avoid allocating a new holder of delta_tauij with every budget sample real(rkind), dimension(:,:,:,:), allocatable :: delta_tauij contains @@ -140,6 +140,13 @@ subroutine init(this, pre_budget, primary_inputfile, prim_igrid_sim) this%budgets_dir = budgets_dir if(this%do_budgets) then + if(.not. allocated(this%pre_budget%budget_0)) then + call GracefulExit("Compact deficit budgets require initialized precursor budget_0.", 124) + end if + if(this%do_budget3 .and. (.not. this%pre_budget%isSqueezed()) .and. (.not. allocated(this%pre_budget%budget_1))) then + call GracefulExit("Compact deficit budget3 requires precursor budget_1. Use base budgetType > 0.", 125) + end if + 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 @@ -170,9 +177,10 @@ subroutine init(this, pre_budget, primary_inputfile, prim_igrid_sim) 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%do_budget0) allocate(this%delta_tauij(this%nx,this%ny,this%nz,6)) + 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 @@ -262,7 +270,7 @@ subroutine updateBudget(this) ! 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%do_budget0) this%delta_tauij = this%prim_igrid_sim%tauSGS_ij - this%pre_budget%igrid_sim%tauSGS_ij ! All arrays remain in raw-sum mode between dumps. Assemble lower-order ! moments before higher-order moments so they cover identical samples. @@ -300,7 +308,7 @@ subroutine DumpBudget(this) 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 - if(.not. preBudgetSqueezed) this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight + if(this%do_budget3 .and. (.not. preBudgetSqueezed)) this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight ! Budget 0 if(this%do_budget0)then @@ -379,7 +387,7 @@ subroutine DumpBudget(this) 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 - if(.not. preBudgetSqueezed) this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight + if(this%do_budget3 .and. (.not. preBudgetSqueezed)) this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight end subroutine ! ---------------------- Mean Cell Gradients (MCG) ------------------------ @@ -956,29 +964,29 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) 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) + case(5) buffer = this%budget_0(:,:,:,1)*this%MCG(:,:,:,13) + & this%budget_0(:,:,:,2)*this%MCG(:,:,:,14) + & this%budget_0(:,:,:,3)*this%MCG(:,:,:,15) - case(9) + case(6) buffer = this%budget_0(:,:,:,1)*this%MCG(:,:,:,16) + & this%budget_0(:,:,:,2)*this%MCG(:,:,:,17) + & this%budget_0(:,:,:,3)*this%MCG(:,:,:,18) + case(7) + 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(8) + 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(9) + 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(10) buffer = this%pre_budget%budget_0(:,:,:,1)*this%MCG(:,:,:,10) + & this%pre_budget%budget_0(:,:,:,2)*this%MCG(:,:,:,11) + & @@ -1065,14 +1073,14 @@ subroutine getProductOfMeans(this, budgetid, idx, buffer) - 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) + 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) end if case(6) ! d_j(delta u_i' * delta tau_ij') [SGS transport] @@ -1346,10 +1354,16 @@ subroutine RestartBudget(this, dir, rid, tid, cid) this%counter = cid totalWeight = real(this%counter,rkind) + 1.d-18 + 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%MCG)) this%MCG = zero + ! The precursor budget must already be restarted and in raw-sum mode, ! with the same historical sample count as this compact budget. this%pre_budget%budget_0 = this%pre_budget%budget_0/totalWeight - if(.not. preBudgetSqueezed) this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight + if(this%do_budget3 .and. (.not. preBudgetSqueezed)) this%pre_budget%budget_1 = this%pre_budget%budget_1/totalWeight ! Restart files contain means/fluctuation moments. Keep all fields in ! mean mode while rebuilding the raw moments used for accumulation. @@ -1411,7 +1425,7 @@ subroutine RestartBudget(this, dir, rid, tid, cid) 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 - if(.not. preBudgetSqueezed) this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight + if(this%do_budget3 .and. (.not. preBudgetSqueezed)) this%pre_budget%budget_1 = this%pre_budget%budget_1*totalWeight nullify(buffer) end subroutine From 427e5ec9e309d5a459ec89c5593658beaf2f03e6 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Mon, 22 Jun 2026 22:17:29 -0400 Subject: [PATCH 111/114] push the streamtube program --- problems/postprocessing_igrid/Streamtube.F90 | 1850 +++++++++++++++++ .../Streamtube_files/input_streamtube.dat | 26 + 2 files changed, 1876 insertions(+) create mode 100644 problems/postprocessing_igrid/Streamtube.F90 create mode 100644 problems/postprocessing_igrid/Streamtube_files/input_streamtube.dat diff --git a/problems/postprocessing_igrid/Streamtube.F90 b/problems/postprocessing_igrid/Streamtube.F90 new file mode 100644 index 00000000..d2c89706 --- /dev/null +++ b/problems/postprocessing_igrid/Streamtube.F90 @@ -0,0 +1,1850 @@ +module streamtube_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 :: nx = 0, ny = 0, nz = 0 + integer :: prow = 0, pcol = 0 + integer :: NumericalSchemeVert = 1 + + real(rkind) :: Lx = one, Ly = one, Lz = one + real(rkind) :: dx = one, dy = one, dz = one + + logical :: PeriodicInZ = .false. + integer :: botWall = 3, topWall = 2 + integer :: uBC_bottom, uBC_top + integer :: vBC_bottom, vBC_top + integer :: wBC_bottom, wBC_top + + type(spectral), target :: spectC, spectE + type(decomp_info) :: gpC, gpE + type(decomp_info), pointer :: sp_gpC, sp_gpE + type(Pade6stagg) :: Pade6opZ + + ! Local x-pencil mesh: mesh(:,:,:,1:3) = x,y,z. + real(rkind), dimension(:,:,:,:), allocatable, target :: mesh + + ! Buffers for derivatives/interpolation. + real(rkind), dimension(:,:,:), allocatable :: rbuffxC + real(rkind), dimension(:,:,:,:), allocatable, target :: duidxj + complex(rkind), dimension(:,:,:), allocatable :: cbuffyC + complex(rkind), dimension(:,:,:,:), allocatable, target :: cbuffzC + + ! Velocity-gradient pointers. + real(rkind), dimension(:,:,:), pointer :: dudx => null(), dudy => null(), dudz => null() + real(rkind), dimension(:,:,:), pointer :: dvdx => null(), dvdy => null(), dvdz => null() + real(rkind), dimension(:,:,:), pointer :: dwdx => null(), dwdy => null(), dwdz => null() + + ! Numerical controls. + real(rkind) :: umin_streamtube = 1.0e-12_rkind + real(rkind) :: invalid_value = huge(one) + integer :: streamtube_cutcell_nsamp_y = 11 + integer :: streamtube_cutcell_nsamp_z = 11 + +contains + +!=============================================================================== +! Initialization / finalization +!=============================================================================== + + subroutine initialize_streamtube_module(nx_in, ny_in, nz_in, Lx_in, Ly_in, Lz_in, prow_in, pcol_in) + implicit none + integer, intent(in) :: nx_in, ny_in, nz_in + integer, intent(in) :: prow_in, pcol_in + real(rkind), intent(in) :: Lx_in, Ly_in, Lz_in + + logical :: periodicbcs(3) + + nx = nx_in; ny = ny_in; nz = nz_in + Lx = Lx_in; Ly = Ly_in; Lz = Lz_in + prow = prow_in; pcol = pcol_in + + dx = Lx / real(nx, rkind) + dy = Ly / real(ny, rkind) + dz = Lz / real(nz, rkind) + + periodicbcs(1) = .true. + periodicbcs(2) = .true. + periodicbcs(3) = PeriodicInZ + + call decomp_2d_init(nx, ny, nz, prow, pcol, periodicbcs) + call get_decomp_info(gpC) + call decomp_info_init(nx, ny, nz + 1, gpE) + + call message(0, 'Initializing streamtube spectral operators ...') + call spectC%init('x', nx, ny, nz, dx, dy, dz, 'FOUR', '2/3rd', & + dimTransform=2, fixOddball=.false., init_periodicInZ=PeriodicInZ) + call spectE%init('x', nx, ny, nz + 1, dx, dy, dz, 'FOUR', '2/3rd', & + dimTransform=2, fixOddball=.false., init_periodicInZ=PeriodicInZ) + + sp_gpC => spectC%spectdecomp + sp_gpE => spectE%spectdecomp + + call allocate_streamtube_memory() + call create_local_mesh() + + call Pade6opZ%init(gpC, sp_gpC, gpE, sp_gpE, dz, NumericalSchemeVert, PeriodicInZ, spectC) + call get_boundary_conditions_stencil() + call associate_gradient_pointers() + + call message(0, 'Streamtube module initialized.') + end subroutine initialize_streamtube_module + + + subroutine allocate_streamtube_memory() + implicit none + + call message(0, 'Allocating streamtube work arrays ...') + + 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(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)) + + mesh = zero + duidxj = zero + cbuffyC = cmplx(zero, zero, kind=rkind) + cbuffzC = cmplx(zero, zero, kind=rkind) + end subroutine allocate_streamtube_memory + + + subroutine create_local_mesh() + implicit none + integer :: i, j, k + integer :: ix1, iy1, iz1 + + ix1 = gpC%xst(1) + iy1 = gpC%xst(2) + iz1 = gpC%xst(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 - 2, rkind) * dx + mesh(i,j,k,2) = real(iy1 + j - 2, rkind) * dy + mesh(i,j,k,3) = real(iz1 + k - 2, rkind) * dz + end do + end do + end do + + ! Cell-center vertical coordinate + mesh(:,:,:,3) = mesh(:,:,:,3) + half * dz + end subroutine create_local_mesh + + + subroutine associate_gradient_pointers() + implicit none + + 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) + end subroutine associate_gradient_pointers + + + subroutine release_streamtube_module() + implicit none + + if (allocated(mesh)) deallocate(mesh) + if (allocated(duidxj)) deallocate(duidxj) + if (allocated(cbuffyC)) deallocate(cbuffyC) + if (allocated(cbuffzC)) deallocate(cbuffzC) + if (allocated(rbuffxC)) deallocate(rbuffxC) + + nullify(dudx, dudy, dudz) + nullify(dvdx, dvdy, dvdz) + nullify(dwdx, dwdy, dwdz) + + 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 release_streamtube_module + +!=============================================================================== +! Main user-facing driver +!=============================================================================== + + subroutine march_streamtube_xpencil(u, v, w, x_march, y0, z0, tube_y, tube_z) + implicit none + + real(rkind), intent(in) :: u(:,:,:), v(:,:,:), w(:,:,:) + real(rkind), intent(in) :: x_march(:) + real(rkind), intent(in) :: y0(:), z0(:) + real(rkind), intent(out) :: tube_y(:,:), tube_z(:,:) + + integer :: nxm, np, n + real(rkind) :: dxm + real(rkind), allocatable :: y_old(:), z_old(:) + real(rkind), allocatable :: y_new(:), z_new(:) + + nxm = size(x_march) + np = size(y0) + + if (size(z0) /= np) call gracefulExit('march_streamtube_xpencil: z0 size mismatch.', 201) + if (size(tube_y,1) /= nxm .or. size(tube_y,2) /= np) call gracefulExit('march_streamtube_xpencil: tube_y size mismatch.', 202) + if (size(tube_z,1) /= nxm .or. size(tube_z,2) /= np) call gracefulExit('march_streamtube_xpencil: tube_z size mismatch.', 203) + + allocate(y_old(np), z_old(np), y_new(np), z_new(np)) + + call message(0, 'Computing velocity gradients for streamtube interpolation ...') + call compute_velocity_gradients(u, v, w) + + y_old = y0 + z_old = z0 + tube_y(1,:) = y_old + tube_z(1,:) = z_old + + do n = 1, nxm - 1 + call message(1, 'At x station: ', x_march(n)) + dxm = x_march(n+1) - x_march(n) + + call rk4_step_all_points(x_march(n), dxm, y_old, z_old, y_new, z_new, u, v, w) + + ! y_new/z_new are identical on all ranks because every RK-stage RHS is + ! globally reduced with MPI_Allreduce. Thus a point can leave one rank's + ! y-z pencil and be picked up by another rank at the next station. + y_old = y_new + z_old = z_new + + tube_y(n+1,:) = y_old + tube_z(n+1,:) = z_old + end do + + deallocate(y_old, z_old, y_new, z_new) + end subroutine march_streamtube_xpencil + +!=============================================================================== +! RK4 integration in x +!=============================================================================== + + subroutine rk4_step_all_points(x0, dxm, y0, z0, y1, z1, u, v, w) + implicit none + + real(rkind), intent(in) :: x0, dxm + real(rkind), intent(in) :: y0(:), z0(:) + real(rkind), intent(out) :: y1(:), z1(:) + real(rkind), intent(in) :: u(:,:,:), v(:,:,:), w(:,:,:) + + integer :: np, p + real(rkind), allocatable :: k1y(:), k1z(:), k2y(:), k2z(:), k3y(:), k3z(:), k4y(:), k4z(:) + real(rkind), allocatable :: yt(:), zt(:) + logical, allocatable :: ok1(:), ok2(:), ok3(:), ok4(:) + + np = size(y0) + + allocate(k1y(np), k1z(np), k2y(np), k2z(np), k3y(np), k3z(np), k4y(np), k4z(np)) + allocate(yt(np), zt(np)) + allocate(ok1(np), ok2(np), ok3(np), ok4(np)) + + call rhs_all_points(x0, y0, z0, k1y, k1z, ok1, u, v, w) + + yt = y0 + half * dxm * k1y + zt = z0 + half * dxm * k1z + call rhs_all_points(x0 + half*dxm, yt, zt, k2y, k2z, ok2, u, v, w) + + yt = y0 + half * dxm * k2y + zt = z0 + half * dxm * k2z + call rhs_all_points(x0 + half*dxm, yt, zt, k3y, k3z, ok3, u, v, w) + + yt = y0 + dxm * k3y + zt = z0 + dxm * k3z + call rhs_all_points(x0 + dxm, yt, zt, k4y, k4z, ok4, u, v, w) + + do p = 1, np + if (ok1(p) .and. ok2(p) .and. ok3(p) .and. ok4(p)) then + y1(p) = y0(p) + dxm * (k1y(p) + two*k2y(p) + two*k3y(p) + k4y(p)) / 6.0_rkind + z1(p) = z0(p) + dxm * (k1z(p) + two*k2z(p) + two*k3z(p) + k4z(p)) / 6.0_rkind + else + y1(p) = invalid_value + z1(p) = invalid_value + end if + end do + + deallocate(k1y, k1z, k2y, k2z, k3y, k3z, k4y, k4z) + deallocate(yt, zt) + deallocate(ok1, ok2, ok3, ok4) + end subroutine rk4_step_all_points + + + subroutine rhs_all_points(xp, yp, zp, rhs_y, rhs_z, ok, u, v, w) + implicit none + + real(rkind), intent(in) :: xp + real(rkind), intent(in) :: yp(:), zp(:) + real(rkind), intent(out) :: rhs_y(:), rhs_z(:) + logical, intent(out) :: ok(:) + real(rkind), intent(in) :: u(:,:,:), v(:,:,:), w(:,:,:) + + integer :: np, p, ierr + real(rkind), allocatable :: rhs_y_local(:), rhs_z_local(:) + real(rkind), allocatable :: rhs_y_global(:), rhs_z_global(:) + real(rkind), allocatable :: found_local(:), found_global(:) + real(rkind) :: up, vp, wp + logical :: found + + np = size(yp) + + allocate(rhs_y_local(np), rhs_z_local(np)) + allocate(rhs_y_global(np), rhs_z_global(np)) + allocate(found_local(np), found_global(np)) + + rhs_y_local = zero + rhs_z_local = zero + found_local = zero + + do p = 1, np + if (.not. is_valid_point(yp(p), zp(p))) cycle + + call interp_velocity_taylor(xp, yp(p), zp(p), u, v, w, up, vp, wp, found) + + if (found) then + if (abs(up) > umin_streamtube) then + rhs_y_local(p) = vp / up + rhs_z_local(p) = wp / up + found_local(p) = one + end if + end if + end do + + call mpi_allreduce(rhs_y_local, rhs_y_global, np, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) + call mpi_allreduce(rhs_z_local, rhs_z_global, np, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) + call mpi_allreduce(found_local, found_global, np, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr) + + do p = 1, np + if (found_global(p) > half) then + rhs_y(p) = rhs_y_global(p) / found_global(p) + rhs_z(p) = rhs_z_global(p) / found_global(p) + ok(p) = .true. + else + rhs_y(p) = zero + rhs_z(p) = zero + ok(p) = .false. + end if + end do + + deallocate(rhs_y_local, rhs_z_local) + deallocate(rhs_y_global, rhs_z_global) + deallocate(found_local, found_global) + end subroutine rhs_all_points + +!=============================================================================== +! Velocity interpolation +!=============================================================================== + + subroutine interp_velocity_taylor(xp, yp, zp, u, v, w, up, vp, wp, found) + implicit none + + real(rkind), intent(in) :: xp, yp, zp + real(rkind), intent(in) :: u(:,:,:), v(:,:,:), w(:,:,:) + real(rkind), intent(out) :: up, vp, wp + logical, intent(out) :: found + + integer :: i, j, k + real(rkind) :: dxp, dyp, dzp + + up = zero + vp = zero + wp = zero + found = .false. + + ! Locate the owning cell once, then reuse the same local index and Taylor + ! displacement for u, v, and w. The passed fields are all cell-centered. + call find_nearest_owned_cell(xp, yp, zp, i, j, k, dxp, dyp, dzp, found) + if (.not. found) return + + call interp_scalar_taylor_1st(i, j, k, dxp, dyp, dzp, u, dudx, dudy, dudz, up) + call interp_scalar_taylor_1st(i, j, k, dxp, dyp, dzp, v, dvdx, dvdy, dvdz, vp) + call interp_scalar_taylor_1st(i, j, k, dxp, dyp, dzp, w, dwdx, dwdy, dwdz, wp) + + found = .true. + end subroutine interp_velocity_taylor + + + subroutine interp_scalar_taylor_1st(i, j, k, dxp, dyp, dzp, f, dfdx, dfdy, dfdz, fp) + implicit none + + integer, intent(in) :: i, j, k + real(rkind), intent(in) :: dxp, dyp, dzp + real(rkind), intent(in) :: f(:,:,:) + real(rkind), intent(in) :: dfdx(:,:,:), dfdy(:,:,:), dfdz(:,:,:) + real(rkind), intent(out) :: fp + + fp = f(i,j,k) + dxp*dfdx(i,j,k) + dyp*dfdy(i,j,k) + dzp*dfdz(i,j,k) + end subroutine interp_scalar_taylor_1st + + + subroutine find_nearest_owned_cell(xp, yp, zp, i, j, k, dxp, dyp, dzp, found) + implicit none + + real(rkind), intent(in) :: xp, yp, zp + integer, intent(out) :: i, j, k + real(rkind), intent(out) :: dxp, dyp, dzp + logical, intent(out) :: found + + integer :: ig, jg, kg + real(rkind) :: xc, yc, zc + + found = .false. + i = -1; j = -1; k = -1 + dxp = zero; dyp = zero; dzp = zero + + if (zp < zero .or. zp > Lz) then + found = .false. + return + end if + + ! x and y are periodic; z is wall-bounded and remains clamped. + call nearest_global_index_uniform_periodic(xp, dx, nx, ig) + call nearest_global_index_uniform_periodic(yp, dy, ny, jg) + call nearest_global_index_uniform_zcell(zp, dz, nz, kg) + + if (ig < gpC%xst(1) .or. ig > gpC%xen(1)) return + if (jg < gpC%xst(2) .or. jg > gpC%xen(2)) return + if (kg < gpC%xst(3) .or. kg > gpC%xen(3)) return + + i = ig - gpC%xst(1) + 1 + j = jg - gpC%xst(2) + 1 + k = kg - gpC%xst(3) + 1 + + if (i < 1 .or. i > size(mesh,1)) return + if (j < 1 .or. j > size(mesh,2)) return + if (k < 1 .or. k > size(mesh,3)) return + + xc = mesh(i,j,k,1) + yc = mesh(i,j,k,2) + zc = mesh(i,j,k,3) + + ! Use the nearest periodic image for the Taylor displacement. Wrapping the + ! index alone is not sufficient: xp-xc or yp-yc can otherwise be O(L). + dxp = periodic_delta(xp - xc, Lx) + dyp = periodic_delta(yp - yc, Ly) + dzp = zp - zc + + found = .true. + end subroutine find_nearest_owned_cell + + + subroutine nearest_global_index_uniform_periodic(xp, dd, nn, ig) + implicit none + real(rkind), intent(in) :: xp, dd + integer, intent(in) :: nn + integer, intent(out) :: ig + + ig = modulo(nint(xp / dd), nn) + 1 + end subroutine nearest_global_index_uniform_periodic + + + subroutine nearest_global_index_uniform_zcell(zp, dd, nn, kg) + implicit none + real(rkind), intent(in) :: zp, dd + integer, intent(in) :: nn + integer, intent(out) :: kg + + ! z cell centers are at (k-1)*dz + dz/2. + kg = nint((zp - half*dd) / dd) + 1 + kg = max(1, min(nn, kg)) + end subroutine nearest_global_index_uniform_zcell + + + pure real(rkind) function periodic_delta(delta, period) + implicit none + real(rkind), intent(in) :: delta, period + + if (period > zero) then + periodic_delta = delta - period * anint(delta / period) + else + periodic_delta = delta + end if + end function periodic_delta + + + logical function is_valid_point(y, z) + implicit none + real(rkind), intent(in) :: y, z + + is_valid_point = .true. + if (abs(y) >= half*invalid_value) is_valid_point = .false. + if (abs(z) >= half*invalid_value) is_valid_point = .false. + end function is_valid_point + +!=============================================================================== +! Velocity gradients used by Taylor interpolation +!=============================================================================== + + subroutine compute_velocity_gradients(u, v, w) + implicit none + real(rkind), intent(in) :: u(:,:,:), v(:,:,:), w(:,:,:) + + duidxj = zero + + call ddx_R2R(u, dudx) + call ddy_R2R(u, dudy) + call ddz_R2R(u, dudz, uBC_bottom, uBC_top) + + call ddx_R2R(v, dvdx) + call ddy_R2R(v, dvdy) + call ddz_R2R(v, dvdz, vBC_bottom, vBC_top) + + call ddx_R2R(w, dwdx) + call ddy_R2R(w, dwdy) + call ddz_R2R(w, dwdz, wBC_bottom, wBC_top) + end subroutine compute_velocity_gradients + + + subroutine ddx_R2R(f, dfdx) + implicit none + 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 ddx_R2R + + + subroutine ddy_R2R(f, dfdy) + implicit none + 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 ddy_R2R + + + subroutine ddz_R2R(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%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 ddz_R2R + + + subroutine get_boundary_conditions_stencil() + implicit none + + wBC_bottom = -1 + wBC_top = -1 + + select case (botWall) + case (1) + call message(1, 'Bottom wall: no-slip wall') + uBC_bottom = 0 + vBC_bottom = 0 + wBC_bottom = 1 + case (2) + call message(1, 'Bottom wall: slip wall') + uBC_bottom = 1 + vBC_bottom = 1 + case (3) + call message(1, 'Bottom wall: wall model') + uBC_bottom = 0 + vBC_bottom = 0 + case default + call gracefulExit('Invalid choice for bottom wall BCs.', 301) + end select + + select case (topWall) + case (1) + call message(1, 'Top wall: no-slip wall') + uBC_top = 0 + vBC_top = 0 + wBC_top = 1 + case (2) + call message(1, 'Top wall: slip wall') + uBC_top = 1 + vBC_top = 1 + case (3) + call message(1, 'Top wall: wall model') + uBC_top = 0 + vBC_top = 0 + case default + call gracefulExit('Invalid choice for top wall BCs.', 302) + end select + end subroutine get_boundary_conditions_stencil + +!=============================================================================== +! Output helpers +!=============================================================================== + + subroutine export_streamtube_csv(filename, x_march, tube_y, tube_z) + implicit none + character(len=*), intent(in) :: filename + real(rkind), intent(in) :: x_march(:) + real(rkind), intent(in) :: tube_y(:,:), tube_z(:,:) + + integer :: unit, n, p, nxm, np + + nxm = size(x_march) + np = size(tube_y, 2) + + open(newunit=unit, file=trim(filename), status='replace', action='write', form='formatted') + + write(unit, '(A)', advance='no') 'x' + do p = 1, np + write(unit, '(A,I0)', advance='no') ',y', p + write(unit, '(A,I0)', advance='no') ',z', p + end do + write(unit, *) + + do n = 1, nxm + write(unit, '(ES16.8)', advance='no') x_march(n) + do p = 1, np + write(unit, '(A,ES16.8,A,ES16.8)', advance='no') ',', tube_y(n,p), ',', tube_z(n,p) + end do + write(unit, *) + end do + + close(unit) + end subroutine export_streamtube_csv + + +!=============================================================================== +! Optional geometry diagnostics +!=============================================================================== + +subroutine compute_contour_extents(tube_y, tube_z, valid, width_y, height_z) +implicit none + +real(rkind), intent(in) :: tube_y(:,:), tube_z(:,:) +logical, intent(in) :: valid(:,:) +real(rkind), intent(out) :: width_y(:), height_z(:) + +integer :: n + +if (size(tube_z,1) /= size(tube_y,1)) call gracefulExit('compute_contour_extents: tube_z station mismatch.', 551) +if (size(tube_z,2) /= size(tube_y,2)) call gracefulExit('compute_contour_extents: tube_z point mismatch.', 552) +if (size(valid,1) /= size(tube_y,1)) call gracefulExit('compute_contour_extents: valid station mismatch.', 553) +if (size(valid,2) /= size(tube_y,2)) call gracefulExit('compute_contour_extents: valid point mismatch.', 554) + +do n = 1, size(tube_y,1) + + if (all(valid(n,:))) then + width_y(n) = maxval(tube_y(n,:), mask=valid(n,:)) - & + minval(tube_y(n,:), mask=valid(n,:)) + + height_z(n) = maxval(tube_z(n,:), mask=valid(n,:)) - & + minval(tube_z(n,:), mask=valid(n,:)) + else + width_y(n) = zero + height_z(n) = zero + end if + +end do + +end subroutine compute_contour_extents + + +subroutine compute_contour_area(tube_y, tube_z, valid, area) +implicit none + +real(rkind), intent(in) :: tube_y(:,:), tube_z(:,:) +logical, intent(in) :: valid(:,:) +real(rkind), intent(out) :: area(:) + +integer :: n, p, pp, np, nv +real(rkind) :: accum +real(rkind), allocatable :: yv(:), zv(:) + +np = size(tube_y,2) + +if (size(tube_z,1) /= size(tube_y,1)) call gracefulExit('compute_contour_area: tube_z station mismatch.', 541) +if (size(tube_z,2) /= np) call gracefulExit('compute_contour_area: tube_z point mismatch.', 542) +if (size(valid,1) /= size(tube_y,1)) call gracefulExit('compute_contour_area: valid station mismatch.', 543) +if (size(valid,2) /= np) call gracefulExit('compute_contour_area: valid point mismatch.', 544) +if (size(area) /= size(tube_y,1)) call gracefulExit('compute_contour_area: area size mismatch.', 545) + +allocate(yv(np), zv(np)) + +do n = 1, size(tube_y,1) + + if (.not. all(valid(n,:))) then + area(n) = zero + cycle + end if + + call compact_valid_contour(tube_y(n,:), tube_z(n,:), valid(n,:), yv, zv, nv) + + if (nv < 3) then + area(n) = zero + cycle + end if + + accum = zero + + do p = 1, nv + pp = p + 1 + if (pp > nv) pp = 1 + accum = accum + yv(p)*zv(pp) - zv(p)*yv(pp) + end do + + area(n) = half * abs(accum) + +end do + +deallocate(yv, zv) + +end subroutine compute_contour_area + + subroutine build_x_march(xa, xb, xarr) + implicit none + real(rkind), intent(in) :: xa, xb + real(rkind), intent(out) :: xarr(:) + integer :: n, nloc + + nloc = size(xarr) + + if (nloc < 2) then + call gracefulExit('build_x_march: need at least 2 stations.', 570) + end if + + do n = 1, nloc + xarr(n) = xa + (xb - xa) * real(n - 1, rkind) / real(nloc - 1, rkind) + end do + end subroutine build_x_march + + + subroutine count_initial_contour_points(filename, npts) + implicit none + character(len=*), intent(in) :: filename + integer, intent(out) :: npts + + integer :: unit, ios + character(len=4096) :: line + real(rkind) :: ytmp, ztmp + logical :: ok + + npts = 0 + open(newunit=unit, file=trim(filename), status='old', action='read', form='formatted') + + do + read(unit, '(A)', iostat=ios) line + if (ios /= 0) exit + call parse_yz_line(line, ytmp, ztmp, ok) + if (ok) npts = npts + 1 + end do + + close(unit) + end subroutine count_initial_contour_points + + + subroutine read_initial_contour_csv(filename, yy, zz) + implicit none + character(len=*), intent(in) :: filename + real(rkind), intent(out) :: yy(:), zz(:) + + integer :: unit, ios, p, npts + character(len=4096) :: line + real(rkind) :: ytmp, ztmp + logical :: ok + + npts = size(yy) + if (size(zz) /= npts) call gracefulExit('Internal contour array size mismatch.', 201) + + p = 0 + open(newunit=unit, file=trim(filename), status='old', action='read', form='formatted') + + do + read(unit, '(A)', iostat=ios) line + if (ios /= 0) exit + + call parse_yz_line(line, ytmp, ztmp, ok) + if (.not. ok) cycle + + p = p + 1 + if (p > npts) then + call gracefulExit('Initial contour file has more valid points than num_contour_points.', 202) + end if + + yy(p) = ytmp + zz(p) = ztmp + end do + + close(unit) + + if (p /= npts) then + call gracefulExit('Initial contour file has fewer valid points than expected.', 203) + end if + end subroutine read_initial_contour_csv + + + subroutine parse_yz_line(line_in, yy, zz, ok) + implicit none + character(len=*), intent(in) :: line_in + real(rkind), intent(out) :: yy, zz + logical, intent(out) :: ok + + character(len=len(line_in)) :: line + integer :: i, ios + + line = adjustl(line_in) + + ok = .false. + yy = zero + zz = zero + + if (len_trim(line) == 0) return + if (line(1:1) == '#') return + + do i = 1, len(line) + if (line(i:i) == ',') line(i:i) = ' ' + end do + + read(line, *, iostat=ios) yy, zz + ok = (ios == 0) + end subroutine parse_yz_line + + + subroutine export_geometry_csv(filename, xarr, area_in, width_in, height_in, flow_rate_in) + implicit none + character(len=*), intent(in) :: filename + real(rkind), intent(in) :: xarr(:) + real(rkind), intent(in) :: area_in(:), width_in(:), height_in(:) + real(rkind), intent(in) :: flow_rate_in(:) + + integer :: unit, n + + call message(0, 'Writing streamtube geometry to '//trim(filename)) + + open(newunit=unit, file=trim(filename), status='replace', action='write', form='formatted') + write(unit, '(A)') 'x,area,width_y,height_z,flow_rate' + + do n = 1, size(xarr) + write(unit, '(ES16.8,A,ES16.8,A,ES16.8,A,ES16.8,A,ES16.8)') & + xarr(n), ',', area_in(n), ',', width_in(n), ',', height_in(n), ',', flow_rate_in(n) + end do + + close(unit) + end subroutine export_geometry_csv + +subroutine export_streamtube_stl(filename, x_march, tube_y, tube_z, valid) + implicit none + + character(len=*), intent(in) :: filename + real(rkind), intent(in) :: x_march(:) + real(rkind), intent(in) :: tube_y(:,:), tube_z(:,:) + logical, intent(in) :: valid(:,:) + + integer :: unit + integer :: n, p, pp + integer :: nxm, np + real(rkind) :: v1(3), v2(3), v3(3), v4(3) + logical :: ok + + nxm = size(x_march) + np = size(tube_y, 2) + + if (size(tube_y,1) /= nxm) call gracefulExit('export_streamtube_stl: tube_y station mismatch.', 401) + if (size(tube_z,1) /= nxm) call gracefulExit('export_streamtube_stl: tube_z station mismatch.', 402) + if (size(tube_z,2) /= np ) call gracefulExit('export_streamtube_stl: tube_z point mismatch.', 403) + + call message(0, 'Writing streamtube STL to '//trim(filename)) + + open(newunit=unit, file=trim(filename), status='replace', action='write', form='formatted') + + write(unit,'(A)') 'solid streamtube' + + do n = 1, nxm - 1 + do p = 1, np + + pp = p + 1 + if (pp > np) pp = 1 + + ok = all(valid(n,:)) .and. all(valid(n+1,:)) + + if (.not. ok) cycle + + v1 = (/ x_march(n), tube_y(n, p ), tube_z(n, p ) /) + v2 = (/ x_march(n+1), tube_y(n+1,p ), tube_z(n+1,p ) /) + v3 = (/ x_march(n+1), tube_y(n+1,pp), tube_z(n+1,pp) /) + v4 = (/ x_march(n), tube_y(n, pp), tube_z(n, pp) /) + + ! Quad split: + ! Triangle 1: v1 -> v2 -> v3 + ! Triangle 2: v1 -> v3 -> v4 + call write_stl_triangle(unit, v1, v2, v3) + call write_stl_triangle(unit, v1, v3, v4) + + end do + end do + + write(unit,'(A)') 'endsolid streamtube' + + close(unit) + +end subroutine export_streamtube_stl + +subroutine write_stl_triangle(unit, a, b, c) + implicit none + + integer, intent(in) :: unit + real(rkind), intent(in) :: a(3), b(3), c(3) + + real(rkind) :: nvec(3) + + call triangle_normal(a, b, c, nvec) + + write(unit,'(A,3(1X,ES16.8))') ' facet normal', nvec(1), nvec(2), nvec(3) + write(unit,'(A)') ' outer loop' + write(unit,'(A,3(1X,ES16.8))') ' vertex', a(1), a(2), a(3) + write(unit,'(A,3(1X,ES16.8))') ' vertex', b(1), b(2), b(3) + write(unit,'(A,3(1X,ES16.8))') ' vertex', c(1), c(2), c(3) + write(unit,'(A)') ' endloop' + write(unit,'(A)') ' endfacet' + +end subroutine write_stl_triangle + +subroutine triangle_normal(a, b, c, nvec) + implicit none + + real(rkind), intent(in) :: a(3), b(3), c(3) + real(rkind), intent(out) :: nvec(3) + + real(rkind) :: ab(3), ac(3) + real(rkind) :: mag + + ab = b - a + ac = c - a + + nvec(1) = ab(2)*ac(3) - ab(3)*ac(2) + nvec(2) = ab(3)*ac(1) - ab(1)*ac(3) + nvec(3) = ab(1)*ac(2) - ab(2)*ac(1) + + mag = sqrt(nvec(1)**2 + nvec(2)**2 + nvec(3)**2) + + if (mag > tiny(one)) then + nvec = nvec / mag + else + nvec = zero + end if + +end subroutine triangle_normal + +subroutine compute_streamtube_flow_rate(u, x_march, tube_y, tube_z, valid, flow_rate) + implicit none + + real(rkind), intent(in) :: u(:,:,:) + real(rkind), intent(in) :: x_march(:) + real(rkind), intent(in) :: tube_y(:,:), tube_z(:,:) + logical, intent(in) :: valid(:,:) + real(rkind), intent(out) :: flow_rate(:) + real(rkind), allocatable :: q_local_arr(:), q_global_arr(:) + + integer :: n, ierr + integer :: nxm, np + integer :: ig0, ig1 + integer :: il0, il1 + integer :: nv + real(rkind) :: wx0, wx1, q0_local, q1_local + logical :: have_i0, have_i1 + real(rkind), allocatable :: yv(:), zv(:) + + nxm = size(x_march) + np = size(tube_y, 2) + + if (size(tube_y,1) /= nxm) call gracefulExit('compute_streamtube_flow_rate: tube_y station mismatch.', 501) + if (size(tube_z,1) /= nxm) call gracefulExit('compute_streamtube_flow_rate: tube_z station mismatch.', 502) + if (size(tube_z,2) /= np ) call gracefulExit('compute_streamtube_flow_rate: tube_z point mismatch.', 503) + if (size(valid,1) /= nxm .or. size(valid,2) /= np) call gracefulExit('compute_streamtube_flow_rate: valid size mismatch.', 504) + if (size(flow_rate) /= nxm) call gracefulExit('compute_streamtube_flow_rate: flow_rate size mismatch.', 505) + + allocate(yv(np), zv(np)) + allocate(q_local_arr(nxm), q_global_arr(nxm)) + q_local_arr = zero + q_global_arr = zero + + flow_rate = zero + + do n = 1, nxm + + ! For a closed streamtube contour, do not compact a partially invalid + ! polygon. That would close the contour with artificial chords. + if (.not. all(valid(n,:))) then + q_local_arr(n) = zero + cycle + end if + + call compact_valid_contour(tube_y(n,:), tube_z(n,:), valid(n,:), yv, zv, nv) + + if (nv < 3) then + flow_rate(n) = zero + cycle + end if + + call bracket_x_indices(x_march(n), ig0, ig1, wx0, wx1) + + call global_x_to_local(ig0, il0, have_i0) + call global_x_to_local(ig1, il1, have_i1) + + q0_local = zero + q1_local = zero + + if (have_i0) then + call integrate_u_on_xplane_cutcells(u, il0, yv, zv, nv, q0_local) + end if + + if (have_i1) then + call integrate_u_on_xplane_cutcells(u, il1, yv, zv, nv, q1_local) + end if + + q_local_arr(n) = wx0*q0_local + wx1*q1_local + + end do + + call mpi_allreduce(q_local_arr, q_global_arr, nxm, MPI_DOUBLE_PRECISION, & + MPI_SUM, MPI_COMM_WORLD, ierr) + + flow_rate = q_global_arr + + deallocate(q_local_arr, q_global_arr) + deallocate(yv, zv) + +end subroutine compute_streamtube_flow_rate + +logical function valid_mask_has_gap(valid) + implicit none + + logical, intent(in) :: valid(:) + + integer :: p, np + integer :: ntrans + + np = size(valid) + ntrans = 0 + + do p = 1, np + if (valid(p) .neqv. valid(merge(p+1,1,p 2 means multiple gaps. + valid_mask_has_gap = ntrans > 2 + +end function valid_mask_has_gap + +subroutine bracket_x_indices(xp_in, ig0, ig1, wx0, wx1) + implicit none + + real(rkind), intent(in) :: xp_in + integer, intent(out) :: ig0, ig1 + real(rkind), intent(out) :: wx0, wx1 + + real(rkind) :: xp + real(rkind) :: s + integer :: i0 + + ! x is periodic in this module. + xp = modulo(xp_in, Lx) + + s = xp / dx + i0 = floor(s) + + wx1 = s - real(i0, rkind) + wx0 = one - wx1 + + ig0 = modulo(i0, nx) + 1 + ig1 = modulo(i0 + 1, nx) + 1 + + ! Exact or near-exact grid plane. + if (abs(wx1) < 10.0_rkind*epsilon(one)) then + wx0 = one + wx1 = zero + ig1 = ig0 + end if + +end subroutine bracket_x_indices + +subroutine global_x_to_local(ig, iloc, have_i) + implicit none + + integer, intent(in) :: ig + integer, intent(out) :: iloc + logical, intent(out) :: have_i + + have_i = .false. + iloc = -1 + + if (ig < gpC%xst(1) .or. ig > gpC%xen(1)) return + + iloc = ig - gpC%xst(1) + 1 + + if (iloc < 1 .or. iloc > size(mesh,1)) then + have_i = .false. + else + have_i = .true. + end if + +end subroutine global_x_to_local + +subroutine integrate_u_on_xplane_cutcells(u, iloc, yy, zz, nv, q_local) + implicit none + + real(rkind), intent(in) :: u(:,:,:) + integer, intent(in) :: iloc + real(rkind), intent(in) :: yy(:), zz(:) + integer, intent(in) :: nv + real(rkind), intent(out) :: q_local + + integer :: j, k + real(rkind) :: yc, zc + real(rkind) :: ylo, yhi, zlo, zhi + real(rkind) :: frac + real(rkind) :: cell_area + real(rkind) :: ymin_poly, ymax_poly + real(rkind) :: zmin_poly, zmax_poly + + q_local = zero + cell_area = dy * dz + + call valid_contour_bounds(yy, zz, nv, ymin_poly, ymax_poly, zmin_poly, zmax_poly) + + if (ymax_poly <= ymin_poly) return + if (zmax_poly <= zmin_poly) return + + do k = 1, size(u,3) + do j = 1, size(u,2) + + yc = mesh(iloc,j,k,2) + zc = mesh(iloc,j,k,3) + + ylo = yc - half*dy + yhi = yc + half*dy + zlo = zc - half*dz + zhi = zc + half*dz + + if (yhi < ymin_poly) cycle + if (ylo > ymax_poly) cycle + if (zhi < zmin_poly) cycle + if (zlo > zmax_poly) cycle + + call cell_area_fraction_by_sampling(yy, zz, nv, ylo, yhi, zlo, zhi, frac) + + if (frac > zero) then + q_local = q_local + u(iloc,j,k) * frac * cell_area + end if + + end do + end do + +end subroutine integrate_u_on_xplane_cutcells + +subroutine valid_contour_bounds(yy, zz, nv, ymin_poly, ymax_poly, zmin_poly, zmax_poly) + implicit none + + real(rkind), intent(in) :: yy(:), zz(:) + integer, intent(in) :: nv + real(rkind), intent(out) :: ymin_poly, ymax_poly + real(rkind), intent(out) :: zmin_poly, zmax_poly + + integer :: p + + if (nv < 1) then + ymin_poly = zero + ymax_poly = zero + zmin_poly = zero + zmax_poly = zero + return + end if + + ymin_poly = yy(1) + ymax_poly = yy(1) + zmin_poly = zz(1) + zmax_poly = zz(1) + + do p = 2, nv + ymin_poly = min(ymin_poly, yy(p)) + ymax_poly = max(ymax_poly, yy(p)) + zmin_poly = min(zmin_poly, zz(p)) + zmax_poly = max(zmax_poly, zz(p)) + end do + +end subroutine valid_contour_bounds + +subroutine cell_area_fraction_by_sampling(yy, zz, nv, ylo, yhi, zlo, zhi, frac) + implicit none + + real(rkind), intent(in) :: yy(:), zz(:) + integer, intent(in) :: nv + real(rkind), intent(in) :: ylo, yhi, zlo, zhi + real(rkind), intent(out) :: frac + + logical :: c1, c2, c3, c4 + integer :: ninside + + c1 = point_in_polygon(yy, zz, nv, ylo, zlo) + c2 = point_in_polygon(yy, zz, nv, yhi, zlo) + c3 = point_in_polygon(yy, zz, nv, yhi, zhi) + c4 = point_in_polygon(yy, zz, nv, ylo, zhi) + + ninside = 0 + if (c1) ninside = ninside + 1 + if (c2) ninside = ninside + 1 + if (c3) ninside = ninside + 1 + if (c4) ninside = ninside + 1 + + if (ninside == 4) then + frac = one + else + call partial_cell_area_fraction_sampling(yy, zz, nv, ylo, yhi, zlo, zhi, frac) + end if + +end subroutine cell_area_fraction_by_sampling + +subroutine partial_cell_area_fraction_sampling(yy, zz, nv, ylo, yhi, zlo, zhi, frac) + implicit none + + real(rkind), intent(in) :: yy(:), zz(:) + integer, intent(in) :: nv + real(rkind), intent(in) :: ylo, yhi, zlo, zhi + real(rkind), intent(out) :: frac + + integer :: iy, iz + integer :: ny_samp, nz_samp + integer :: ninside, ntotal + real(rkind) :: yp, zp + real(rkind) :: sy, sz + + ny_samp = max(3, streamtube_cutcell_nsamp_y) + nz_samp = max(3, streamtube_cutcell_nsamp_z) + + ninside = 0 + ntotal = ny_samp * nz_samp + + do iz = 1, nz_samp + + sz = real(iz - 1, rkind) / real(nz_samp - 1, rkind) + zp = zlo + sz * (zhi - zlo) + + do iy = 1, ny_samp + + sy = real(iy - 1, rkind) / real(ny_samp - 1, rkind) + yp = ylo + sy * (yhi - ylo) + + if (point_in_polygon(yy, zz, nv, yp, zp)) then + ninside = ninside + 1 + end if + + end do + end do + + frac = real(ninside, rkind) / real(ntotal, rkind) + +end subroutine partial_cell_area_fraction_sampling + +subroutine build_streamtube_valid_mask(tube_y, tube_z, valid) + implicit none + + real(rkind), intent(in) :: tube_y(:,:), tube_z(:,:) + logical, intent(out) :: valid(:,:) + + integer :: n, p + + if (size(valid,1) /= size(tube_y,1)) call gracefulExit('build_streamtube_valid_mask: station mismatch.', 531) + if (size(valid,2) /= size(tube_y,2)) call gracefulExit('build_streamtube_valid_mask: point mismatch.', 532) + if (size(tube_z,1) /= size(tube_y,1)) call gracefulExit('build_streamtube_valid_mask: tube_z station mismatch.', 533) + if (size(tube_z,2) /= size(tube_y,2)) call gracefulExit('build_streamtube_valid_mask: tube_z point mismatch.', 534) + + do n = 1, size(tube_y,1) + do p = 1, size(tube_y,2) + valid(n,p) = is_valid_point(tube_y(n,p), tube_z(n,p)) + end do + end do + +end subroutine build_streamtube_valid_mask + +logical function point_in_polygon(yy, zz, nv, yp, zp) +!=============================================================================== +! Point-in-polygon classification +! +! Implements the dual-perspective point-in-polygon method of Ali and Guaily. +! The method classifies a point by identifying the closest polygon vertex and +! combining the inside/outside perspectives of the two parent edges attached to +! that vertex. Points lying exactly on polygon edges are treated as inside for +! the present streamtube area-fraction calculation. +! +! Reference: +! Ali, K. M. and Guaily, A. (2020). "Dual perspective method for solving the +! point in a polygon problem." arXiv:2012.05001. +! +! Notes: +! - The polygon vertices must be ordered consistently around the contour. +! - The polygon must be non-self-intersecting. +! - This implementation assumes compacted valid vertices are passed in; invalid +! streamtube points should be removed before calling point_in_polygon. +!=============================================================================== + implicit none + + real(rkind), intent(in) :: yy(:), zz(:) + integer, intent(in) :: nv + real(rkind), intent(in) :: yp, zp + + integer :: ic, iprev, inext + integer :: s1, s2 + logical :: L1, L2 + logical :: dismiss1, dismiss2 + real(rkind) :: c + real(rkind) :: A1y, A1z, A2y, A2z + real(rkind) :: tol + real(rkind) :: area_signed + logical :: ccw + + point_in_polygon = .false. + + if (nv < 3) return + + tol = point_polygon_tolerance(yy, zz, nv) + + call polygon_signed_area(yy, zz, nv, area_signed) + + if (abs(area_signed) <= tol) then + point_in_polygon = .false. + return + end if + + ccw = area_signed > zero + + call closest_vertex(yy, zz, nv, yp, zp, ic) + + if (ic < 1) then + point_in_polygon = .false. + return + end if + + if ((yp - yy(ic))**2 + (zp - zz(ic))**2 <= tol**2) then + point_in_polygon = .true. + return + end if + + iprev = ic - 1 + if (iprev < 1) iprev = nv + + inext = ic + 1 + if (inext > nv) inext = 1 + + A1y = yy(inext) - yy(ic) + A1z = zz(inext) - zz(ic) + + A2y = yy(iprev) - yy(ic) + A2z = zz(iprev) - zz(ic) + + c = A1y*A2z - A1z*A2y + + call edge_perspective_sign(yy(ic), zz(ic), yy(inext), zz(inext), & + yp, zp, ccw, tol, s1, L1, dismiss1) + + call edge_perspective_sign(yy(iprev), zz(iprev), yy(ic), zz(ic), & + yp, zp, ccw, tol, s2, L2, dismiss2) + + if ((s1 == 0 .and. L1) .or. (s2 == 0 .and. L2)) then + point_in_polygon = .true. + return + end if + + if (dismiss1 .and. .not. dismiss2) then + point_in_polygon = s2 <= 0 + return + end if + + if (dismiss2 .and. .not. dismiss1) then + point_in_polygon = s1 <= 0 + return + end if + + if (dismiss1 .and. dismiss2) then + point_in_polygon = .false. + return + end if + + if (c > tol) then + + if (s1 == 1 .and. s2 == 1) then + point_in_polygon = .false. + else + point_in_polygon = .true. + end if + + else if (abs(c) <= tol) then + + if (s1 == 1) then + point_in_polygon = .false. + else + point_in_polygon = .true. + end if + + else + + if (s1 == -1 .and. s2 == -1) then + point_in_polygon = .true. + else + point_in_polygon = .false. + end if + + end if + +end function point_in_polygon + +subroutine closest_vertex(yy, zz, nv, yp, zp, ic) + implicit none + + real(rkind), intent(in) :: yy(:), zz(:) + integer, intent(in) :: nv + real(rkind), intent(in) :: yp, zp + integer, intent(out) :: ic + + integer :: p + real(rkind) :: d2, d2min + + ic = 1 + d2min = (yp - yy(1))**2 + (zp - zz(1))**2 + + do p = 2, nv + d2 = (yp - yy(p))**2 + (zp - zz(p))**2 + + if (d2 < d2min) then + d2min = d2 + ic = p + end if + end do + +end subroutine closest_vertex + +subroutine edge_perspective_sign(ya, za, yb, zb, yp, zp, ccw, tol, s, L, dismiss) + implicit none + + real(rkind), intent(in) :: ya, za + real(rkind), intent(in) :: yb, zb + real(rkind), intent(in) :: yp, zp + logical, intent(in) :: ccw + real(rkind), intent(in) :: tol + + integer, intent(out) :: s + logical, intent(out) :: L + logical, intent(out) :: dismiss + + real(rkind) :: ey, ez + real(rkind) :: ny, nz + real(rkind) :: my, mz + real(rkind) :: ry, rz + real(rkind) :: d + + ey = yb - ya + ez = zb - za + + ! Outward normal. + ! + ! For a counter-clockwise polygon, the interior is on the left of each + ! directed edge, so the outward normal is the right normal. + ! + ! Edge vector: e = (ey, ez) + ! Right normal: n = ( ez, -ey) + ! Left normal: n = (-ez, ey) + if (ccw) then + ny = ez + nz = -ey + else + ny = -ez + nz = ey + end if + + my = half * (ya + yb) + mz = half * (za + zb) + + ry = yp - my + rz = zp - mz + + d = ny*ry + nz*rz + + L = point_on_segment(ya, za, yb, zb, yp, zp, tol) + + if (d > tol) then + s = 1 + dismiss = .false. + else if (d < -tol) then + s = -1 + dismiss = .false. + else + s = 0 + + if (L) then + dismiss = .false. + else + ! Point is on the extension of the edge, but not on the edge itself. + ! This parent edge perspective is dismissed. + dismiss = .true. + end if + end if + +end subroutine edge_perspective_sign + +logical function point_on_segment(ya, za, yb, zb, yp, zp, tol) + implicit none + + real(rkind), intent(in) :: ya, za + real(rkind), intent(in) :: yb, zb + real(rkind), intent(in) :: yp, zp + real(rkind), intent(in) :: tol + + real(rkind) :: ey, ez + real(rkind) :: py, pz + real(rkind) :: crossp + real(rkind) :: dotp + real(rkind) :: len2, elen + + ey = yb - ya + ez = zb - za + + py = yp - ya + pz = zp - za + + crossp = ey*pz - ez*py + len2 = ey*ey + ez*ez + elen = sqrt(len2) + + if (len2 <= tol**2) then + point_on_segment = (py*py + pz*pz <= tol**2) + return + end if + + if (abs(crossp) > tol * elen) then + point_on_segment = .false. + return + end if + + dotp = py*ey + pz*ez + + point_on_segment = dotp >= -tol*elen .and. dotp <= len2 + tol*elen + +end function point_on_segment + +subroutine polygon_signed_area(yy, zz, nv, area_signed) + implicit none + + real(rkind), intent(in) :: yy(:), zz(:) + integer, intent(in) :: nv + real(rkind), intent(out) :: area_signed + + integer :: p, pp + real(rkind) :: accum + real(rkind) :: yc, zc + real(rkind) :: yp, zp, ypp, zpp + + if (nv < 3) then + area_signed = zero + return + end if + + yc = sum(yy(1:nv)) / real(nv, rkind) + zc = sum(zz(1:nv)) / real(nv, rkind) + + accum = zero + + do p = 1, nv + pp = p + 1 + if (pp > nv) pp = 1 + + yp = yy(p) - yc + zp = zz(p) - zc + ypp = yy(pp) - yc + zpp = zz(pp) - zc + + accum = accum + yp*zpp - zp*ypp + end do + + area_signed = half * accum + +end subroutine polygon_signed_area + +real(rkind) function point_polygon_tolerance(yy, zz, nv) + implicit none + + real(rkind), intent(in) :: yy(:), zz(:) + integer, intent(in) :: nv + + real(rkind) :: ymin, ymax + real(rkind) :: zmin, zmax + real(rkind) :: scale + + if (nv < 1) then + point_polygon_tolerance = 100.0_rkind * epsilon(one) + return + end if + + ymin = minval(yy(1:nv)) + ymax = maxval(yy(1:nv)) + zmin = minval(zz(1:nv)) + zmax = maxval(zz(1:nv)) + + scale = max(ymax - ymin, zmax - zmin) + scale = max(scale, one) + + point_polygon_tolerance = 100.0_rkind * epsilon(one) * scale + +end function point_polygon_tolerance + +subroutine compact_valid_contour(yy, zz, valid, yv, zv, nv) + implicit none + + real(rkind), intent(in) :: yy(:), zz(:) + logical, intent(in) :: valid(:) + real(rkind), intent(out) :: yv(:), zv(:) + integer, intent(out) :: nv + + integer :: p, np + + np = size(yy) + + if (size(zz) /= np) call gracefulExit('compact_valid_contour: zz size mismatch.', 520) + if (size(valid) /= np) call gracefulExit('compact_valid_contour: valid size mismatch.', 521) + if (size(yv) < np) call gracefulExit('compact_valid_contour: yv too small.', 522) + if (size(zv) < np) call gracefulExit('compact_valid_contour: zv too small.', 523) + + nv = 0 + + do p = 1, np + if (valid(p)) then + nv = nv + 1 + yv(nv) = yy(p) + zv(nv) = zz(p) + end if + end do + +end subroutine compact_valid_contour + +subroutine check_streamtube_valid_topology(valid) + implicit none + + logical, intent(in) :: valid(:,:) + + integer :: n + + do n = 1, size(valid,1) + if (valid_mask_has_gap(valid(n,:))) then + call gracefulExit( & + 'Streamtube contour has multiple invalid gaps; polygon topology is ambiguous.', & + 560) + end if + end do + +end subroutine check_streamtube_valid_topology + +end module streamtube_mod + + +program constructStreamtube + use streamtube_mod + + implicit none + + integer :: ioUnit, ierr + character(len=clen) :: inputfile, ers, filename + + character(len=clen) :: outputdir = '.' + character(len=clen) :: inputdir = '.' + + ! User-facing namelist controls. + character(len=clen) :: initial_contour_file = '' + character(len=clen) :: output_streamtube_file = 'streamtube.csv' + character(len=clen) :: output_geometry_file = 'streamtube_geometry.csv' + character(len=clen) :: output_stl_file = 'streamtube.stl' + character(len=2) :: crid, cbrid + character(len=6) :: ctid, ccount + + integer :: RunID, BaseRunID, TID, counter + integer :: num_x_stations = 101 + integer :: num_contour_points = 0 + real(rkind) :: x_start = zero + real(rkind) :: x_end = one + logical :: write_geometry = .true., write_stl = .true., exists + + ! Internal names retained for consistency with the streamtube module. + integer :: nxm, np + + real(rkind), allocatable :: u(:,:,:), v(:,:,:), w(:,:,:) + real(rkind), allocatable :: x_march(:) + real(rkind), allocatable :: y0(:), z0(:) + real(rkind), allocatable :: tube_y(:,:), tube_z(:,:) + real(rkind), allocatable :: area(:), width_y(:), height_z(:), flow_rate(:) + logical, allocatable :: valid(:,:) + + namelist /INPUT/ nx, ny, nz, Lx, Ly, Lz, prow, pcol, NumericalSchemeVert, & + PeriodicInZ, botWall, topWall, & + RunID, BaseRunID, TID, counter,& + initial_contour_file, inputdir, outputdir, & + x_start, x_end, num_x_stations, num_contour_points, & + output_streamtube_file, write_geometry, output_geometry_file, & + output_stl_file, write_stl + + call MPI_Init(ierr) + call get_command_argument(1, inputfile) + + if (len_trim(inputfile) == 0) then + call gracefulExit('Usage: constructStreamtube input.dat', 100) + end if + + 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,'(I0)') ierr + call gracefulExit('Reading failed for INPUT with error '//trim(ers), 101) + end if + close(ioUnit) + + if (len_trim(initial_contour_file) == 0) call gracefulExit('INPUT requires initial_contour_file.', 105) + if (num_x_stations < 2) call gracefulExit('num_x_stations must be at least 2.', 106) + + nxm = num_x_stations + + ! Count the initial contour points unless the user supplies the expected count. + if (num_contour_points > 0) then + np = num_contour_points + else + call count_initial_contour_points(trim(initial_contour_file), np) + end if + + if (np < 3) call gracefulExit('The initial contour must contain at least 3 valid points.', 107) + + call initialize_streamtube_module(nx, ny, nz, Lx, Ly, Lz, prow, pcol) + + allocate(u(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3)), source=zero) + allocate(v(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3)), source=zero) + allocate(w(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3)), source=zero) + allocate(rbuffxC(gpC%xsz(1), gpC%xsz(2), gpC%xsz(3)), source=zero) + + allocate(x_march(nxm)) + allocate(y0(np), z0(np)) + allocate(tube_y(nxm,np), tube_z(nxm,np)) + + call build_x_march(x_start, x_end, x_march) + call read_initial_contour_csv(trim(initial_contour_file), y0, z0) + + write(crid, '(I2.2)') RunID + write(cbrid, '(I2.2)') BaseRunID + write(ctid, '(I6.6)') TID + write(ccount, '(I6.6)') counter + + ! Read the velocity fields + + ! Delta u + filename = trim(inputdir)//'/Run'//trim(crid)//'_comp_deficit_budget0_term01_t'//trim(ctid)//'_n'//trim(ccount)//'.s3D' + inquire(file=trim(filename), exist=exists) + if (.not. exists) call gracefulExit('Missing: '//trim(filename), 707) + call message(0, 'Reading '//trim(filename)) + call decomp_2d_read_one(1, rbuffxC, trim(filename), gpC) + u = rbuffxC + + ! Base u + filename = trim(inputdir)//'/Run'//trim(cbrid)//'_budget0_term01_t'//trim(ctid)//'_n'//trim(ccount)//'.s3D' + inquire(file=trim(filename), exist=exists) + if (.not. exists) call gracefulExit('Missing: '//trim(filename), 708) + call message(0, 'Reading '//trim(filename)) + call decomp_2d_read_one(1, rbuffxC, trim(filename), gpC) + u = u + rbuffxC + + ! Delta v + filename = trim(inputdir)//'/Run'//trim(crid)//'_comp_deficit_budget0_term02_t'//trim(ctid)//'_n'//trim(ccount)//'.s3D' + inquire(file=trim(filename), exist=exists) + if (.not. exists) call gracefulExit('Missing: '//trim(filename), 709) + call message(0, 'Reading '//trim(filename)) + call decomp_2d_read_one(1, rbuffxC, trim(filename), gpC) + v = rbuffxC + + ! Base v + filename = trim(inputdir)//'/Run'//trim(cbrid)//'_budget0_term02_t'//trim(ctid)//'_n'//trim(ccount)//'.s3D' + inquire(file=trim(filename), exist=exists) + if (.not. exists) call gracefulExit('Missing: '//trim(filename), 710) + call message(0, 'Reading '//trim(filename)) + call decomp_2d_read_one(1, rbuffxC, trim(filename), gpC) + v = v + rbuffxC + + ! Delta w + filename = trim(inputdir)//'/Run'//trim(crid)//'_comp_deficit_budget0_term03_t'//trim(ctid)//'_n'//trim(ccount)//'.s3D' + inquire(file=trim(filename), exist=exists) + if (.not. exists) call gracefulExit('Missing: '//trim(filename), 711) + call message(0, 'Reading '//trim(filename)) + call decomp_2d_read_one(1, rbuffxC, trim(filename), gpC) + w = rbuffxC + + ! Base w + filename = trim(inputdir)//'/Run'//trim(cbrid)//'_budget0_term03_t'//trim(ctid)//'_n'//trim(ccount)//'.s3D' + inquire(file=trim(filename), exist=exists) + if (.not. exists) call gracefulExit('Missing: '//trim(filename), 712) + call message(0, 'Reading '//trim(filename)) + call decomp_2d_read_one(1, rbuffxC, trim(filename), gpC) + w = w + rbuffxC + + call march_streamtube_xpencil(u, v, w, x_march, y0, z0, tube_y, tube_z) + + allocate(valid(nxm,np)) + call build_streamtube_valid_mask(tube_y, tube_z, valid) + + call check_streamtube_valid_topology(valid) + + if (write_geometry) then + call message(0, "Post Processing the streamtube ...") + allocate(area(nxm), width_y(nxm), height_z(nxm), flow_rate(nxm)) + + call compute_contour_area(tube_y, tube_z, valid, area) + call compute_contour_extents(tube_y, tube_z, valid, width_y, height_z) + call compute_streamtube_flow_rate(u, x_march, tube_y, tube_z, valid, flow_rate) + end if + + if(nrank == 0) then + call export_streamtube_csv(trim(outputdir)//'/'//trim(output_streamtube_file), x_march, tube_y, tube_z) + + if (write_geometry) then + call export_geometry_csv(trim(outputdir)//'/'//trim(output_geometry_file), & + x_march, area, width_y, height_z, flow_rate) + end if + + if(write_stl)then + call export_streamtube_stl(trim(outputdir)//'/'//trim(output_stl_file), & + x_march, tube_y, tube_z, valid) + end if + end if + + if (write_geometry) then + deallocate(area, width_y, height_z, flow_rate) + end if + + deallocate(tube_y, tube_z) + deallocate(y0, z0) + deallocate(x_march) + deallocate(u, v, w) + deallocate(valid) + + call release_streamtube_module() + call MPI_Finalize(ierr) + +end program constructStreamtube diff --git a/problems/postprocessing_igrid/Streamtube_files/input_streamtube.dat b/problems/postprocessing_igrid/Streamtube_files/input_streamtube.dat new file mode 100644 index 00000000..6c5bfc72 --- /dev/null +++ b/problems/postprocessing_igrid/Streamtube_files/input_streamtube.dat @@ -0,0 +1,26 @@ +&INPUT +inputdir = "/anvil/scratch/x-kali/PadeOpsSims/EXT-BLH800/t092440_n014462" +outputdir = "/anvil/scratch/x-kali/PadeOpsSims/EXT-BLH800/slices_t092440_n014462" ! Directory for all output files +nx = 2200 ! Number of points in X +ny = 1000 ! Number of points in Y +nz = 800 ! Number of points in Z +Lx = 698.4126984D0 ! Domain Length (appropriate dimesnions/non-dimensionalized) +Ly = 158.7301587D0 ! Domain Width (appropriate dimesnions/non-dimensionalized) +Lz = 63.49206349D0 ! Domain Height (appropriate dimesnions/non-dimensionalized) +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) +NumericalSchemeVert = 1 +botWall = 3 +topWall = 2 +RunID = 9 +BaseRunID = 8 +TID = 92440 +counter = 14462 +initial_contour_file = "/anvil/scratch/x-kali/PadeOpsSims/EXT-BLH800/input_streamtube_seed.csv" +num_contour_points = 100 ! If not provided, will be counted from the csv file +x_start = 120 ! x-station of the streamtube seed in "initial_contour_file" +x_end = 540 ! where to end the computed streamtube +num_x_stations = 210 ! x resolution of the streamtube +write_geometry = .true. ! Write geometric characterstics os the streamtube (Area, Width, Height)? +write_stl = .true. ! Write the streamtube as an STL? +/ From bafe6d391735894b2f64d80f8f85dfcd5478cc48 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 24 Jun 2026 17:37:12 -0400 Subject: [PATCH 112/114] Add a TMP type in CosntructDeficitBudgets --- .../ConstructDeficitBudgets.F90 | 163 ++++++++++++++---- 1 file changed, 133 insertions(+), 30 deletions(-) diff --git a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 index 616914a4..c4643478 100644 --- a/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 +++ b/problems/postprocessing_igrid/ConstructDeficitBudgets.F90 @@ -35,7 +35,7 @@ module constructDeficitBudgets_mod 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, 5: MKE + integer :: budgettype=1 ! 1: x-Momentum, 2: y-Momentum, 3: z-Momentum, 4: TKE, 5: MKE, 6: TMP real(rkind), dimension(:,:,:), pointer :: dudx, dudy, dudz real(rkind), dimension(:,:,:), pointer :: dvdx, dvdy, dvdz real(rkind), dimension(:,:,:), pointer :: dwdx, dwdy, dwdz @@ -73,6 +73,8 @@ subroutine export_csv(key, stamp) name = 'TKE' case(5) name = 'MKE' + case(6) + name = 'TMP' end select write(crid, '(I2.2)') RID @@ -152,6 +154,9 @@ subroutine compute_budgets(key, stamp) case(5) call compute_MKE_budget_component(idx, buffer) additional = '8' + case(6) + call compute_TMP_budget_component(idx, buffer) + additional = '9' end select ! Average this budget term across the box @@ -182,6 +187,9 @@ function depedent_variable(idx) elseif(budgettype == 5)then ! MKE equation depedent_variable = .true. + elseif(budgettype == 6)then + ! TMP + depedent_variable = .true. end if end function depedent_variable @@ -460,7 +468,7 @@ subroutine compute_TKE_budget_component(idx, buffer) BF1 => rbuffxC(:,:,:,1) BF2 => rbuffxC(:,:,:,2) - + buffer = zero select case(idx) case(1) @@ -469,35 +477,35 @@ subroutine compute_TKE_budget_component(idx, buffer) call ddx_R2R(BF1, BF2); buffer = buffer + BF2*du call ddy_R2R(BF1, BF2); buffer = buffer + BF2*dv call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*dw ! 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*du call ddy_R2R(BF1, BF2); buffer = buffer + BF2*dv call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*dw ! 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*du call ddy_R2R(BF1, BF2); buffer = buffer + BF2*dv call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*dw ! 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*ubase call ddy_R2R(BF1, BF2); buffer = buffer + BF2*vbase call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*wbase ! 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*ubase call ddy_R2R(BF1, BF2); buffer = buffer + BF2*vbase call ddz_R2R(BF1, BF2, 1, 1); buffer = buffer + BF2*wbase ! 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) + & @@ -537,7 +545,7 @@ subroutine compute_TKE_budget_component(idx, buffer) case(13) ! Buoyancy: mean(delta w' delta wb') buffer = - budget3(:,:,:,10) - + case(14) ! Buoyancy: mean(delta w' base wb') buffer = - budget3(:,:,:,11) @@ -610,7 +618,100 @@ subroutine compute_TKE_budget_component(idx, buffer) ! SGS Dissipation: mean(delta tau_ij' partial_j delta u_i') buffer = -budget3(:,:,:,9) end select - + + nullify(BF1, BF2) + end subroutine + + subroutine compute_TMP_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) + ! Turbulent Transport: dj(delta u_i * mean(delta u_i' delta u_j')) + BF1 = du * budget1(:,:,:,1) + dv * budget1(:,:,:,2) + dw * budget1(:,:,:,3) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = du * budget1(:,:,:,2) + dv * budget1(:,:,:,4) + dw * budget1(:,:,:,5) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = du * budget1(:,:,:,3) + dv * budget1(:,:,:,5) + dw * budget1(:,:,:,6) + call ddz_R2R(BF1, BF2, -1, -1); buffer = buffer + BF2 + + case(2) + ! Turbulent Transport: dj(delta u_i * mean(delta u_i' base u_j')) + BF1 = du * budget1(:,:,:,7) + dv * budget1(:,:,:,9) + dw * budget1(:,:,:,11) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = du * budget1(:,:,:,8) + dv * budget1(:,:,:,12) + dw * budget1(:,:,:,14) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = du * budget1(:,:,:,10) + dv * budget1(:,:,:,13) + dw * budget1(:,:,:,15) + call ddz_R2R(BF1, BF2, -1, -1); buffer = buffer + BF2 + + case(3) + ! Turbulent Transport: dj(delta u_i * mean(base u_i' delta u_j')) + BF1 = du * budget1(:,:,:,7) + dv * budget1(:,:,:,8) + dw * budget1(:,:,:,10) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = du * budget1(:,:,:,9) + dv * budget1(:,:,:,12) + dw * budget1(:,:,:,13) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = du * budget1(:,:,:,11) + dv * budget1(:,:,:,14) + dw * budget1(:,:,:,15) + call ddz_R2R(BF1, BF2, -1, -1); buffer = buffer + BF2 + + case(4) + ! Turbulent Transport: dj(delta u_i * mean(base u_i' base u_j')) + BF1 = du * baseBudget0(:,:,:,4) + dv * baseBudget0(:,:,:,5) + dw * baseBudget0(:,:,:,6) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = du * baseBudget0(:,:,:,5) + dv * baseBudget0(:,:,:,7) + dw * baseBudget0(:,:,:,8) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = du * baseBudget0(:,:,:,6) + dv * baseBudget0(:,:,:,8) + dw * baseBudget0(:,:,:,9) + call ddz_R2R(BF1, BF2, -1, -1); buffer = buffer + BF2 + + case(5) + ! Turbulent Transport: dj(base u_i * mean(delta u_i' delta u_j')) + BF1 = ubase * budget1(:,:,:,1) + vbase * budget1(:,:,:,2) + wbase * budget1(:,:,:,3) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = ubase * budget1(:,:,:,2) + vbase * budget1(:,:,:,4) + wbase * budget1(:,:,:,5) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = ubase * budget1(:,:,:,3) + vbase * budget1(:,:,:,5) + wbase * budget1(:,:,:,6) + call ddz_R2R(BF1, BF2, -1, -1); buffer = buffer + BF2 + + case(6) + ! Turbulent Transport: dj(base u_i * mean(delta u_i' base u_j')) + BF1 = ubase * budget1(:,:,:,7) + vbase * budget1(:,:,:,9) + wbase * budget1(:,:,:,11) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = ubase * budget1(:,:,:,8) + vbase * budget1(:,:,:,12) + wbase * budget1(:,:,:,14) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = ubase * budget1(:,:,:,10) + vbase * budget1(:,:,:,13) + wbase * budget1(:,:,:,15) + call ddz_R2R(BF1, BF2, -1, -1); buffer = buffer + BF2 + + case(7) + ! Turbulent Transport: dj(base u_i * mean(base u_i' delta u_j')) + BF1 = ubase * budget1(:,:,:,7) + vbase * budget1(:,:,:,8) + wbase * budget1(:,:,:,10) + call ddx_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = ubase * budget1(:,:,:,9) + vbase * budget1(:,:,:,12) + wbase * budget1(:,:,:,13) + call ddy_R2R(BF1, BF2); buffer = buffer + BF2 + + BF1 = ubase * budget1(:,:,:,11) + vbase * budget1(:,:,:,14) + wbase * budget1(:,:,:,15) + call ddz_R2R(BF1, BF2, -1, -1); buffer = buffer + BF2 + + end select + nullify(BF1, BF2) end subroutine @@ -622,7 +723,7 @@ subroutine compute_MKE_budget_component(idx, buffer) BF1 => rbuffxC(:,:,:,1) BF2 => rbuffxC(:,:,:,2) - + buffer = zero select case(idx) case(1) @@ -635,7 +736,7 @@ subroutine compute_MKE_budget_component(idx, buffer) buffer = ubase * (dudx * ubase + dudy * vbase + dudz * wbase) + & vbase * (dvdx * ubase + dvdy * vbase + dvdz * wbase) + & wbase * (dwdx * ubase + dwdy * vbase + dwdz * wbase) - + case(3) ! Advection: delta u_i base u_j partial_j delta u_i buffer = du * (dudx * ubase + dudy * vbase + dudz * wbase) + & @@ -687,7 +788,7 @@ subroutine compute_MKE_budget_component(idx, buffer) case(12) ! Pressure gradient: base u_i * d_i delta p buffer = ubase * budget0(:,:,:,18) + vbase * budget0(:,:,:,19) + wbase * budget0(:,:,:,20) - + case(13) ! Pressure gradient: delta u_i * d_i base p ! Make sure that squeeze was .true. in the main simulation @@ -747,7 +848,7 @@ subroutine compute_MKE_budget_component(idx, buffer) ! Coriolis: base u_i * delta ucor_i buffer = ubase * budget0(:,:,:,15) + vbase * budget0(:,:,:,16) end select - + nullify(BF1, BF2) end subroutine @@ -916,7 +1017,7 @@ subroutine get_boundary_conditions_stencil() wBC_bottom = -1 wBC_top = -1 - + !! Bottom wall call message(0,"Bottom Wall Boundary Condition is:") select case (botWall) @@ -938,7 +1039,7 @@ subroutine get_boundary_conditions_stencil() 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) @@ -960,7 +1061,7 @@ subroutine get_boundary_conditions_stencil() case default call gracefulExit("Invalid choice for TOP WALL BCs",13) end select - + end subroutine subroutine readBudgets(key, stamp) @@ -970,8 +1071,10 @@ subroutine readBudgets(key, stamp) character(len=clen) :: pattern, filename logical :: exists real(rkind), dimension(:,:,:,:), pointer :: budget - + do budgetid=0,3 + if((budgetid == 3) .and. (budgettype /= 4)) cycle ! budget3 is only relevant for TKE budgets + select case(budgetid) case(0) budget => budget0 @@ -983,8 +1086,6 @@ subroutine readBudgets(key, stamp) 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) @@ -1117,10 +1218,10 @@ subroutine get_keys_stamps() 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) @@ -1441,7 +1542,7 @@ 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) @@ -1451,18 +1552,18 @@ subroutine ddx_R2R(f, dfdx) 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) @@ -1534,6 +1635,8 @@ subroutine initializeEverything() num_profiles = 31 case(5) num_profiles = 26 + case(6) + num_profiles = 7 end select allocate(profiles(nx_box, num_profiles)) @@ -1578,7 +1681,7 @@ subroutine release_memory() 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) nullify(du, dv, dw, ubase, vbase, wbase) @@ -1595,12 +1698,12 @@ 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 @@ -1653,7 +1756,7 @@ program constructDeficitBudgets ! Get file list and sort by time call get_keys_stamps() - + ! Loop through time frames do k = 1, size(sorted_keys) call tic() @@ -1685,4 +1788,4 @@ program constructDeficitBudgets call release_memory() call MPI_FINALIZE(ierr) -end program constructDeficitBudgets \ No newline at end of file +end program constructDeficitBudgets From 6fe9e3cbca0e1d7cb02e0f79c46b92f2592ee5e1 Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 24 Jun 2026 17:39:02 -0400 Subject: [PATCH 113/114] Refactor CMake dependency discovery for portable platform stacks --- CMakeLists.txt | 113 +---------- cmake/Find2DECOMP.cmake | 38 ++++ cmake/FindFFTW.cmake | 38 ++++ cmake/FindSZIP.cmake | 31 ++++ cmake/PadeOpsCompiler.cmake | 96 ++++++++++ cmake/PadeOpsDependencies.cmake | 79 ++++++++ cmake/PadeOpsHDF5.cmake | 114 ++++++++++++ cmake/PadeOpsLAPACK.cmake | 54 ++++++ cmake/PadeOpsModuleEnv.cmake | 186 +++++++++++++++++++ problems/CMakeLists.txt | 12 +- problems/compressible/CMakeLists.txt | 12 +- problems/incompressible/CMakeLists.txt | 11 +- problems/postprocessing/CMakeLists.txt | 13 +- problems/postprocessing_igrid/CMakeLists.txt | 11 +- problems/solids/CMakeLists.txt | 12 +- problems/turbines/CMakeLists.txt | 11 +- setup/SetupEnv_Anvil.sh | 18 -- setup/SetupEnv_Anvil_impi.sh | 18 ++ src/CMakeLists.txt | 75 +++----- tests/CMakeLists.txt | 16 +- 20 files changed, 689 insertions(+), 269 deletions(-) create mode 100644 cmake/Find2DECOMP.cmake create mode 100644 cmake/FindFFTW.cmake create mode 100644 cmake/FindSZIP.cmake create mode 100644 cmake/PadeOpsCompiler.cmake create mode 100644 cmake/PadeOpsDependencies.cmake create mode 100644 cmake/PadeOpsHDF5.cmake create mode 100644 cmake/PadeOpsLAPACK.cmake create mode 100644 cmake/PadeOpsModuleEnv.cmake delete mode 100644 setup/SetupEnv_Anvil.sh create mode 100644 setup/SetupEnv_Anvil_impi.sh diff --git a/CMakeLists.txt b/CMakeLists.txt index ec318bd3..a530c765 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,118 +1,15 @@ -cmake_minimum_required(VERSION 2.8) -project(PadeOps) +cmake_minimum_required(VERSION 3.16) +project(PadeOps LANGUAGES Fortran) -enable_language(Fortran) - -set( CMAKE_MODULE_PATH ${PadeOps_SOURCE_DIR} ) +list(PREPEND CMAKE_MODULE_PATH "${PadeOps_SOURCE_DIR}/cmake") if (NOT CMAKE_BUILD_TYPE) message(STATUS "No build type selected, default to Release") set(CMAKE_BUILD_TYPE "Release") endif() -# Where to look for FFTW -set(FFTW_PATH $ENV{FFTW_PATH}) -set(FFTW_LIBRARY_PATH "${FFTW_PATH}/lib") -set(FFTW_INCLUDE_PATH "${FFTW_PATH}/include") - -# Where to look for DECOMP&FFT -set(DECOMP_PATH $ENV{DECOMP_PATH}) -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") - -# Where to look for HDF5 -set(HDF5_PATH $ENV{HDF5_PATH}) -set(HDF5_LIBRARY_PATH "${HDF5_PATH}/lib") -set(HDF5_INCLUDE_PATH "${HDF5_PATH}/include") - -# Where to look for fftpack -set(FFTPACK_PATH $ENV{FFTPACK_PATH}) -set(FFTPACK_LIBRARY_PATH "${FFTPACK_PATH}/lib") -set(FFTPACK_INCLUDE_PATH "${FFTPACK_PATH}/include") - - -set(CMAKE_Fortran_COMPILER_ID $ENV{COMPILER_ID}) - - - -# Intel compiler suite -if ( CMAKE_Fortran_COMPILER_ID MATCHES "Intel" ) - if ( CMAKE_BUILD_TYPE MATCHES "Release" ) - if ($ENV{ARCH_OPT_FLAG}) - set(OPTFLAG $ENV{ARCH_OPT_FLAG}) - else() - set(OPTFLAG "-xhost") - endif() - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O3 -traceback -qmkl -heap-arrays 1024 -warn all ${OPTFLAG} -dynamic -qopt-report=2 -qopt-report-phase=vec -qopenmp") - elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -g -traceback -g -qmkl -heap-arrays 1024 -check all,nouninit -check noarg-temp-created -fpe0 -warn -traceback -debug extended -assume realloc_lhs -fstack-protector -assume protect_parens -implicitnone") - endif() - -# GNU compiler on OSX -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 -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 $ENV{ARCH_OPT_FLAG}) - else() - set(OPTFLAG "-march=native") - endif() - #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O3 -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") - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O3 -Wall -Wconversion -Wextra -Waliasing -ffree-form -ffree-line-length-none ${OPTFLAG} -funroll-loops -fopenmp -fallow-argument-mismatch -finit-integer=0 -finit-real=zero") - elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) - 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} -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 -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") - if ( CMAKE_BUILD_TYPE MATCHES "Release" ) - set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -O5 -qsuffix=cpp=f90 -qxlf2003=polymorphic") - elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) - set(CMAKE_Fortran_FLAGS "-O0 -qsuffix=cpp=f90 -qxlf2003=polymorphic") - endif() - -# AOCC / AMD compiler suite -elseif ( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD" ) - if ( DEFINED ENV{ARCH_OPT_FLAG} AND NOT "$ENV{ARCH_OPT_FLAG}" STREQUAL "" ) - set(OPTFLAG "$ENV{ARCH_OPT_FLAG}") - else() - # ARCHER2 CPU nodes are AMD EPYC Rome / Zen 2 - #set(OPTFLAG "-march=znver2") - set(OPTFLAG "") - endif() - if ( CMAKE_BUILD_TYPE MATCHES "Release" ) - set(CMAKE_Fortran_FLAGS - "${CMAKE_Fortran_FLAGS} -O3 ${OPTFLAG} -fopenmp -ffree-form -ffast-math -funroll-loops" - ) - elseif ( CMAKE_BUILD_TYPE MATCHES "Debug" ) - set(CMAKE_Fortran_FLAGS - "${CMAKE_Fortran_FLAGS} -O0 -g -fopenmp -ffree-form -fcheck=all -fbounds-check -ffpe-trap=zero,overflow" - ) - endif() - -endif() +include(PadeOpsCompiler) +include(PadeOpsDependencies) # Add source file directories add_subdirectory(src) diff --git a/cmake/Find2DECOMP.cmake b/cmake/Find2DECOMP.cmake new file mode 100644 index 00000000..1ef74afd --- /dev/null +++ b/cmake/Find2DECOMP.cmake @@ -0,0 +1,38 @@ +include(FindPackageHandleStandardArgs) + +set(_2DECOMP_HINTS) +foreach(_var DECOMP_ROOT DECOMP_PATH DECOMP_HOME) + if(DEFINED ${_var}) + list(APPEND _2DECOMP_HINTS "${${_var}}") + endif() + if(DEFINED ENV{${_var}}) + list(APPEND _2DECOMP_HINTS "$ENV{${_var}}") + endif() +endforeach() +list(REMOVE_DUPLICATES _2DECOMP_HINTS) + +find_path(2DECOMP_INCLUDE_DIR + NAMES decomp_2d.mod decomp_2d_fft.mod + HINTS ${_2DECOMP_HINTS} + PATH_SUFFIXES include modules mod +) + +find_library(2DECOMP_LIBRARY + NAMES 2decomp_fft + HINTS ${_2DECOMP_HINTS} + PATH_SUFFIXES lib lib64 +) + +find_package_handle_standard_args(2DECOMP + REQUIRED_VARS 2DECOMP_LIBRARY 2DECOMP_INCLUDE_DIR +) + +if(2DECOMP_FOUND AND NOT TARGET PadeOps::2DECOMP) + add_library(PadeOps::2DECOMP INTERFACE IMPORTED) + set_target_properties(PadeOps::2DECOMP PROPERTIES + INTERFACE_INCLUDE_DIRECTORIES "${2DECOMP_INCLUDE_DIR}" + INTERFACE_LINK_LIBRARIES "${2DECOMP_LIBRARY}" + ) +endif() + +mark_as_advanced(2DECOMP_INCLUDE_DIR 2DECOMP_LIBRARY) diff --git a/cmake/FindFFTW.cmake b/cmake/FindFFTW.cmake new file mode 100644 index 00000000..ca19d6ba --- /dev/null +++ b/cmake/FindFFTW.cmake @@ -0,0 +1,38 @@ +include(FindPackageHandleStandardArgs) + +set(_FFTW_HINTS) +foreach(_var FFTW_ROOT FFTW_PATH FFTW_HOME) + if(DEFINED ${_var}) + list(APPEND _FFTW_HINTS "${${_var}}") + endif() + if(DEFINED ENV{${_var}}) + list(APPEND _FFTW_HINTS "$ENV{${_var}}") + endif() +endforeach() +list(REMOVE_DUPLICATES _FFTW_HINTS) + +find_path(FFTW_INCLUDE_DIR + NAMES fftw3.f fftw3.h + HINTS ${_FFTW_HINTS} + PATH_SUFFIXES include +) + +find_library(FFTW_LIBRARY + NAMES fftw3 + HINTS ${_FFTW_HINTS} + PATH_SUFFIXES lib lib64 +) + +find_package_handle_standard_args(FFTW + REQUIRED_VARS FFTW_LIBRARY FFTW_INCLUDE_DIR +) + +if(FFTW_FOUND AND NOT TARGET PadeOps::FFTW) + add_library(PadeOps::FFTW INTERFACE IMPORTED) + set_target_properties(PadeOps::FFTW PROPERTIES + INTERFACE_INCLUDE_DIRECTORIES "${FFTW_INCLUDE_DIR}" + INTERFACE_LINK_LIBRARIES "${FFTW_LIBRARY}" + ) +endif() + +mark_as_advanced(FFTW_INCLUDE_DIR FFTW_LIBRARY) diff --git a/cmake/FindSZIP.cmake b/cmake/FindSZIP.cmake new file mode 100644 index 00000000..64536c0b --- /dev/null +++ b/cmake/FindSZIP.cmake @@ -0,0 +1,31 @@ +include(FindPackageHandleStandardArgs) + +set(_SZIP_HINTS) +foreach(_var SZIP_ROOT SZIP_PATH SZIP_HOME LIBSZIP_ROOT LIBSZIP_PATH LIBSZIP_HOME) + if(DEFINED ${_var}) + list(APPEND _SZIP_HINTS "${${_var}}") + endif() + if(DEFINED ENV{${_var}}) + list(APPEND _SZIP_HINTS "$ENV{${_var}}") + endif() +endforeach() +list(REMOVE_DUPLICATES _SZIP_HINTS) + +find_library(SZIP_LIBRARY + NAMES sz szip aec + HINTS ${_SZIP_HINTS} + PATH_SUFFIXES lib lib64 +) + +find_package_handle_standard_args(SZIP + REQUIRED_VARS SZIP_LIBRARY +) + +if(SZIP_FOUND AND NOT TARGET PadeOps::SZIP) + add_library(PadeOps::SZIP UNKNOWN IMPORTED) + set_target_properties(PadeOps::SZIP PROPERTIES + IMPORTED_LOCATION "${SZIP_LIBRARY}" + ) +endif() + +mark_as_advanced(SZIP_LIBRARY) diff --git a/cmake/PadeOpsCompiler.cmake b/cmake/PadeOpsCompiler.cmake new file mode 100644 index 00000000..8446e447 --- /dev/null +++ b/cmake/PadeOpsCompiler.cmake @@ -0,0 +1,96 @@ +add_library(PadeOps::FortranOptions INTERFACE IMPORTED) + +find_package(OpenMP QUIET COMPONENTS Fortran) + +if(DEFINED ENV{ARCH_OPT_FLAG} AND NOT "$ENV{ARCH_OPT_FLAG}" STREQUAL "") + separate_arguments(PADEOPS_ARCH_OPT_FLAGS NATIVE_COMMAND "$ENV{ARCH_OPT_FLAG}") +else() + set(PADEOPS_ARCH_OPT_FLAGS) +endif() + +set(_PADEOPS_FORTRAN_COMPILE_OPTIONS) +set(_PADEOPS_FORTRAN_LINK_OPTIONS) + +if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + if(NOT PADEOPS_ARCH_OPT_FLAGS) + set(PADEOPS_ARCH_OPT_FLAGS -xhost) + endif() + + if(CMAKE_BUILD_TYPE MATCHES "Debug") + list(APPEND _PADEOPS_FORTRAN_COMPILE_OPTIONS + -g -traceback -heap-arrays 1024 -check all,nouninit + -check noarg-temp-created -fpe0 -warn -debug extended + -assume realloc_lhs -fstack-protector -assume protect_parens + -implicitnone + ) + else() + list(APPEND _PADEOPS_FORTRAN_COMPILE_OPTIONS + -O3 -traceback -heap-arrays 1024 -warn all + ${PADEOPS_ARCH_OPT_FLAGS} + -dynamic -qopt-report=2 -qopt-report-phase=vec + ) + endif() +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + if(NOT PADEOPS_ARCH_OPT_FLAGS) + set(PADEOPS_ARCH_OPT_FLAGS -march=native) + endif() + + if(CMAKE_BUILD_TYPE MATCHES "Debug") + list(APPEND _PADEOPS_FORTRAN_COMPILE_OPTIONS + -Og -g -fbacktrace -pg -ffree-form -ffree-line-length-none + -fcheck=all -fbounds-check -ffpe-trap=zero,overflow + -Wall -Wconversion -Wextra -Waliasing -Wsurprising + ) + else() + list(APPEND _PADEOPS_FORTRAN_COMPILE_OPTIONS + -O3 -Wall -Wconversion -Wextra -Waliasing + -ffree-form -ffree-line-length-none + ${PADEOPS_ARCH_OPT_FLAGS} + -funroll-loops -fallow-argument-mismatch + -finit-integer=0 -finit-real=zero + ) + endif() +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Cray") + if(NOT CMAKE_BUILD_TYPE MATCHES "Debug") + list(APPEND _PADEOPS_FORTRAN_COMPILE_OPTIONS -hlist=a) + endif() +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "IBM") + if(CMAKE_BUILD_TYPE MATCHES "Debug") + list(APPEND _PADEOPS_FORTRAN_COMPILE_OPTIONS -O0 -qsuffix=cpp=f90 -qxlf2003=polymorphic) + else() + list(APPEND _PADEOPS_FORTRAN_COMPILE_OPTIONS -O5 -qsuffix=cpp=f90 -qxlf2003=polymorphic) + endif() +elseif(CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD") + if(CMAKE_BUILD_TYPE MATCHES "Debug") + list(APPEND _PADEOPS_FORTRAN_COMPILE_OPTIONS + -O0 -g -ffree-form -fcheck=all + -fbounds-check -ffpe-trap=zero,overflow + ) + else() + list(APPEND _PADEOPS_FORTRAN_COMPILE_OPTIONS + -O3 ${PADEOPS_ARCH_OPT_FLAGS} + -ffree-form -ffast-math -funroll-loops + ) + endif() +endif() + +if(OpenMP_Fortran_FOUND) + list(APPEND _PADEOPS_FORTRAN_LINK_OPTIONS OpenMP::OpenMP_Fortran) + message(STATUS "OpenMP Fortran provider: OpenMP::OpenMP_Fortran") +else() + message(STATUS "OpenMP Fortran was not found by CMake; building without CMake-managed OpenMP flags") +endif() + +if(_PADEOPS_FORTRAN_COMPILE_OPTIONS) + set_target_properties(PadeOps::FortranOptions PROPERTIES + INTERFACE_COMPILE_OPTIONS "${_PADEOPS_FORTRAN_COMPILE_OPTIONS}" + ) +endif() + +if(_PADEOPS_FORTRAN_LINK_OPTIONS) + set_target_properties(PadeOps::FortranOptions PROPERTIES + INTERFACE_LINK_LIBRARIES "${_PADEOPS_FORTRAN_LINK_OPTIONS}" + ) +endif() + +message(STATUS "Fortran compiler: ${CMAKE_Fortran_COMPILER_ID} ${CMAKE_Fortran_COMPILER_VERSION}") diff --git a/cmake/PadeOpsDependencies.cmake b/cmake/PadeOpsDependencies.cmake new file mode 100644 index 00000000..3c36e94e --- /dev/null +++ b/cmake/PadeOpsDependencies.cmake @@ -0,0 +1,79 @@ +include(CheckFortranSourceCompiles) +include(PadeOpsModuleEnv) + +function(_padeops_append_existing_library out_var) + set(_result "${${out_var}}") + foreach(_lib IN LISTS ARGN) + if(_lib AND NOT _lib MATCHES "-NOTFOUND$") + list(APPEND _result "${_lib}") + endif() + endforeach() + set(${out_var} "${_result}" PARENT_SCOPE) +endfunction() + +function(_padeops_filter_found_libraries out_var) + set(_result) + foreach(_lib IN LISTS ARGN) + if(_lib AND NOT _lib MATCHES "-NOTFOUND$") + list(APPEND _result "${_lib}") + endif() + endforeach() + set(${out_var} "${_result}" PARENT_SCOPE) +endfunction() + +padeops_collect_dependency_prefixes(HDF5 PADEOPS_HDF5_PREFIXES) +padeops_collect_dependency_prefixes(FFTW PADEOPS_FFTW_PREFIXES) +padeops_collect_dependency_prefixes(2DECOMP PADEOPS_2DECOMP_PREFIXES) +padeops_collect_dependency_prefixes(SZIP PADEOPS_SZIP_PREFIXES) + +foreach(_var HDF5_ROOT HDF5_PATH HDF5_HOME FFTW_ROOT FFTW_PATH FFTW_HOME DECOMP_ROOT DECOMP_PATH DECOMP_HOME SZIP_ROOT SZIP_PATH SZIP_HOME LIBSZIP_ROOT LIBSZIP_PATH LIBSZIP_HOME) + if(DEFINED ${_var} AND NOT "${${_var}}" STREQUAL "") + list(APPEND CMAKE_PREFIX_PATH "${${_var}}") + endif() + if(DEFINED ENV{${_var}} AND NOT "$ENV{${_var}}" STREQUAL "") + list(APPEND CMAKE_PREFIX_PATH "$ENV{${_var}}") + endif() +endforeach() +list(APPEND CMAKE_PREFIX_PATH + ${PADEOPS_HDF5_PREFIXES} + ${PADEOPS_FFTW_PREFIXES} + ${PADEOPS_2DECOMP_PREFIXES} + ${PADEOPS_SZIP_PREFIXES} +) +list(REMOVE_DUPLICATES CMAKE_PREFIX_PATH) + +find_package(MPI REQUIRED COMPONENTS Fortran) +find_package(FFTW REQUIRED) +find_package(2DECOMP REQUIRED) + +set(_save_required_includes "${CMAKE_REQUIRED_INCLUDES}") +set(CMAKE_REQUIRED_INCLUDES "${2DECOMP_INCLUDE_DIR}") +check_fortran_source_compiles(" + program padeops_2decomp_compile_check + use decomp_2d + end +" PADEOPS_2DECOMP_COMPILES) +set(CMAKE_REQUIRED_INCLUDES "${_save_required_includes}") +if(NOT PADEOPS_2DECOMP_COMPILES) + message(FATAL_ERROR + "Found 2DECOMP, but its Fortran module cannot be compiled with the active compiler. Ensure DECOMP_ROOT/DECOMP_PATH points to the 2DECOMP build for this compiler and MPI stack." + ) +endif() + +include(PadeOpsHDF5) +include(PadeOpsLAPACK) + +if(TARGET MPI::MPI_Fortran) + add_library(PadeOps::MPI ALIAS MPI::MPI_Fortran) +elseif(NOT TARGET PadeOps::MPI) + add_library(PadeOps::MPI INTERFACE IMPORTED) + set_target_properties(PadeOps::MPI PROPERTIES + INTERFACE_COMPILE_OPTIONS "${MPI_Fortran_COMPILE_OPTIONS}" + INTERFACE_INCLUDE_DIRECTORIES "${MPI_Fortran_INCLUDE_DIRS}" + INTERFACE_LINK_LIBRARIES "${MPI_Fortran_LIBRARIES}" + INTERFACE_LINK_OPTIONS "${MPI_Fortran_LINK_FLAGS}" + ) +endif() + +message(STATUS "FFTW library: ${FFTW_LIBRARY}") +message(STATUS "2DECOMP library: ${2DECOMP_LIBRARY}") diff --git a/cmake/PadeOpsHDF5.cmake b/cmake/PadeOpsHDF5.cmake new file mode 100644 index 00000000..a90a51d1 --- /dev/null +++ b/cmake/PadeOpsHDF5.cmake @@ -0,0 +1,114 @@ +function(_padeops_check_hdf5_link result_var link_libs) + set(_save_required_includes "${CMAKE_REQUIRED_INCLUDES}") + set(_save_required_libs "${CMAKE_REQUIRED_LIBRARIES}") + set(CMAKE_REQUIRED_INCLUDES "${PADEOPS_HDF5_INCLUDE_DIRS}") + set(CMAKE_REQUIRED_LIBRARIES "${link_libs}") + check_fortran_source_compiles(" + program padeops_hdf5_link_check + use hdf5 + integer ierr + call h5open_f(ierr) + call h5close_f(ierr) + end +" ${result_var}) + set(CMAKE_REQUIRED_INCLUDES "${_save_required_includes}") + set(CMAKE_REQUIRED_LIBRARIES "${_save_required_libs}") + set(${result_var} "${${result_var}}" PARENT_SCOPE) +endfunction() + +set(HDF5_PREFER_PARALLEL TRUE) +find_package(HDF5 QUIET COMPONENTS Fortran HL) + +if(HDF5_FOUND) + set(PADEOPS_HDF5_INCLUDE_DIRS ${HDF5_INCLUDE_DIRS}) + _padeops_filter_found_libraries(PADEOPS_HDF5_LINK_LIBRARIES ${HDF5_HL_LIBRARIES} ${HDF5_LIBRARIES}) +endif() + +if(NOT HDF5_FOUND OR NOT PADEOPS_HDF5_LINK_LIBRARIES) + set(_HDF5_HINTS ${PADEOPS_HDF5_PREFIXES}) + foreach(_var HDF5_ROOT HDF5_PATH HDF5_HOME) + if(DEFINED ${_var}) + list(APPEND _HDF5_HINTS "${${_var}}") + endif() + if(DEFINED ENV{${_var}}) + list(APPEND _HDF5_HINTS "$ENV{${_var}}") + endif() + endforeach() + list(REMOVE_DUPLICATES _HDF5_HINTS) + + find_path(PADEOPS_HDF5_INCLUDE_DIRS + NAMES hdf5.mod hdf5.h + HINTS ${_HDF5_HINTS} + PATH_SUFFIXES include + ) + foreach(_name hdf5_hl_fortran hdf5hl_fortran hdf5_hl_f90cstub hdf5_fortran hdf5_f90cstub hdf5_hl hdf5) + find_library(_PADEOPS_HDF5_${_name}_LIBRARY + NAMES ${_name} + HINTS ${_HDF5_HINTS} + PATH_SUFFIXES lib lib64 + ) + _padeops_append_existing_library(PADEOPS_HDF5_LINK_LIBRARIES "${_PADEOPS_HDF5_${_name}_LIBRARY}") + endforeach() + + if(NOT PADEOPS_HDF5_INCLUDE_DIRS OR NOT PADEOPS_HDF5_LINK_LIBRARIES) + message(FATAL_ERROR + "Could not find HDF5 Fortran/HL. Load an HDF5 module or pass -DHDF5_ROOT=/path/to/hdf5." + ) + endif() +endif() + +list(REMOVE_DUPLICATES PADEOPS_HDF5_LINK_LIBRARIES) + +_padeops_check_hdf5_link(PADEOPS_HDF5_LINKS "${PADEOPS_HDF5_LINK_LIBRARIES}") + +if(NOT PADEOPS_HDF5_LINKS) + set(_PADEOPS_HDF5_SYSTEM_EXTRAS) + find_package(ZLIB QUIET) + if(ZLIB_FOUND) + list(APPEND _PADEOPS_HDF5_SYSTEM_EXTRAS ZLIB::ZLIB) + else() + find_library(PADEOPS_ZLIB_LIBRARY NAMES z) + _padeops_append_existing_library(_PADEOPS_HDF5_SYSTEM_EXTRAS "${PADEOPS_ZLIB_LIBRARY}") + endif() + + find_library(PADEOPS_DL_LIBRARY NAMES dl) + find_library(PADEOPS_M_LIBRARY NAMES m) + _padeops_append_existing_library(_PADEOPS_HDF5_SYSTEM_EXTRAS "${PADEOPS_DL_LIBRARY}" "${PADEOPS_M_LIBRARY}") + + set(_PADEOPS_HDF5_WITH_SYSTEM ${PADEOPS_HDF5_LINK_LIBRARIES} ${_PADEOPS_HDF5_SYSTEM_EXTRAS}) + _padeops_check_hdf5_link(PADEOPS_HDF5_LINKS_WITH_SYSTEM "${_PADEOPS_HDF5_WITH_SYSTEM}") + + if(PADEOPS_HDF5_LINKS_WITH_SYSTEM) + set(PADEOPS_HDF5_LINK_LIBRARIES ${_PADEOPS_HDF5_WITH_SYSTEM}) + else() + find_package(SZIP QUIET) + if(SZIP_FOUND) + set(_PADEOPS_HDF5_WITH_SZIP ${PADEOPS_HDF5_LINK_LIBRARIES} PadeOps::SZIP ${_PADEOPS_HDF5_SYSTEM_EXTRAS}) + _padeops_check_hdf5_link(PADEOPS_HDF5_LINKS_WITH_SZIP "${_PADEOPS_HDF5_WITH_SZIP}") + if(PADEOPS_HDF5_LINKS_WITH_SZIP) + set(PADEOPS_HDF5_LINK_LIBRARIES ${_PADEOPS_HDF5_WITH_SZIP}) + set(PADEOPS_HDF5_REQUIRES_SZIP TRUE) + endif() + endif() + endif() +endif() + +if(NOT PADEOPS_HDF5_LINKS AND NOT PADEOPS_HDF5_LINKS_WITH_SYSTEM AND NOT PADEOPS_HDF5_LINKS_WITH_SZIP) + message(FATAL_ERROR + "Found HDF5, but a Fortran HDF5 compile/link test failed. Ensure HDF5 was built with the active Fortran compiler and MPI stack. If this HDF5 was built with SZIP, load/provide SZIP with -DSZIP_ROOT=/path/to/szip or LIBSZIP_HOME." + ) +endif() + +if(NOT TARGET PadeOps::HDF5) + add_library(PadeOps::HDF5 INTERFACE IMPORTED) + set_target_properties(PadeOps::HDF5 PROPERTIES + INTERFACE_INCLUDE_DIRECTORIES "${PADEOPS_HDF5_INCLUDE_DIRS}" + INTERFACE_LINK_LIBRARIES "${PADEOPS_HDF5_LINK_LIBRARIES}" + ) +endif() + +message(STATUS "HDF5 include dirs: ${PADEOPS_HDF5_INCLUDE_DIRS}") +message(STATUS "HDF5 link libraries: ${PADEOPS_HDF5_LINK_LIBRARIES}") +if(PADEOPS_HDF5_REQUIRES_SZIP) + message(STATUS "HDF5 requires SZIP: ${SZIP_LIBRARY}") +endif() diff --git a/cmake/PadeOpsLAPACK.cmake b/cmake/PadeOpsLAPACK.cmake new file mode 100644 index 00000000..1abbd3eb --- /dev/null +++ b/cmake/PadeOpsLAPACK.cmake @@ -0,0 +1,54 @@ +option(PADEOPS_REQUIRE_LAPACK + "Require CMake to find a LAPACK provider at configure time" + OFF +) + +function(_padeops_check_lapack_link result_var link_libs) + set(_save_required_libs "${CMAKE_REQUIRED_LIBRARIES}") + set(CMAKE_REQUIRED_LIBRARIES "${link_libs}") + check_fortran_source_compiles(" + program padeops_lapack_link_check + double precision a(1,1), b(1,1) + integer ipiv(1), info + a(1,1) = 1.0d0 + b(1,1) = 1.0d0 + call dgesv(1, 1, a, 1, ipiv, b, 1, info) + end +" ${result_var}) + set(CMAKE_REQUIRED_LIBRARIES "${_save_required_libs}") + set(${result_var} "${${result_var}}" PARENT_SCOPE) +endfunction() + +find_package(LAPACK QUIET) + +if(LAPACK_FOUND) + add_library(PadeOps::LAPACK INTERFACE IMPORTED) + set_target_properties(PadeOps::LAPACK PROPERTIES + INTERFACE_LINK_LIBRARIES "${LAPACK_LIBRARIES}" + ) + message(STATUS "LAPACK provider: ${LAPACK_LIBRARIES}") +else() + if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + _padeops_check_lapack_link(PADEOPS_INTEL_MKL_FLAG_WORKS "-mkl") + if(PADEOPS_INTEL_MKL_FLAG_WORKS) + add_library(PadeOps::LAPACK INTERFACE IMPORTED) + set_target_properties(PadeOps::LAPACK PROPERTIES + INTERFACE_LINK_LIBRARIES "-mkl" + ) + message(STATUS "LAPACK provider: Intel compiler -mkl fallback") + endif() + endif() +endif() + +if(NOT TARGET PadeOps::LAPACK) + if(PADEOPS_REQUIRE_LAPACK) + message(FATAL_ERROR + "Could not find a working LAPACK provider. Load a LAPACK/MKL module or provide a LAPACK-capable compiler stack." + ) + endif() + + add_library(PadeOps::LAPACK INTERFACE IMPORTED) + message(STATUS + "No LAPACK provider was found. Continuing because PADEOPS_REQUIRE_LAPACK=OFF; LAPACK-using targets will fail to link unless their stack supplies LAPACK implicitly." + ) +endif() diff --git a/cmake/PadeOpsModuleEnv.cmake b/cmake/PadeOpsModuleEnv.cmake new file mode 100644 index 00000000..e2a38a1d --- /dev/null +++ b/cmake/PadeOpsModuleEnv.cmake @@ -0,0 +1,186 @@ +set(PADEOPS_MODULES "$ENV{PADEOPS_MODULES}" CACHE STRING + "Whitespace-separated module names loaded by the setup script for this PadeOps stack" +) + +function(_padeops_normalize_prefix out_var candidate) + set(_result) + + if(candidate AND EXISTS "${candidate}") + if(IS_DIRECTORY "${candidate}") + get_filename_component(_name "${candidate}" NAME) + if(_name MATCHES "^(bin|include|lib|lib64|mod|modules)$") + get_filename_component(_result "${candidate}" DIRECTORY) + else() + set(_result "${candidate}") + endif() + else() + get_filename_component(_dir "${candidate}" DIRECTORY) + get_filename_component(_name "${_dir}" NAME) + if(_name MATCHES "^(bin|include|lib|lib64|mod|modules)$") + get_filename_component(_result "${_dir}" DIRECTORY) + else() + set(_result "${_dir}") + endif() + endif() + endif() + + set(${out_var} "${_result}" PARENT_SCOPE) +endfunction() + +function(_padeops_append_path_values out_var raw_value) + set(_result "${${out_var}}") + + if(raw_value) + string(REPLACE ":" ";" _values "${raw_value}") + foreach(_value IN LISTS _values) + if(EXISTS "${_value}") + list(APPEND _result "${_value}") + endif() + endforeach() + endif() + + set(${out_var} "${_result}" PARENT_SCOPE) +endfunction() + +function(_padeops_dependency_patterns dependency name_pattern_var) + string(TOUPPER "${dependency}" _dep) + + if(_dep STREQUAL "HDF5") + set(_pattern "HDF5|PHDF5") + elseif(_dep STREQUAL "FFTW") + set(_pattern "FFTW") + elseif(_dep STREQUAL "SZIP") + set(_pattern "SZIP|LIBSZIP|LIBAEC|AEC") + elseif(_dep STREQUAL "2DECOMP") + set(_pattern "2DECOMP|DECOMP") + else() + set(_pattern "${_dep}") + endif() + + set(${name_pattern_var} "${_pattern}" PARENT_SCOPE) +endfunction() + +function(padeops_collect_env_candidates dependency out_var) + _padeops_dependency_patterns("${dependency}" _name_pattern) + set(_candidates) + + execute_process( + COMMAND "${CMAKE_COMMAND}" -E environment + OUTPUT_VARIABLE _environment + ERROR_QUIET + ) + string(REPLACE "\n" ";" _environment_lines "${_environment}") + + foreach(_line IN LISTS _environment_lines) + if(_line MATCHES "^([^=]+)=(.*)$") + set(_name "${CMAKE_MATCH_1}") + set(_value "${CMAKE_MATCH_2}") + string(TOUPPER "${_name}" _name_upper) + + if(_name_upper MATCHES "${_name_pattern}") + _padeops_append_path_values(_candidates "${_value}") + endif() + endif() + endforeach() + + set(${out_var} "${_candidates}" PARENT_SCOPE) +endfunction() + +function(padeops_collect_module_candidates dependency out_var) + _padeops_dependency_patterns("${dependency}" _name_pattern) + set(_candidates) + + if(NOT PADEOPS_MODULES) + set(${out_var} "" PARENT_SCOPE) + return() + endif() + + separate_arguments(_modules NATIVE_COMMAND "${PADEOPS_MODULES}") + + foreach(_module IN LISTS _modules) + string(TOUPPER "${_module}" _module_upper) + if(NOT _module_upper MATCHES "${_name_pattern}") + continue() + endif() + + execute_process( + COMMAND bash -lc "module show ${_module} 2>&1" + OUTPUT_VARIABLE _module_show + ERROR_VARIABLE _module_show_error + RESULT_VARIABLE _module_show_result + ) + + set(_module_text "${_module_show}\n${_module_show_error}") + string(REGEX MATCHALL "(/[^ \t\r\n;:\"'()]+)" _paths "${_module_text}") + + foreach(_path IN LISTS _paths) + if(EXISTS "${_path}") + list(APPEND _candidates "${_path}") + endif() + endforeach() + endforeach() + + set(${out_var} "${_candidates}" PARENT_SCOPE) +endfunction() + +function(padeops_validate_prefixes dependency out_var) + string(TOUPPER "${dependency}" _dep) + set(_valid_prefixes) + + foreach(_candidate IN LISTS ARGN) + _padeops_normalize_prefix(_prefix "${_candidate}") + if(NOT _prefix) + continue() + endif() + + set(_is_valid FALSE) + if(_dep STREQUAL "HDF5") + file(GLOB _libs "${_prefix}/lib/libhdf5*" "${_prefix}/lib64/libhdf5*") + if(_libs AND (EXISTS "${_prefix}/include/hdf5.mod" OR EXISTS "${_prefix}/include/hdf5.h")) + set(_is_valid TRUE) + endif() + elseif(_dep STREQUAL "FFTW") + file(GLOB _libs "${_prefix}/lib/libfftw3*" "${_prefix}/lib64/libfftw3*") + if(_libs AND (EXISTS "${_prefix}/include/fftw3.f" OR EXISTS "${_prefix}/include/fftw3.h")) + set(_is_valid TRUE) + endif() + elseif(_dep STREQUAL "SZIP") + file(GLOB _libs + "${_prefix}/lib/libsz*" + "${_prefix}/lib64/libsz*" + "${_prefix}/lib/libaec*" + "${_prefix}/lib64/libaec*" + ) + if(_libs) + set(_is_valid TRUE) + endif() + elseif(_dep STREQUAL "2DECOMP") + file(GLOB _libs "${_prefix}/lib/lib2decomp_fft*" "${_prefix}/lib64/lib2decomp_fft*") + if(_libs AND (EXISTS "${_prefix}/include/decomp_2d.mod" OR EXISTS "${_prefix}/modules/decomp_2d.mod" OR EXISTS "${_prefix}/mod/decomp_2d.mod")) + set(_is_valid TRUE) + endif() + endif() + + if(_is_valid) + list(APPEND _valid_prefixes "${_prefix}") + endif() + endforeach() + + if(_valid_prefixes) + list(REMOVE_DUPLICATES _valid_prefixes) + endif() + + set(${out_var} "${_valid_prefixes}" PARENT_SCOPE) +endfunction() + +function(padeops_collect_dependency_prefixes dependency out_var) + padeops_collect_env_candidates("${dependency}" _env_candidates) + padeops_collect_module_candidates("${dependency}" _module_candidates) + padeops_validate_prefixes("${dependency}" _prefixes ${_env_candidates} ${_module_candidates}) + + if(_prefixes) + message(STATUS "${dependency} module/env prefix candidates: ${_prefixes}") + endif() + + set(${out_var} "${_prefixes}" PARENT_SCOPE) +endfunction() diff --git a/problems/CMakeLists.txt b/problems/CMakeLists.txt index 67b00fef..a16f3f58 100644 --- a/problems/CMakeLists.txt +++ b/problems/CMakeLists.txt @@ -5,12 +5,6 @@ file(GLOB turbproblems_source_files turbines/*.F90) file(GLOB pp_source_files postprocessing/*.F90) file(GLOB pp_igrid_source_files postprocessing_igrid/*.F90) -# Include directories -include_directories( ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${PadeOps_BINARY_DIR}/src ) - -# Link directories -link_directories( ${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${PadeOps_BINARY_DIR}/src ) - # Create the problem executables foreach ( problemfile ${problems_source_files} ) string( REPLACE "${PadeOps_SOURCE_DIR}/problems/" "" problemfile ${problemfile} ) @@ -18,11 +12,7 @@ foreach ( problemfile ${problems_source_files} ) add_executable( ${problemexec} ${problemfile} ) - target_link_libraries( ${problemexec} PadeOps ) - - if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(${problemexec} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") - endif() + target_link_libraries( ${problemexec} PRIVATE PadeOps ) endforeach() diff --git a/problems/compressible/CMakeLists.txt b/problems/compressible/CMakeLists.txt index 08b5e442..44dd5134 100644 --- a/problems/compressible/CMakeLists.txt +++ b/problems/compressible/CMakeLists.txt @@ -1,11 +1,5 @@ file(GLOB cproblems_source_files *.F90) -# Include directories -include_directories( ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${PadeOps_BINARY_DIR}/src ) - -# Link directories -link_directories( ${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${PadeOps_BINARY_DIR}/src ) - # Create the compressible problem executables foreach ( cproblemfile ${cproblems_source_files} ) string( REPLACE "${PadeOps_SOURCE_DIR}/problems/compressible/" "" cproblemfile ${cproblemfile} ) @@ -13,11 +7,7 @@ foreach ( cproblemfile ${cproblems_source_files} ) add_executable( ${cproblemexec} ${cproblemfile} ) - target_link_libraries( ${cproblemexec} CompressibleOps ) - - if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(${cproblemexec} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") - endif() + target_link_libraries( ${cproblemexec} PRIVATE CompressibleOps ) file(MAKE_DIRECTORY ${PadeOps_BINARY_DIR}/problems/compressible/${cproblemexec}_files) file(COPY ${cproblemexec}_files/input.dat DESTINATION ${PadeOps_BINARY_DIR}/problems/compressible/${cproblemexec}_files) diff --git a/problems/incompressible/CMakeLists.txt b/problems/incompressible/CMakeLists.txt index c4c1b52a..a0196c50 100644 --- a/problems/incompressible/CMakeLists.txt +++ b/problems/incompressible/CMakeLists.txt @@ -1,10 +1,5 @@ file(GLOB iproblems_source_files *.F90) -# Include directories -include_directories( ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${PadeOps_BINARY_DIR}/src ) -# Link directories -link_directories( ${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${PadeOps_BINARY_DIR}/src ) - # Create the incompressible problem executables foreach ( iproblemfile ${iproblems_source_files} ) string( REPLACE "${PadeOps_SOURCE_DIR}/problems/incompressible/" "" iproblemfile ${iproblemfile} ) @@ -12,11 +7,7 @@ foreach ( iproblemfile ${iproblems_source_files} ) add_executable( ${iproblemexec} ${iproblemfile} ) - target_link_libraries( ${iproblemexec} IncompressibleOps 2decomp_fft fftw3) - - if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(${iproblemexec} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") - endif() + target_link_libraries( ${iproblemexec} PRIVATE IncompressibleOps ) file(MAKE_DIRECTORY ${PadeOps_BINARY_DIR}/problems/incompressible/${iproblemexec}_files) # file(COPY ${iproblemexec}_files/*.dat DESTINATION ${PadeOps_BINARY_DIR}/problems/incompressible/${iproblemexec}_files) diff --git a/problems/postprocessing/CMakeLists.txt b/problems/postprocessing/CMakeLists.txt index c2b0fc6d..2ccefa39 100644 --- a/problems/postprocessing/CMakeLists.txt +++ b/problems/postprocessing/CMakeLists.txt @@ -1,11 +1,5 @@ file(GLOB postprocessing_source_files *.F90) -# Include directories -include_directories( ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${VTK_IO_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 ) - # Create the compressible problem executables foreach ( postprocessingfile ${postprocessing_source_files} ) string( REPLACE "${PadeOps_SOURCE_DIR}/problems/postprocessing/" "" postprocessingfile ${postprocessingfile} ) @@ -13,12 +7,7 @@ foreach ( postprocessingfile ${postprocessing_source_files} ) add_executable( ${postprocessingexec} ${postprocessingfile} ) - target_link_libraries( ${postprocessingexec} PadeOps) - # target_link_libraries( ${testexec} IncompressibleOps CompressibleOps 2decomp_fft fftw3 ${VTK_IO_LIBRARY_PATH}/libVTK_IO.a ) - - if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(${postprocessingexec} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") - endif() + target_link_libraries( ${postprocessingexec} PRIVATE PadeOps) file(MAKE_DIRECTORY ${PadeOps_BINARY_DIR}/problems/postprocessing/${postprocessingexec}_files) file(COPY ${postprocessingexec}_files/input.dat DESTINATION ${PadeOps_BINARY_DIR}/problems/postprocessing/${postprocessingexec}_files) diff --git a/problems/postprocessing_igrid/CMakeLists.txt b/problems/postprocessing_igrid/CMakeLists.txt index c9e2ffe6..0f86d2d1 100644 --- a/problems/postprocessing_igrid/CMakeLists.txt +++ b/problems/postprocessing_igrid/CMakeLists.txt @@ -1,10 +1,5 @@ file(GLOB pp_iproblems_source_files *.F90) -# Include directories -include_directories( ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${PadeOps_BINARY_DIR}/src ) -# Link directories -link_directories( ${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${PadeOps_BINARY_DIR}/src ) - # Create the incompressible problem executables foreach ( iproblemfile ${pp_iproblems_source_files} ) string( REPLACE "${PadeOps_SOURCE_DIR}/problems/postprocessing_igrid/" "" iproblemfile ${iproblemfile} ) @@ -12,11 +7,7 @@ foreach ( iproblemfile ${pp_iproblems_source_files} ) add_executable( ${iproblemexec} ${iproblemfile} ) - target_link_libraries( ${iproblemexec} IncompressibleOps 2decomp_fft fftw3) - - if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(${iproblemexec} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") - endif() + target_link_libraries( ${iproblemexec} PRIVATE IncompressibleOps ) file(MAKE_DIRECTORY ${PadeOps_BINARY_DIR}/problems/incompressible/${iproblemexec}_files) # file(COPY ${iproblemexec}_files/*.dat DESTINATION ${PadeOps_BINARY_DIR}/problems/incompressible/${iproblemexec}_files) diff --git a/problems/solids/CMakeLists.txt b/problems/solids/CMakeLists.txt index af643e5f..21168fe5 100644 --- a/problems/solids/CMakeLists.txt +++ b/problems/solids/CMakeLists.txt @@ -1,11 +1,5 @@ file(GLOB sproblems_source_files *.F90) -# Include directories -include_directories( ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${PadeOps_BINARY_DIR}/src ) - -# Link directories -link_directories( ${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${PadeOps_BINARY_DIR}/src ) - # Create the solids problem executables foreach ( sproblemfile ${sproblems_source_files} ) string( REPLACE "${PadeOps_SOURCE_DIR}/problems/solids/" "" sproblemfile ${sproblemfile} ) @@ -13,11 +7,7 @@ foreach ( sproblemfile ${sproblems_source_files} ) add_executable( ${sproblemexec} ${sproblemfile} ) - target_link_libraries( ${sproblemexec} SolidOps ) - - if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(${sproblemexec} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") - endif() + target_link_libraries( ${sproblemexec} PRIVATE SolidOps ) file(MAKE_DIRECTORY ${PadeOps_BINARY_DIR}/problems/solids/${sproblemexec}_files) file(COPY ${sproblemexec}_files/input.dat DESTINATION ${PadeOps_BINARY_DIR}/problems/solids/${sproblemexec}_files) diff --git a/problems/turbines/CMakeLists.txt b/problems/turbines/CMakeLists.txt index ecfbddac..703a94b6 100644 --- a/problems/turbines/CMakeLists.txt +++ b/problems/turbines/CMakeLists.txt @@ -1,10 +1,5 @@ file(GLOB turbproblems_source_files *.F90) -# Include directories -include_directories( ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${PadeOps_BINARY_DIR}/src ) -# Link directories -link_directories( ${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${PadeOps_BINARY_DIR}/src ) - # Create the turbines problem executables foreach ( turbproblemfile ${turbproblems_source_files} ) string( REPLACE "${PadeOps_SOURCE_DIR}/problems/turbines/" "" turbproblemfile ${turbproblemfile} ) @@ -12,11 +7,7 @@ foreach ( turbproblemfile ${turbproblems_source_files} ) add_executable( ${turbproblemexec} ${turbproblemfile} ) - target_link_libraries( ${turbproblemexec} IncompressibleOps 2decomp_fft fftw3) - - if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(${turbproblemexec} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") - endif() + target_link_libraries( ${turbproblemexec} PRIVATE IncompressibleOps ) file(MAKE_DIRECTORY ${PadeOps_BINARY_DIR}/problems/turbines/${turbproblemexec}_files) # file(COPY ${turbproblemexec}_files/*.dat DESTINATION ${PadeOps_BINARY_DIR}/problems/turbines/${turbproblemexec}_files) diff --git a/setup/SetupEnv_Anvil.sh b/setup/SetupEnv_Anvil.sh deleted file mode 100644 index 19d5fbde..00000000 --- a/setup/SetupEnv_Anvil.sh +++ /dev/null @@ -1,18 +0,0 @@ -#!/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_Anvil_impi.sh b/setup/SetupEnv_Anvil_impi.sh new file mode 100644 index 00000000..5b5d742e --- /dev/null +++ b/setup/SetupEnv_Anvil_impi.sh @@ -0,0 +1,18 @@ +#!/bin/bash +module purge +module load intel +module load cmake +module load fftw +module load impi +module load hdf5 +module list + +export COMPILER_ID=Intel +export FC=mpiifort +export CC=mpiicc +export CXX=mpiicpc +export FFTW_PATH=${FFTW_HOME} +export HDF5_PATH=${HDF5_HOME} +export DECOMP_PATH=/anvil/projects/x-atm170028/karim/PadeOps/dependencies/impi/2decomp_fft +export FFTPACK_PATH=dummy +export ARCH_OPT_FLAG="-march=core-avx2" diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 72157776..2ec03055 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -8,68 +8,37 @@ file(GLOB solid_source_files solid/*.F90) file(GLOB poisson_source_files incompressible/poisson/*.F90) file(GLOB incompressible_source_files incompressible/*.F90) -# Where to look for FFTW -set(FFTW_LIBRARY_PATH "${FFTW_PATH}/lib") -set(FFTW_INCLUDE_PATH "${FFTW_PATH}/include") - -# LAPACK -find_package(LAPACK REQUIRED) - -# Include directories -include_directories(${MPI_INCLUDE_PATH} ${FFTW_INCLUDE_PATH} ${DECOMP_INCLUDE_PATH} ${HDF5_INCLUDE_PATH}) - -# Link directories -link_directories(${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${HDF5_LIBRARY_PATH}) +set(PADEOPS_MODULE_DIR "${PadeOps_BINARY_DIR}/src") # 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 - ${HDF5_LIBRARY_PATH}/libhdf5_hl_fortran.a - ${HDF5_LIBRARY_PATH}/libhdf5_hl_f90cstub.a - ${HDF5_LIBRARY_PATH}/libhdf5_hl.a - ${HDF5_LIBRARY_PATH}/libhdf5_fortran.a - ${HDF5_LIBRARY_PATH}/libhdf5_f90cstub.a - ${HDF5_LIBRARY_PATH}/libhdf5.a - -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) -elseif( CMAKE_Fortran_COMPILER_ID MATCHES "AOCC|AMD" ) - 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) -elseif( CMAKE_Fortran_COMPILER_ID MATCHES "GNU" ) - target_link_libraries(PadeOps fftw3 2decomp_fft ${LAPACK_LIBRARIES} ${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 "GNU_OSX") - target_link_libraries(PadeOps fftw3 2decomp_fft blas lapack ${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}) -else() - 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 (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(PadeOps PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") -endif() +set_target_properties(PadeOps PROPERTIES Fortran_MODULE_DIRECTORY "${PADEOPS_MODULE_DIR}") +target_include_directories(PadeOps PUBLIC "${PADEOPS_MODULE_DIR}") +target_link_libraries(PadeOps + PUBLIC + PadeOps::FortranOptions + PadeOps::MPI + PadeOps::FFTW + PadeOps::2DECOMP + PadeOps::HDF5 + PRIVATE + PadeOps::LAPACK +) # Create a library called CompressibleOps add_library(CompressibleOps STATIC ${grid_source_files} ${compressible_source_files}) -target_link_libraries(CompressibleOps PadeOps ${MPI_LIBRARIES}) - -if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(CompressibleOps PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") -endif() +set_target_properties(CompressibleOps PROPERTIES Fortran_MODULE_DIRECTORY "${PADEOPS_MODULE_DIR}") +target_include_directories(CompressibleOps PUBLIC "${PADEOPS_MODULE_DIR}") +target_link_libraries(CompressibleOps PUBLIC PadeOps) # Create a library called SolidOps add_library(SolidOps STATIC ${grid_source_files} ${solid_source_files}) -target_link_libraries(SolidOps CompressibleOps ${MPI_LIBRARIES}) - -if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(SolidOps PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") -endif() +set_target_properties(SolidOps PROPERTIES Fortran_MODULE_DIRECTORY "${PADEOPS_MODULE_DIR}") +target_include_directories(SolidOps PUBLIC "${PADEOPS_MODULE_DIR}") +target_link_libraries(SolidOps PUBLIC CompressibleOps) # Create a library called IncompressibleOps add_library(IncompressibleOps STATIC ${grid_source_files} ${poisson_source_files} ${incompressible_source_files}) -target_link_libraries(IncompressibleOps PadeOps ${MPI_LIBRARIES}) - -if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(IncompressibleOps PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") -endif() +set_target_properties(IncompressibleOps PROPERTIES Fortran_MODULE_DIRECTORY "${PADEOPS_MODULE_DIR}") +target_include_directories(IncompressibleOps PUBLIC "${PADEOPS_MODULE_DIR}") +target_link_libraries(IncompressibleOps PUBLIC PadeOps) diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index e204f340..154fd7dc 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -2,12 +2,6 @@ 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} ${HDF5_INCLUDE_PATH} ${PadeOps_BINARY_DIR}/src ) - -# Link directories -link_directories( ${FFTW_LIBRARY_PATH} ${DECOMP_LIBRARY_PATH} ${HDF5_LIBRARY_PATH} ${PadeOps_BINARY_DIR}/src ) - # Create the test executables foreach ( testfile ${tests_source_files} ) string( REPLACE "${PadeOps_SOURCE_DIR}/tests/" "" testfile ${testfile} ) @@ -15,14 +9,6 @@ foreach ( testfile ${tests_source_files} ) add_executable( ${testexec} ${testfile} ) - target_link_libraries( ${testexec} IncompressibleOps CompressibleOps 2decomp_fft fftw3 ) - - if (MPI_Fortran_COMPILER_FLAGS) - set_target_properties(${testexec} PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS}") - endif() - - # if (MPI_LINK_FLAGS) - # set_target_properties(${testexec} PROPERTIES LINK_FLAGS "${MPI_LINK_FLAGS}") - # endif() + target_link_libraries( ${testexec} PRIVATE IncompressibleOps CompressibleOps ) endforeach() From 3b477033cc41bbfce8e45f04ed34c9d182f7e5ea Mon Sep 17 00:00:00 2001 From: karimali5 Date: Wed, 24 Jun 2026 17:47:31 -0400 Subject: [PATCH 114/114] Add option to recognize implicit sci libs coming with loaded modules, like libsci from ftn on Archer2 --- cmake/PadeOpsLAPACK.cmake | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/cmake/PadeOpsLAPACK.cmake b/cmake/PadeOpsLAPACK.cmake index 1abbd3eb..f816c531 100644 --- a/cmake/PadeOpsLAPACK.cmake +++ b/cmake/PadeOpsLAPACK.cmake @@ -28,7 +28,11 @@ if(LAPACK_FOUND) ) message(STATUS "LAPACK provider: ${LAPACK_LIBRARIES}") else() - if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") + _padeops_check_lapack_link(PADEOPS_IMPLICIT_LAPACK_WORKS "") + if(PADEOPS_IMPLICIT_LAPACK_WORKS) + add_library(PadeOps::LAPACK INTERFACE IMPORTED) + message(STATUS "LAPACK provider: active Fortran compiler wrapper/linker defaults") + elseif(CMAKE_Fortran_COMPILER_ID MATCHES "Intel") _padeops_check_lapack_link(PADEOPS_INTEL_MKL_FLAG_WORKS "-mkl") if(PADEOPS_INTEL_MKL_FLAG_WORKS) add_library(PadeOps::LAPACK INTERFACE IMPORTED)