From 1702f41affcc3c8aa45f61bf3d9c34fe567e4d30 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 28 Jan 2026 16:23:18 +0100 Subject: [PATCH 01/63] create idemix2 module and wrapper, expand the namelist.cvmix --- config/namelist.cvmix | 53 ++ src/cvmix_driver/cvmix_idemix2.F90 | 539 +++++++++++++ .../gen_modules_cvmix_idemix2.F90 | 728 ++++++++++++++++++ src/cvmix_driver/gen_modules_cvmix_tke.F90 | 1 + src/io_meandata.F90 | 1 + src/io_restart.F90 | 1 + src/oce_ale.F90 | 1 + src/oce_setup_step.F90 | 39 +- 8 files changed, 1348 insertions(+), 15 deletions(-) create mode 100644 src/cvmix_driver/cvmix_idemix2.F90 create mode 100644 src/cvmix_driver/gen_modules_cvmix_idemix2.F90 diff --git a/config/namelist.cvmix b/config/namelist.cvmix index 5c73d9403..2dd797dba 100644 --- a/config/namelist.cvmix +++ b/config/namelist.cvmix @@ -71,7 +71,60 @@ idemix_surforc_vname = 'var706' ! variable name in surface forcing file !idemix_botforc_vname = 'wave_dissipation' ! variable name in bottom forcing file idemix_botforc_file = '/albedo/pool/FESOM/fesom2.0/forcing/idemix/forcing_idemix_final_bin/FIN_STORMTIDE2_M2_plus_NYCANDER_CnoM2_bin_0.40deg.nc' ! path to bottom forcing file, idemix_botforc_vname = 'stormt_M2_plus_nycand_CnoM2' ! variable name in bottom forcing file +/ + +! ============================================================================ +! IDEMIX2 (INTERNAL WAVE ENERGY PARAMETERIZATION) +! ============================================================================ +! Based on: F. Pohlmann, C. Eden, D. Olbers and Z. Zhao (draft) Anisotropy of +! internal tide generation and propagation in the consistent internal wave mixing +! closure IDEMIX +! ============================================================================ +¶m_idemix +! --- Time Scales --- +idemix2_tau_v = 172800.0 ! vertical symmetrization time scale [s] (2 days) +idemix2_tau_h = 1296000.0 ! horizontal symmetrization time scale [s] (15 days) + +! --- Spectral Parameters --- +idemix2_gamma = 1.570 ! spectral shape constant [dimensionless] (order 1) +idemix2_jstar = 5.0 ! spectral bandwidth in vertical modes [dimensionless] +idemix2_mu0 = 0.33333333 ! dissipation parameter [dimensionless] + +! --- M2 and Near Inertial Wave components +idemix2_enable_M2 = .true. +idemix2_enable_niw = .false. +idemix2_fniw_usage = 0.2 ! fraction of surface forcing used [dimensionless] + +! --- superbee-spectral advection scheme and Adams-Bashfort timestepping --- +idemix2_superbee_adv = .true. +idemix2_AB_timestep = .true. + +! --- Number of used spectral frequency bins +idemix2_nfbin = 52 + +! ensures idemix1 functionality +idemix2_enable_hor_diffusion = .false. +idemix2_n_hor_iwe_prop_iter = 5 ! from Pollman et al. (2017) + +! --- M2 Forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) --- +idemix2_M2forc_file = './idemix2_IT_forc_M2modes1+2_aniso.nc' +idemix_M2forc_vname = 'Flux_to2.nc' ! variable name in surface forcing file + +! --- NIW Forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) --- +idemix2_niwforc_file = './dummy.nc' +idemix_niwforc_vname = 'dummy' + +! --- Bottom Forcing (Tidal Internal Waves) --- +idemix2_botforc_file = '/albedo/pool/FESOM/fesom2.0/forcing/idemix/forcing_idemix_final_bin/FIN_STORMTIDE2_M2_plus_NYCANDER_CnoM2_bin_0.40deg.nc' ! path to bottom forcing file, +idemix2_botforc_vname = 'stormt_M2_plus_nycand_CnoM2' ! variable name in bottom forcing file + +! --- Root Mean Square Topographic Height forcing --- +idemix2_hrmsforc_file = 'idemix2_forcing_t-scattering_Goff2023_1deg.nc' +idemix2_hrmsforc_vname = 'HRMS' +! --- Characteristic horizontal length scale of topographic feature --- +idemix2_hlamforc_file = 'idemix2_forcing_t-scattering_1deg.nc' +idemix2_hlamforc_vname = 'LAMBDA_G10' / ! ============================================================================ diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 new file mode 100644 index 000000000..8f1358738 --- /dev/null +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -0,0 +1,539 @@ +module cvmix_idemix2 +! This module contains the main computations of the IDEMIX 2 parameterization (described in "A Global Model for the Diapycnal +! Diffusivity Induced by Internal Gravity Waves", Olbers&Eden 2013) of Internal wave energy and its dissipation +! +! EdenOlbers2014: +! -------------- +! Eden, C. and Olbers, D. (2014): An Energy Compartment Model for Propagation, +! Nonlinear Interaction, and Dissipation of Internal Gravity Waves , Journal of +! Physical Oceanography, 44 (8), pp. 2093-2106 . doi: 10.1175/JPO-D-13-0224.1 + +use cvmix_kinds_and_types, only : cvmix_r8, & + CVMIX_OVERWRITE_OLD_VAL, & + CVMIX_SUM_OLD_AND_NEW_VALS, & + CVMIX_MAX_OLD_AND_NEW_VALS, & + cvmix_data_type, & + cvmix_PI, & + cvmix_global_params_type +use cvmix_kinds_and_types_addon, only : cvmix_data_type_addon +use cvmix_utils_addon, only : cvmix_update_tke, solve_tridiag +implicit none + +!_______________________________________________________________________________ +private +save +!public member functions +public :: cvmix_init_idemix2 +public :: cvmix_compute_groupvel_idemix2 +! public :: calc_idemix2_v0 +! public :: cvmix_coeffs_idemix2 +public :: gofx2, hofx1, hofx2 + + +!_______________________________________________________________________________ +! Interface to call the IDEMIX parameterization +! interface cvmix_coeffs_idemix2 +! module procedure integrate_idemix2 ! calculation ! FIXME: rename in cvmix_coeffs_low.. +! !module procedure idemix_wrap ! necessary to handle old/new values and to hand over user_defined constants +! end interface cvmix_coeffs_idemix2 + +interface cvmix_init_idemix2 + module procedure init_idemix2 +end interface cvmix_init_idemix2 + +interface cvmix_compute_groupvel_idemix2 + module procedure compute_groupvel_idemix2 +end interface cvmix_compute_groupvel_idemix2 + +interface idemix2_put + module procedure vmix_tke_put_idemix2_int + module procedure vmix_tke_put_idemix2_real + module procedure vmix_tke_put_idemix2_bool +end interface idemix2_put + +!_______________________________________________________________________________ +! types for Idemix +type, public :: idemix2_type + private + real(cvmix_r8) :: & + tau_v , & ! time scale for vertical symmetrisation (sec) + tau_h , & ! time scale for horizontal symmetrisation, only necessary for lateral diffusion (sec) + gamma , & ! constant of order one derived from the shape of the spectrum in m space (dimensionless) + jstar , & ! spectral bandwidth in modes (dimensionless) + mu0 ! dissipation parameter (dimensionless) + + logical :: & + enable_M2 , & + enable_niw , & + enable_superbee_adv , & + enable_AB_timestep , & + enable_hor_diffusion + + integer :: & + handle_old_vals , & + nfbin , & + hor_diffusion_niter + +end type idemix2_type +type(idemix2_type), target :: idemix2_constants_saved + +!_______________________________________________________________________________ +contains + + + +! +! +!_______________________________________________________________________________ +subroutine init_idemix2(tau_v , & ! time scale for vertical symmetrisation + tau_h , & ! time scale for horizontal symmetrisation + gamma , & ! const. derived from the shape of the spectrum in m spac + jstar , & ! mode number scale + mu0 , & ! dissipation parameter (dimensionless) + nfbin , & ! number of spectral bins + enable_M2 , & + enable_niw , & + enable_superbee_adv , & + enable_AB_timestep , & + enable_hor_diffusion, & + hor_diffusion_niter , & + handle_old_vals, idemix2_userdef_constants) + + ! This subroutine sets user or default values for IDEMIX parameters + real(cvmix_r8), optional, intent(in) :: tau_v, tau_h, gamma, jstar, mu0 + logical , optional, intent(in) :: enable_M2, enable_niw, & + enable_superbee_adv, enable_AB_timestep, & + enable_hor_diffusion + integer , optional, intent(in) :: nfbin, hor_diffusion_niter + integer , optional, intent(in) :: handle_old_vals + type(idemix2_type), target, optional, intent(inout) :: idemix2_userdef_constants + + + ! FIXME: not sure about the allowed ranges for idemix parameters, default values confirm with pyOM testcases + !___ tau_v _________________________________________________________________ + if (present(tau_v)) then + if(tau_v.lt.1.d0*86400.0 .or. tau_v .gt. 100.d0*86400.0) then + print*, "ERROR:tau_v can only be allowed_range" + stop 1 + end if + call idemix2_put('tau_v', tau_v, idemix2_userdef_constants) + else + call idemix2_put('tau_v',1._cvmix_r8*86400.0 , idemix2_userdef_constants) + end if + + !___ tau_h _________________________________________________________________ + if (present(tau_h)) then + if(tau_h.lt. 0.01*864000. .or. tau_h .gt. 100.*86400.) then + print*, "ERROR:tau_h can only be allowed_range" + stop 1 + end if + call idemix2_put('tau_h', tau_h, idemix2_userdef_constants) + else + call idemix2_put('tau_h', 15._cvmix_r8*86400.0, idemix2_userdef_constants) + end if + + !___ gamma _________________________________________________________________ + if (present(gamma)) then + if(gamma.lt. 1.d0 .or. gamma .gt. 3.d0) then + print*, "ERROR:gamma can only be allowed_range" + stop 1 + end if + call idemix2_put('gamma', gamma, idemix2_userdef_constants) + else + call idemix2_put('gamma', 1.57_cvmix_r8, idemix2_userdef_constants) + end if + + !___ jstar _________________________________________________________________ + if (present(jstar)) then + if(jstar.lt. 5.d0 .or. jstar .gt. 15.d0) then + print*, "ERROR:jstar can only be allowed_range" + stop 1 + end if + call idemix2_put('jstar', jstar, idemix2_userdef_constants) + else + call idemix2_put('jstar', 10._cvmix_r8 , idemix2_userdef_constants) + end if + + !___ mu0 ___________________________________________________________________ + if (present(mu0)) then + if(mu0.lt. 0.d0 .or. mu0 .gt. 3.d0) then + print*, "ERROR: mu0 can only be allowed_range" + stop 1 + end if + call idemix2_put('mu0', mu0, idemix2_userdef_constants) + else + call idemix2_put('mu0', 4._cvmix_r8/3.0 , idemix2_userdef_constants) + end if + + !___ superbee_adv __________________________________________________________ + if (present(nfbin)) then + call idemix2_put('nfbin', nfbin, idemix2_userdef_constants) + else + call idemix2_put('nfbin', 52 , idemix2_userdef_constants) + end if + + !___ enable_M2 _____________________________________________________________ + if (present(enable_M2)) then + call idemix2_put('enable_M2', enable_M2, idemix2_userdef_constants) + else + call idemix2_put('enable_M2', .true. , idemix2_userdef_constants) + end if + + !___ enable_niw ____________________________________________________________ + if (present(enable_niw)) then + call idemix2_put('enable_niw', enable_niw, idemix2_userdef_constants) + else + call idemix2_put('enable_niw', .true. , idemix2_userdef_constants) + end if + + !___ superbee_adv __________________________________________________________ + if (present(enable_superbee_adv)) then + call idemix2_put('enable_superbee_adv', enable_superbee_adv, idemix2_userdef_constants) + else + call idemix2_put('enable_superbee_adv', .true. , idemix2_userdef_constants) + end if + + !___ superbee_adv __________________________________________________________ + if (present(enable_AB_timestep)) then + call idemix2_put('enable_AB_timestep', enable_AB_timestep, idemix2_userdef_constants) + else + call idemix2_put('enable_AB_timestep', .true. , idemix2_userdef_constants) + end if + + !___ homogenous diffusion idemix1 functionality ____________________________ + if (present(enable_hor_diffusion)) then + call idemix2_put('enable_hor_diffusion', enable_hor_diffusion, idemix2_userdef_constants) + else + call idemix2_put('enable_hor_diffusion', .false. , idemix2_userdef_constants) + end if + + if (present(hor_diffusion_niter)) then + call idemix2_put('hor_diffusion_niter', hor_diffusion_niter, idemix2_userdef_constants) + else + call idemix2_put('hor_diffusion_niter', 5 , idemix2_userdef_constants) + end if + + !___ handle_old_vals________________________________________________________ + if (present(handle_old_vals)) then + if(handle_old_vals.lt. 1 .or. handle_old_vals.gt. 3 ) then + print*, "ERROR:handle_old_vals can only be 1 to 3" + stop 1 + end if + call idemix2_put('handle_old_vals', handle_old_vals, idemix2_userdef_constants) + else + call idemix2_put('handle_old_vals', 1, idemix2_userdef_constants) + end if +end subroutine init_idemix2 + + +! +! +!_______________________________________________________________________________ +! Compute idemix representative vertical (v0) and horizontal (c0) group velocites +! as well as the enery dissipation coefficient alpha_c +subroutine compute_groupvel_idemix2(nlev , & + nfbin , & + dtime , & + coriolis , & + grady_coriol, & + coslat , & + Nsqr , & + omega_M2 , & + omega_niw , & + cn , & + cn_gradx , & + cn_grady , & + phit , & + phiu , & + alpha_c , & + c0 , & + v0 , & + cg_M2 , & + cg_niw , & + u_M2 , & + v_M2 , & + w_M2 , & + u_niw , & + v_niw , & + w_niw , & + idemix2_const_userdef & + ) + !___Input___________________________________________________________________ + type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef + integer , intent(in) :: nlev , & + nfbin + real(cvmix_r8) , intent(in) :: dtime , & + coriolis , & + grady_coriol , & + coslat , & + cn , & + cn_gradx , & + cn_grady , & + omega_M2 , & + omega_niw + real(cvmix_r8) , intent(in) , dimension(nlev+1):: Nsqr + real(cvmix_r8) , intent(in) , dimension(nfbin) :: phit , & + phiu + !___Output__________________________________________________________________ + real(cvmix_r8) , intent(out), dimension(nlev) :: alpha_c , & + c0 , & + v0 + real(cvmix_r8) , intent(out) :: cg_M2 , & + cg_niw + real(cvmix_r8) , intent(out), dimension(nfbin) :: u_M2 , & + v_M2 , & + w_M2 , & + u_niw , & + v_niw , & + w_niw + !___Local___________________________________________________________________ + integer :: di, fbin_i + real(cvmix_r8) :: fxa, intNz, cstar, & + kdot_x_M2, kdot_x_niw, & + kdot_y_M2, kdot_y_niw + type(idemix2_type), pointer :: idemix2_const_in + + ! do pointer into save variable or into user defined input variable + idemix2_const_in => idemix2_constants_saved + if (present(idemix2_const_userdef)) then + idemix2_const_in => idemix2_const_userdef + end if + + !___________________________________________________________________________ + ! calculate cstar from OE13 Eq. (13) --> vertical integrate sqrt(N²) --> which + ! is already in cn + ! --> cstar = max(1d-2,intNz/(cvmix_PI*idemix2_const_in%jstar) ) + cstar = max(1d-2,cn/(idemix2_const_in%jstar) ) + + !___________________________________________________________________________ + ! calculate vertical and horizontal representative group velocities c0 and v0 + ! c0: OE13 Eq. (13) + ! alpha_c iwe**2: dissipation of internal wave energy (OE13 Eq. (15)) + do di=1,nlev + fxa = sqrt(max(0d0,Nsqr(di))) / ( 1d-22 + abs(coriolis) ) + c0(di) = max(0d0, idemix2_const_in%gamma*cstar*gofx2(fxa)) + v0(di) = max(0d0, idemix2_const_in%gamma*cstar*hofx2(fxa)) + alpha_c(di) = max( 1d-4, idemix2_const_in%mu0*acosh(max(1d0,fxa))*abs(coriolis)/cstar**2 ) + + ! --> ATTENTION: CHECK EFFECT OF THESE LINES !!! + !! set v0 to zero to prevent horizontal iwe propagation in mixed layer + !if ( fxa<1d0 ) then + ! v0(di) = 0d0 + !endif + enddo + ! --> ATTENTION: REMEMBER TO CHECK HORIZONTAL STABILTY CRITERIA WHEN + ! HORIZOTNAL OPERATION IS DONE !!! + ! --> pyOM2: + ! if (enable_idemix_hor_diffusion .or. enable_idemix_hor_diffusion_iter) then + ! ! check for stability criterium, lateral diffusion is explicit + ! ! tau_h v0^2 *dt/dx^2 <= 0.5 -> v0 < sqrt( 0.5*dx^2/(dt tau_h) ) + ! do j=js_pe-onx,je_pe+onx + ! do i=is_pe-onx,ie_pe+onx + ! if (enable_idemix_hor_diffusion_iter) then + ! fxa = 0.2*min( dxt(i)*cost(j), dyt(j) )**2/ max(1D0,dt_tracer/idemix_hor_diffusion_iter *tau_h ) + ! else + ! fxa = 0.2*min( dxt(i)*cost(j), dyt(j) )**2/ max(1D0,dt_tracer *tau_h ) + ! endif + ! v0(i,j,:) = min( sqrt(fxa), v0(i,j,:) ) + ! enddo + ! enddo + ! endif + + !___________________________________________________________________________ + ! compute group velocity of M2 internal tidal waves + if (idemix2_const_in%enable_M2) then + cg_M2=sqrt( max(0d0, omega_M2**2 - coriolis**2 ) ) * cn/omega_M2 + endif + + ! compute group velocity of of near-inertial waves (NIW) + if (idemix2_const_in%enable_niw) then + cg_niw=sqrt( max(0d0, omega_niw**2 - coriolis**2 ) ) * cn/omega_niw + endif + + !___________________________________________________________________________ + ! eq4 in EdenOlbers2014: + ! + ! phi_dot = [c_n/omega/sqrt(omega²-f²)) * f * grad_f + ! + sqrt(omega²-f²)/omega * grad_cn ] * (sin(phi), -cos(phi)) + ! + ! phi_dot = (k_dot_x, kdot_y) * (sin(phi), cos(phi)) + ! + + ! compute wave vector component for the M2 internal tides: + ! kdot_M2 = (kdot_x_M2, kdot_y_M2) + if (idemix2_const_in%enable_M2) then + ! compute: sqrt(omega²-f²) + fxa = max(1d-10,omega_M2**2 - coriolis**2 ) + + ! 1st part coriolis contribution + ! compute: c_n/omega/sqrt(omega²-f²)) * f * grad_f + kdot_y_M2 = -cn/sqrt(fxa)*coriolis/omega_M2*grady_coriol + ! | + ! +-> this minus sign is from the -cos(phi) + ! + ! 2nd part topographic/buoyancy driven contribution + ! compute: sqrt(omega²-f²)/omega * grad_cn + kdot_y_M2 = kdot_y_M2 - sqrt(fxa)/omega_M2*cn_grady + ! | + ! +-> this minus sign is from the -cos(phi) + kdot_x_M2 = sqrt(fxa)/omega_M2*cn_gradx + endif + + ! compute wave vector component for the near-inertial-waves: + ! kdot_niw = (kdot_x_niw, kdot_y_niw) + if (idemix2_const_in%enable_niw) then + ! compute: sqrt(omega²-f²) + fxa = max(1d-10,omega_niw**2 - coriolis**2 ) + + ! 1st part coriolis contribution + ! compute: c_n/omega/sqrt(omega²-f²)) * f * grad_f + kdot_y_niw = -cn/sqrt(fxa)*coriolis/omega_niw*grady_coriol + ! | + ! +-> this minus sign is from the -cos(phi) + ! + ! 2nd part topographic/buoyancy driven contribution + ! compute: sqrt(omega²-f²)/omega * grad_cn + kdot_y_niw = kdot_y_niw - sqrt(fxa)/omega_niw*cn_grady + ! | + ! +-> this minus sign is from the -cos(phi) + kdot_x_niw = sqrt(fxa)/omega_niw*cn_gradx + endif + + + !___________________________________________________________________________ + !zonal, meridional and vertial component of M2 internal tide group velocity + if (idemix2_const_in%enable_M2) then + do fbin_i=2,nfbin-1 + u_M2(fbin_i) = cg_M2*cos( phit(fbin_i) ) + v_M2(fbin_i) = cg_M2*sin( phit(fbin_i) ) * coslat + + !!! ATTENTION !!! --> this might be needed to move to nodes + w_M2(fbin_i) = (kdot_y_M2*cos(phiu(fbin_i)) + kdot_x_M2*sin(phiu(fbin_i)) ) + enddo + end if + + !zonal, meridional and vertial component of NIW internal wave group velocity + if (idemix2_const_in%enable_niw) then + do fbin_i=2,nfbin-1 + u_niw(fbin_i) = cg_niw*cos( phit(fbin_i) ) + v_niw(fbin_i) = cg_niw*sin( phit(fbin_i) ) * coslat + + !!! ATTENTION !!! --> this might be needed to move to nodes + w_niw(fbin_i) = (kdot_y_niw*cos(phiu(fbin_i)) + kdot_x_niw*sin(phiu(fbin_i)) ) + enddo + end if +end subroutine compute_groupvel_idemix2 + + +! ! +! ! +! !_______________________________________________________________________________ +! subroutine set_compute_groupvel_idemix2(dzt , & +! nlev , & +! dtime , & +! coriolis , & +! Nsqr , & +! omega_M2 , & +! omega_niw , & +! alpha_c , & +! c0 , & +! v0 , & +! idemix2_const_userdef & +! ) + + +! +! +!_______________________________________________________________________________ +subroutine vmix_tke_put_idemix2_real(varname, val, idemix2_userdef_constants) + ! This subroutine puts real values to IDEMIX variables + character(len=*), intent(in) :: varname + real(cvmix_r8), intent(in) :: val + type(idemix2_type), intent(inout), target, optional:: idemix2_userdef_constants + type(idemix2_type), pointer :: idemix2_constants_out + ! do pointer into save variable + idemix2_constants_out=>idemix2_constants_saved + ! if input idemix_userdef_constants present do pointer into this + if (present(idemix2_userdef_constants)) idemix2_constants_out=> idemix2_userdef_constants + select case(trim(varname)) + case('tau_v') ; idemix2_constants_out%tau_v = val + case('tau_h') ; idemix2_constants_out%tau_h = val + case('jstar') ; idemix2_constants_out%jstar = val + case('gamma') ; idemix2_constants_out%gamma = val + case('mu0' ) ; idemix2_constants_out%mu0 = val + case DEFAULT + print*, "ERROR:", trim(varname), " not a valid choice" + stop 1 + end select +end subroutine vmix_tke_put_idemix2_real + +subroutine vmix_tke_put_idemix2_int(varname,val,idemix2_userdef_constants) + ! This subroutine puts integer values to IDEMIX variables + character(len=*), intent(in) :: varname + integer, intent(in) :: val + type(idemix2_type), intent(inout), target, optional:: idemix2_userdef_constants + type(idemix2_type), pointer :: idemix2_constants_out + idemix2_constants_out=>idemix2_constants_saved + if (present(idemix2_userdef_constants)) idemix2_constants_out=> idemix2_userdef_constants + select case(trim(varname)) + case('handle_old_vals' ) ; idemix2_constants_out%handle_old_vals = val + case('nfbin' ) ; idemix2_constants_out%nfbin = val + case('hor_diffusion_niter') ; idemix2_constants_out%hor_diffusion_niter= val + case DEFAULT + print*, "ERROR:", trim(varname), " not a valid choice" + stop 1 + end select +end subroutine vmix_tke_put_idemix2_int + +subroutine vmix_tke_put_idemix2_bool(varname,val,idemix2_userdef_constants) + ! This subroutine puts integer values to IDEMIX variables + character(len=*), intent(in) :: varname + logical, intent(in) :: val + type(idemix2_type), intent(inout), target, optional:: idemix2_userdef_constants + type(idemix2_type), pointer :: idemix2_constants_out + idemix2_constants_out=>idemix2_constants_saved + if (present(idemix2_userdef_constants)) idemix2_constants_out=> idemix2_userdef_constants + select case(trim(varname)) + case('enable_M2' ) ; idemix2_constants_out%enable_M2 = val + case('enable_niw' ) ; idemix2_constants_out%enable_niw = val + case('enable_superbee_adv' ) ; idemix2_constants_out%enable_superbee_adv = val + case('enable_AB_timestep' ) ; idemix2_constants_out%enable_AB_timestep = val + case('enable_hor_diffusion') ; idemix2_constants_out%enable_hor_diffusion= val + case DEFAULT + print*, "ERROR:", trim(varname), " not a valid choice" + stop 1 + end select +end subroutine vmix_tke_put_idemix2_bool + + +! +! +!_______________________________________________________________________________ +! function g(x) --> adapted from pyOM +function gofx2(x1) + implicit none + real(cvmix_r8) :: gofx2,x1,x2,c + real(cvmix_r8), parameter :: pi = 3.14159265358979323846264338327950588 + x2=max(3d0,x1) + c= 1.-(2./pi)*asin(1./x2) + gofx2 = 2/pi/c*0.9*x2**(-2./3.)*(1-exp(-x2/4.3)) +end function gofx2 + +! function h(x) --> adapted from pyOM +function hofx2(x1) + implicit none + real(cvmix_r8) :: hofx2,x1,x2 + real(cvmix_r8), parameter :: pi = 3.14159265358979323846264338327950588 + x2 = max(1d1, x1) ! by_nils: it has to be x2>1 + hofx2 = (2./pi)/(1.-(2./pi)*asin(1./x2)) * (x2-1.)/(x2+1.) +end function hofx2 + +! function h(x) --> from pyOM +function hofx1(x) + implicit none + real(cvmix_r8) :: hofx1,x + real(cvmix_r8), parameter :: pi = 3.14159265358979323846264338327950588 + hofx1 = (2./pi)/(1.-(2./pi)*asin(1./x)) * (x-1.)/(x+1.) +end function hofx1 + +end module cvmix_idemix2 \ No newline at end of file diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 new file mode 100644 index 000000000..5f112c819 --- /dev/null +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -0,0 +1,728 @@ +! +! +!=============================================================================== +! module interface to FESOM2.0 for the CVMIX IDEMIX2 extension for the calculation +! of the internal wave energy and its dissipation in Turbulent Kinetic Energy +! vertical mixing scheme --> it is based one its pyOM2 implementation by Carsten Eden +! +! @see Olbers D., Eden C.: +! A Global Model for the Diapycnal Diffusivity Induced Internal Gravity Waves. +! J. Phys. Oceanogr., 43, 1759-1779. doi: 10.1175/JPO-D-12-0207.1, 2013. +! @see Eden C., Czeschel L., Olbers D.: +! Towards Energetically Consistent Ocean Models. +! J. Phys. Oceanogr., 44, 3160-3184, doi: 10.1175/JPO-D-13-0260.1, 2014. +! written by Patrick Scholz, 10.05.2019 +module g_cvmix_idemix2 + + !___________________________________________________________________________ + ! module calls from cvmix library + use cvmix_idemix2, only : cvmix_init_idemix2, & + cvmix_compute_groupvel_idemix2 !calc_idemix2_v0, cvmix_coeffs_idemix2 + use cvmix_put_get, only : cvmix_put + use cvmix_kinds_and_types + + !___________________________________________________________________________ + ! module calls from FESOM + use g_config , only: dt + use o_param + use mod_mesh + USE MOD_PARTIT + USE MOD_PARSUP + use o_arrays + use g_comm_auto + use g_read_other_NetCDF + implicit none + public + + !___________________________________________________________________________ + ! OCECTL/CVMIX_IDEMIX_PARAM namelist parameters + ! time scale for vertical symmetrisation (sec) + ! real(kind=WP) :: idemix_tau_v = 86400.0 ! old + real(kind=WP) :: idemix2_tau_v = 172800.0 ! from Pollman et al. (2017), use 2days, 2*86400sec + + ! time scale for horizontal symmetrisation, only necessary for lateral diffusion (sec), + ! use 15days, 15*86400sec + real(kind=WP) :: idemix2_tau_h = 1296000.0 + + ! constant of order one derived from the shape of the spectrum in m space (dimensionless) + real(kind=WP) :: idemix2_gamma = 1.570 + + ! spectral bandwidth in modes (dimensionless), or mode number scale, it describes over + ! over how many equivalent modes the energy is spread + ! real(kind=WP) :: idemix_jstar = 10.0 ! old + real(kind=WP) :: idemix2_jstar = 5.0 ! from Pollman et al. (2017) + + ! dissipation parameter (dimensionless) + ! real(kind=WP) :: idemix_mu0 = 1.33333333 ! old + real(kind=WP) :: idemix2_mu0 = 0.33333333 ! from Pollman et al. (2017), use 2days + + ! enable M2 tidal component as significant source of internal wave energy in IDEMIX2, + ! lower frequency modes + ! Frequency: Semi-diurnal (twice daily, ~12.42 hour period) + ! Source : Barotropic tidal flow over rough topography + ! Energy : Higher energy, lower frequency + ! Impact : Dominant in regions with strong tidal currents + logical :: idemix2_enable_M2 = .true. + + ! enable Near-Inertial Wave (NIW) component of the IDEMIX module. NIWs are generated by + ! wind stress and have frequencies close to the local inertial frequency. + ! Frequency: Near the local inertial frequency (f, typically 1-4 cycles per day at mid-latitudes) + ! Source : Wind forcing, especially during storms + ! Energy : Lower energy, higher frequency than M2 + ! Impact : Important in the upper ocean, especially after storms + logical :: idemix2_enable_niw = .false. + + ! amount of surface for2cing that is used + real(kind=WP) :: idemix2_fniw_usage = 0.2 + + ! use superbee-spectral advection scheme and Adams-Bashfort timestepping + logical :: idemix2_enable_superbee_adv = .true. + logical :: idemix2_enable_AB_timestep = .true. + + ! number of spectral bins used for the M2 tidal and near-inertial wave (niw) components + ! e.g 50+2 in loop used as do fbin=2,51 ... 1 and 52 serve as spectral boudary condition + ! The first and last bins are used for boundary conditions in the spectral space. + ! They ensure smooth transitions and prevent numerical instabilities at the edges of the spectral domain. + ! Numerical Stability: The advection scheme (e.g., Superbee) requires ghost cells or boundary values. + ! Skipping the first and last bins avoids out-of-bounds errors when calculating gradients. + integer :: idemix2_nfbin=52 + + ! enable idemix1 functionality of homogenous diffusion into all directions + logical :: idemix2_enable_hor_diffusion = .false. + integer :: idemix2_hor_diffusion_niter = 5 ! from Pollman et al. (2017) + + ! filelocation for idemix2 M2 forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) + character(MAX_PATH):: idemix2_M2forc_file = './idemix2_IT_forc_M2modes1+2_aniso.nc' + character(MAX_PATH):: idemix2_M2forc_vname= 'Flux_to2.nc' + + ! filelocation for idemix2 NIW forcing (near inertial waves) + character(MAX_PATH):: idemix2_niwforc_file = './dummy.nc' + character(MAX_PATH):: idemix2_niwforc_vname= 'dummy' + + ! filelocation for idemix2 bottom forcing + character(MAX_PATH):: idemix2_botforc_file = './tidal_energy_gx1v6_20090205_rgrid.nc' + character(MAX_PATH):: idemix2_botforc_vname= 'wave_dissipation' + ! total global Energy input that should be conserved if 0.0 no conservation is applied + real(kind=WP) :: idemix2_botforc_Etot = 0.0_WP ! units W + + ! filelocation for idemix2 Root Mean Square Topographic Height forcing. Measures the roughness or + ! variability of seafloor topography. Units: Meters (m), Role: Represents the standard deviation + ! of seafloor height variations. Used to calculate energy transfer from tides/NIW to internal waves. + character(MAX_PATH):: idemix2_hrmsforc_file = './idemix2_forcing_t-scattering_Goff2023_1deg.nc' + character(MAX_PATH):: idemix2_hrmsforc_vname= 'HRMS' + + ! filelocation for idemix2 Characteristic horizontal length scale of topographic features. + ! Units: Meters (m), Role: Represents the dominant wavelength of seafloor roughness. Used to + ! normalize the topographic forcing. + character(MAX_PATH):: idemix2_hlamforc_file = './idemix2_forcing_t-scattering_1deg.nc' + character(MAX_PATH):: idemix2_hlamforc_vname= 'LAMBDA_G10' + + namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, & + idemix2_enable_M2, idemix2_enable_niw, idemix2_fniw_usage, & + idemix2_enable_superbee_adv, idemix2_enable_AB_timestep, idemix2_nfbin, & + idemix2_enable_hor_diffusion, idemix2_hor_diffusion_niter, & + idemix2_M2forc_file, idemix2_M2forc_vname, & + idemix2_niwforc_file, idemix2_niwforc_file, & + idemix2_botforc_file, idemix2_botforc_vname, idemix2_botforc_Etot, & + idemix2_hrmsforc_file, idemix2_hrmsforc_vname, & + idemix2_hlamforc_file, idemix2_hlamforc_vname + + !___________________________________________________________________________ + ! CVMIX-IDEMIX variables + + ! M2 and niw frequency in 1/s + real(kind=WP) :: iwe2_omega_M2 + real(kind=WP), allocatable, dimension(:) :: iwe2_omega_niw, iwe2_grady_coriol + + real(kind=WP) :: iwe2_dphit, iwe2_dphiu + real(kind=WP), allocatable, dimension(:) :: iwe2_phit, iwe2_phiu, aux + + real(kind=WP), allocatable, dimension(:,:) :: iwe2, iwe2_n, iwe2_tm1, iwe2_tm2 + real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2, iwe2_M2_tm1, iwe2_M2_tm2 + real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw, iwe2_niw_tm1, iwe2_niw_tm2 + + real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_u, iwe2_M2_v, iwe2_M2_w + real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_u, iwe2_niw_v, iwe2_niw_w + + real(kind=WP), allocatable, dimension(:) :: iwe2_cn, iwe2_cg_M2, iwe2_cg_niw + real(kind=WP), allocatable, dimension(:,:) :: iwe2_c0, iwe2_v0 + + real(kind=WP), allocatable, dimension(:,:) :: iwe2_alpha_c, iwe2_alpha_c_n + + real(kind=WP), allocatable, dimension(:) :: iwe2_topo_hrms, iwe2_topo_hlam + real(kind=WP), allocatable, dimension(:) :: iwe2_M2_tau, iwe2_niw_tau + + real(kind=WP), allocatable, dimension(:) :: iwe2_fbot, iwe2_fsrf + real(kind=WP), allocatable, dimension(:,:) :: iwe2_fM2, iwe2_fniw + + real(kind=WP), allocatable, dimension(:,:) :: iwe2_Av, iwe2_Kv + + real(kind=WP), allocatable, dimension(:,:) :: iwe2_Ttot, iwe2_Tdif, iwe2_Thdi, iwe2_Tdis, iwe2_Tdis_n, iwe2_Tsur, iwe2_Tbot + +! real(kind=WP), allocatable, dimension(:,:) :: cvmix_dummy_1, cvmix_dummy_2, cvmix_dummy_3 + + real(kind=WP), allocatable, dimension(:,:) :: vol_wcelli + + ! load variables from CVMix list + type(cvmix_data_type) :: CVMix_vars + + ! nils/ + integer :: tstep_count + + contains + ! + ! + ! + !=========================================================================== + ! allocate and initialize IDEMIX variables --> call initialisation + ! routine from cvmix library + subroutine init_cvmix_idemix2(partit, mesh) + implicit none + type(t_mesh), intent(in), target :: mesh + type(t_partit), intent(inout), target :: partit + + character(len=cvmix_strlen) :: nmlfile + logical :: file_exist=.False. + integer :: node_size, elem_size, elem, nfbin, fbin_i, elnodes(3) + real(kind=WP) :: loc_Etot=0.0_WP, glb_Etot=0.0_WP +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + !_______________________________________________________________________ + if(mype==0) then + write(*,*) '____________________________________________________________' + write(*,*) ' --> initialise IDEMIX' + write(*,*) + end if + + !_______________________________________________________________________ + ! allocate + initialse idemix arrays --> with size myDim_nod2D+eDim_nod2D + node_size=myDim_nod2D+eDim_nod2D + elem_size=myDim_elem2D+eDim_elem2D + nfbin =idemix2_nfbin + + ! allocate dummy variable + allocate(aux(elem_size)) + aux(:) = 0.0_WP + + ! lat gradient in coriolis (is only computed @init) + allocate(iwe2_grady_coriol(elem_size)) + iwe2_grady_coriol(:)= 0.0_WP + + allocate(iwe2_omega_niw(elem_size)) + iwe2_omega_niw(:) = 0.0_WP + + ! allocate 1d Spectral space coordinates + allocate(iwe2_phit(nfbin), iwe2_phiu(nfbin)) + iwe2_phit(:) = 0.0_WP + iwe2_phiu(:) = 0.0_WP + + ! Internal wave energy at time levels + allocate(iwe2(nl,elem_size), iwe2_tm1(nl,elem_size), iwe2_tm2(nl,elem_size), iwe2_n(nl,node_size)) + iwe2(:,:) = 0.0_WP ! E_iw(t) + iwe2_n(:,:) = 0.0_WP ! E_iw(t) + iwe2_tm1(:,:) = 0.0_WP ! E_iw(t-1) + iwe2_tm2(:,:) = 0.0_WP ! E_iw(t-2) + + ! M2 wave energy at time levels + allocate(iwe2_M2(nl,elem_size), iwe2_M2_tm1(nl,elem_size), iwe2_M2_tm2(nl,elem_size)) + iwe2_M2(:,:) = 0.0_WP ! E_M2(t) + iwe2_M2_tm1(:,:) = 0.0_WP ! E_M2(t-1) + iwe2_M2_tm2(:,:) = 0.0_WP ! E_M2(t-2) + + ! niw wave energy at time levels + allocate(iwe2_niw(nl,elem_size), iwe2_niw_tm1(nl,elem_size), iwe2_niw_tm2(nl,elem_size)) + iwe2_niw(:,:) = 0.0_WP ! E_niw(t) + iwe2_niw_tm1(:,:) = 0.0_WP ! E_niw(t-1) + iwe2_niw_tm2(:,:) = 0.0_WP ! E_niw(t-2) + + ! internal wave related vertical viscosity and diffusivity + allocate(iwe2_Av(nl,elem_size)) + allocate(iwe2_Kv(nl,elem_size)) + iwe2_Av(:,:) = 0.0_WP + iwe2_Kv(:,:) = 0.0_WP + + allocate(vol_wcelli(nl,node_size)) + vol_wcelli(:,:) = 0.0_WP + + ! M2 group velocity components + allocate(iwe2_M2_u(nfbin,elem_size), iwe2_M2_v(nfbin,elem_size), iwe2_M2_w(nfbin,elem_size)) + iwe2_M2_u(:,:) = 0.0_WP + iwe2_M2_v(:,:) = 0.0_WP + iwe2_M2_w(:,:) = 0.0_WP + + ! NIW group velocity components (i,j,np) + allocate(iwe2_niw_u(nfbin,elem_size), iwe2_niw_v(nfbin,elem_size), iwe2_niw_w(nfbin,elem_size)) + iwe2_niw_u(:,:) = 0.0_WP + iwe2_niw_v(:,:) = 0.0_WP + iwe2_niw_w(:,:) = 0.0_WP + + ! Vertical group velocity c0, Horizontal group velocity v0 + allocate(iwe2_c0(nl,elem_size), iwe2_v0(nl,elem_size)) + iwe2_c0(:,:) = 0.0_WP + iwe2_v0(:,:) = 0.0_WP + + allocate(iwe2_cg_M2(elem_size), iwe2_cg_niw(elem_size)) + iwe2_cg_M2(:) = 0.0_WP + iwe2_cg_niw(:) = 0.0_WP + + allocate(iwe2_cn(node_size)) + iwe2_cn(:) = 0.0_WP + + ! Dissipation coefficient + allocate(iwe2_alpha_c(nl,elem_size), iwe2_alpha_c_n(nl,node_size)) + iwe2_alpha_c(:,:) = 0.0_WP + iwe2_alpha_c_n(:,:) = 0.0_WP + + ! Topographic height and Topographic wavelength + allocate(iwe2_topo_hrms(elem_size),iwe2_topo_hlam(elem_size)) + iwe2_topo_hrms(:) = 0.0_WP + iwe2_topo_hlam(:) = 0.0_WP + + ! M2 and NIW dissipation timescale + allocate(iwe2_M2_tau(elem_size),iwe2_niw_tau(elem_size)) + iwe2_M2_tau(:) = 0.0_WP + iwe2_niw_tau(:) = 0.0_WP + + ! forcing fields, M2 tidal forcing (spectral) and NIW forcing (spectral) + allocate(iwe2_fbot(elem_size), iwe2_fsrf(elem_size)) + allocate(iwe2_fM2(nfbin, elem_size), iwe2_fniw(nfbin, elem_size)) + iwe2_fbot(:) = 0.0_WP + iwe2_fsrf(:) = 0.0_WP + iwe2_fM2(:,:) = 0.0_WP + iwe2_fniw(:,:) = 0.0_WP + + ! diagnostic + allocate(iwe2_Ttot(nl,elem_size)) + allocate(iwe2_Tdif(nl,elem_size)) + allocate(iwe2_Thdi(nl,elem_size)) + allocate(iwe2_Tdis(nl,elem_size), iwe2_Tdis_n(nl,node_size)) + allocate(iwe2_Tsur(nl,elem_size)) + allocate(iwe2_Tbot(nl,elem_size)) + iwe2_Ttot(:,:) = 0.0_WP + iwe2_Tdif(:,:) = 0.0_WP + iwe2_Thdi(:,:) = 0.0_WP + iwe2_Tdis(:,:) = 0.0_WP + iwe2_Tsur(:,:) = 0.0_WP + iwe2_Tbot(:,:) = 0.0_WP + iwe2_Tdis_n(:,:) = 0.0_WP + +! allocate(cvmix_dummy_1(nl,elem_size)) +! allocate(cvmix_dummy_2(nl,elem_size)) +! allocate(cvmix_dummy_3(nl,elem_size)) +! cvmix_dummy_1(:,:) = 0.0_WP +! cvmix_dummy_2(:,:) = 0.0_WP +! cvmix_dummy_3(:,:) = 0.0_WP + + ! nils (for debugging) + tstep_count = 0 + + !_______________________________________________________________________ + ! width of spectral frequency bins + iwe2_dphit = 2.0_WP*pi/(nfbin-2) + iwe2_dphiu = iwe2_dphit + ! iwe2_phiu(k) represents the center of the k-th spectral bin + ! iwe2_phit(k) represents the edge of the k-th spectral bin + iwe2_phit(1) = -iwe2_dphit + iwe2_phiu(1 )= iwe2_phit(1)+iwe2_dphit/2.0_WP + do fbin_i=2,nfbin + iwe2_phit(fbin_i) = iwe2_phit(fbin_i-1) + iwe2_dphit + iwe2_phiu(fbin_i) = iwe2_phiu(fbin_i-1) + iwe2_dphiu + end do + + + !_______________________________________________________________________ + ! read cvmix namelist file + nmlfile ='namelist.cvmix' ! name of ocean namelist file + ! check if cvmix namelist file exists if not use default values + file_exist=.False. + inquire(file=trim(nmlfile),exist=file_exist) + if (file_exist) then + open(20,file=trim(nmlfile)) + read(20,nml=param_idemix2) + close(20) + else + write(*,*) ' could not find namelist.cvmix, will use default values !' + end if + + + !_______________________________________________________________________ + if (mype==0) then + write(*,*) " idemix2_tau_v = ", idemix2_tau_v + write(*,*) " idemix2_tau_h = ", idemix2_tau_h + write(*,*) " idemix2_gamma = ", idemix2_gamma + write(*,*) " idemix2_jstar = ", idemix2_jstar + write(*,*) " idemix2_mu0 = ", idemix2_mu0 + write(*,*) " idemix2_enable_M2 = ", idemix2_enable_M2 + write(*,*) " idemix2_enable_niw = ", idemix2_enable_niw + write(*,*) " idemix2_fniw_usage = ", idemix2_fniw_usage + write(*,*) " idemix2_superbee_adv = ", idemix2_enable_superbee_adv + write(*,*) " idemix2_AB_timestep = ", idemix2_enable_AB_timestep + write(*,*) " idemix2_nfbin = ", idemix2_nfbin + write(*,*) " idemix2_M2forc_file = ", trim(idemix2_M2forc_file) + write(*,*) " idemix2_niwforc_file = ", trim(idemix2_niwforc_file) + write(*,*) " idemix2_botforc_file = ", trim(idemix2_botforc_file) + write(*,*) " idemix2_botforc_Etot = ", idemix2_botforc_Etot + + write(*,*) " idemix2_hrmsforc_file= ", trim(idemix2_hrmsforc_file) + write(*,*) " idemix2_hlamforc_file= ", trim(idemix2_hlamforc_file) + write(*,*) + end if + + + !_______________________________________________________________________ + ! read idemix M2 forcing from cfsr data --> file + if (idemix2_enable_M2) then + ! omega_M2 is fixed, as the M2 tidal forcing is independent of the local inertial frequency. + ! Physical Implication: At high latitudes where |f| > ω_M2, the M2 tide becomes evanescent + ! (cannot propagate as internal waves). This is handled in the code by checking ω_M2 > |f| + ! for M2 tidal forcing when computing iwe_M2_tau, if ω_M2 < |f| --> iwe_M2_tau=0.0 + iwe2_omega_M2 = 2*pi/( 12*60*60 + 25.2 *60 ) ! M2 frequency in 1/s + + file_exist=.False. + inquire(file=trim(idemix2_M2forc_file),exist=file_exist) + if (file_exist) then + if (mype==0) write(*,*) ' --> read IDEMIX M2 wave forcing' + do fbin_i =2, nfbin-1 + call read_other_NetCDF(idemix2_M2forc_file, idemix2_M2forc_vname, fbin_i, aux, .true., .false., partit, mesh) + ! | + ! .false.=interpolate on element centroids instead of vertices <---+ + iwe2_fM2(fbin_i, :) = aux/density_0/iwe2_dphit + end do + else + if (mype==0) then + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: IDEMIX2 M2 forcing file not found! Cant apply IDEMIX2' + write(*,*) ' vertical mixing parameterisation! ' + write(*,*) ' --> check your namelist.cvmix, idemix2_M2forc_file & ' + write(*,*) '____________________________________________________________________' + end if + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + end if ! --> if (idemix2_enable_M2) then + + + !_______________________________________________________________________ + ! read idemix niw oe srf forcing from cfsr data --> file + file_exist=.False. + inquire(file=trim(idemix2_niwforc_file),exist=file_exist) + if (file_exist) then + if (mype==0) write(*,*) ' --> read IDEMIX niw/surface wave forcing' + call read_other_NetCDF(idemix2_niwforc_file, idemix2_niwforc_vname, 1, iwe2_fsrf, .true., .false., partit, mesh) + ! only 20% (idemix2_fniw_usage) from the surface forcing goes into internal waves + ! iwe2_fsrf becomes surface forcing variable when idemix2_enable_niw=.false. + ! in this case standard idemix1 behaviour + iwe2_fsrf = iwe2_fsrf/density_0*idemix2_fniw_usage + if (idemix2_enable_niw) then + do fbin_i =2, nfbin-1 + iwe2_fniw(fbin_i, :) = iwe2_fsrf/iwe2_dphit !!!ATTENTION CHECK THIS AGAIN!!! + end do + else + iwe2_fsrf(:) = 0.0_WP + end if + + else + if (mype==0) then + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: IDEMIX2 NIW forcing file not found! Cant apply IDEMIX2' + write(*,*) ' vertical mixing parameterisation! ' + write(*,*) ' --> check your namelist.cvmix, idemix2_niwforc_file & ' + write(*,*) '____________________________________________________________________' + end if + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + + ! NIWs are super-inertial (ω_niw > |f|), which is essential for their propagation as internal waves. + ! The factor 1.05 ensures the frequency is 5% above the local inertial frequency. + ! Why 1.05? Represents the minimum frequency for NIWs to propagate. Accounts for the Doppler shift + ! from background flows. Physical Context: NIWs are generated by wind events and have frequencies + ! close to f. They can only propagate as internal waves if ω > |f|. + if (idemix2_enable_niw) then + do elem = 1, elem_size + iwe2_omega_niw(elem) = max(1d-8, abs( 1.05 * mesh%coriolis(elem) ) ) + end do + end if + + !_______________________________________________________________________ + ! read idemix bottom near tidal forcing from cesm data set --> file + ! from N. Brüggemann interpoalted to regular grid + file_exist=.False. + inquire(file=trim(idemix2_botforc_file),exist=file_exist) + if (file_exist) then + if (mype==0) write(*,*) ' --> read IDEMIX near tidal bottom forcing' + call read_other_NetCDF(idemix2_botforc_file, idemix2_botforc_vname, 1, iwe2_fbot, .true., .false., partit, mesh) + ! | + ! .false.=interpolate on element centroids instead of vertices <---+ + + ! check for total tidal energy that is infused through the bottom, see how + ! much is lossed during interpolation and compare with value of the + ! original files + loc_Etot = 0.0_WP + do elem=1, myDim_elem2D + ! REMEMBER!!!: the partition on elements is not unique there are + ! elements that belong to two CPUs. For unique elements the index + ! of the First trinagle node must be <= myDim_nod2D + if (elem2D_nodes(1,elem)<=myDim_nod2D) then + loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot(elem) + end if + end do + call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + if (mype==0) write(*,*) " --> IDEMIX2 total tidal energy Etot_bot =", glb_Etot*1.0e-12, ' TW' + + ! normalize total tidal energy at bottom with respect to the total + ! tidal energy that is e.g in the original forcing files to accomodate + ! non concerving losses during interpolation. This is only done when + ! in namelist.cvmix: idemix2_botforc_Etot \= 0.0_WP + if (idemix2_botforc_Etot /= 0.0_WP) then + iwe2_fbot = iwe2_fbot * idemix2_botforc_Etot/glb_Etot + + loc_Etot = 0.0_WP + do elem=1, myDim_elem2D + ! REMEMBER!!!: the partition on elements is not unique there are + ! elements that belong to two CPUs. For unique elements the index + ! of the First trinagle node must be <= myDim_nod2D + if (elem2D_nodes(1,elem)<=myDim_nod2D) then + loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot(elem) + end if + end do + call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + if (mype==0) write(*,*) " --> IDEMIX2 Etot_bot after normalizing =", glb_Etot*1.0e-12, ' TW' + end if + + ! divide by density_0 --> convert from W/m^2 to m^3/s^3 + iwe2_fbot = iwe2_fbot/density_0 + + else + if (mype==0) then + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: IDEMIX bottom forcing file not found! Cant apply IDEMIX' + write(*,*) ' vertical mixing parameterisation! ' + write(*,*) ' --> check your namelist.cvmix, idemix_surforc_file & ' + write(*,*) ' idemix_botforc_file' + write(*,*) '____________________________________________________________________' + end if + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + + !_______________________________________________________________________ + ! read idemix HRMS and HLAM forcing --> file + if (idemix2_enable_M2 .or. idemix2_enable_niw ) then + ! topo_hrms (Root Mean Square Topographic Height), Definition: Measures the roughness or variability of seafloor topography. + ! Units: Meters (m), Role: Represents the standard deviation of seafloor height variations. Used to calculate + ! energy transfer from tides/NIW to internal waves. + ! file_exist=.False. + inquire(file=trim(idemix2_hrmsforc_file),exist=file_exist) + if (file_exist) then + if (mype==0) write(*,*) ' --> read IDEMIX HRMS forcing' + call read_other_NetCDF(idemix2_hrmsforc_file, idemix2_hrmsforc_vname, 1, iwe2_topo_hrms, .true., .false., partit, mesh) + else + if (mype==0) then + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: IDEMIX2 HRMS forcing file not found! Cant apply IDEMIX2' + write(*,*) ' vertical mixing parameterisation! ' + write(*,*) ' --> check your namelist.cvmix, idemix2_hrmsforc_file & ' + write(*,*) '____________________________________________________________________' + end if + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + + ! topo_hlam (Topographic Wavelength), Definition: Characteristic horizontal length scale of topographic features. + ! Units: Meters (m), Role: Represents the dominant wavelength of seafloor roughness. Used to normalize the topographic forcing. + file_exist=.False. + inquire(file=trim(idemix2_hlamforc_file),exist=file_exist) + if (file_exist) then + if (mype==0) write(*,*) ' --> read IDEMIX HLAM forcing' + call read_other_NetCDF(idemix2_hlamforc_file, idemix2_hlamforc_vname, 1, iwe2_topo_hlam, .true., .false., partit, mesh) + else + if (mype==0) then + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: IDEMIX2 HLAM forcing file not found! Cant apply IDEMIX2' + write(*,*) ' vertical mixing parameterisation! ' + write(*,*) ' --> check your namelist.cvmix, idemix2_hlamforc_file & ' + write(*,*) '____________________________________________________________________' + end if + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + + ! In the M2 tidal and NIW energy calculations: + ! --> fxc = topo_hrms(i,j)**2 * 2*pi / (1d-12 + topo_lam(i,j)) + ! This term estimates the energy flux from barotropic tides to internal waves. The ratio topo_hrms²/topo_lam represents + ! the topographic "steepness" affecting wave generation. + ! Physical Interpretation: + ! --> High topo_hrms and small topo_lam: Indicates rough, steep topography that efficiently generates internal waves. + ! --> Low topo_hrms and large topo_lam: Indicates smooth, flat topography with minimal wave generation. + ! These parameters are crucial for accurately representing the conversion of barotropic tidal energy to internal + ! waves over rough topography. + + end if ! --> if (idemix2_enable_niw) then + + !_______________________________________________________________________ + ! compute d/dy of coriolis + do elem = 1, elem_size + elnodes = elem2d_nodes(:,elem) + iwe2_grady_coriol(elem) = sum(gradient_sca(4:6, elem)*mesh%coriolis_node(elnodes)) + end do + + !_______________________________________________________________________ + ! initialise IDEMIX parameters + call cvmix_init_idemix2(tau_v = idemix2_tau_v , & + tau_h = idemix2_tau_h , & + gamma = idemix2_gamma , & + jstar = idemix2_jstar , & + mu0 = idemix2_mu0 , & + nfbin = idemix2_nfbin , & + enable_M2 = idemix2_enable_M2 , & + enable_niw = idemix2_enable_niw , & + enable_superbee_adv = idemix2_enable_superbee_adv , & + enable_AB_timestep = idemix2_enable_AB_timestep , & + enable_hor_diffusion= idemix2_enable_hor_diffusion, & + hor_diffusion_niter = idemix2_hor_diffusion_niter & + ) + + end subroutine init_cvmix_idemix2 + + ! + ! + ! + !=========================================================================== + ! calculate IDEMIX2 internal wave energy and its dissipation + subroutine calc_cvmix_idemix2(partit, mesh) + implicit none + type(t_mesh), intent(in), target :: mesh + type(t_partit), intent(inout), target :: partit + integer :: node, elem, edge, node_size, elem_size, k + integer :: nz, nln, nl1, nl2, nl12, nu1, nu2, nu12, uln, niter + integer :: elnodes1(3), elnodes2(3), el(2), ednodes(2) + real(kind=WP) :: dz_trr(mesh%nl), dz_trr2(mesh%nl), bvfreq2(mesh%nl), vflux, dz_el, aux, cflfac + real(kind=WP) :: grad_v0Eiw(2), deltaX1, deltaY1, deltaX2, deltaY2 + real(kind=WP) :: tsum1, tsum2, tsum3, tsum4, tvol + real(kind=WP) :: cn, cn_e, cn_gradx_e, cn_grady_e + logical :: debug=.false. + +#include "../associate_part_def.h"omega_M2 +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + ! nils + !tstep_count = tstep_count + 1 + node_size = myDim_nod2D + elem_size = myDim_elem2D + + !_______________________________________________________________________ + ! compute baroclinic gravity wave speed + do node=1, node_size + nln = mesh%nl + uln = 1 + do nz=1, nod_in_elem2D_num(node) + nln=min(nln, nlevels(nod_in_elem2D(nz, node))) + uln=max(uln, ulevels(nod_in_elem2D(nz, node))) + end do + cn=0.0_WP + do nz=uln, nln-1 + cn=cn+hnode_new(nz,node)*(sqrt(max(bvfreq(nz,node), 0._WP))+sqrt(max(bvfreq(nz+1,node), 0._WP)))/2._WP + end do + iwe2_cn(node)=cn/pi + end do + call exchange_elem(iwe2_cn, partit) + + + !_______________________________________________________________________ + do elem = 1,elem_size + nln = nlevels(elem)-1 + uln = ulevels(elem) + elnodes1 = elem2d_nodes(:,elem) + + !___________________________________________________________________ + ! calculate for TKE square of Brünt-Väisälä frequency, be aware that + ! bvfreq contains already the squared brünt Väisälä frequency ... + bvfreq2 = 0.0_WP + do nz= uln, nln+1 + bvfreq2(nz) = sum(bvfreq(nz,elnodes1))/3.0_WP + end do + + !___________________________________________________________________ + ! dz_trr distance between tracer points, surface and bottom dz_trr is half + ! the layerthickness ... + dz_trr = 0.0_WP + dz_trr(uln+1:nln)= helem(uln:nln-1,elem)*0.5_WP + helem(uln+1:nln,elem)*0.5_WP + dz_trr(uln) = helem(uln,elem)*0.5_WP + dz_trr(nln+1) = helem(nln,elem)*0.5_WP + + !___________________________________________________________________ + ! compute baroclionic gravity wave speed on elements + cn_e = sum(iwe2_cn(elnodes1))/3.0 + + ! compute gradient of baroclionic gkdot_x_M2 = sqrt(fxa)/omega_M2*cn_gradxravity wave speed on elements + cn_gradx_e = sum(gradient_sca(1:3,elem)*iwe2_cn(elnodes1)) + cn_grady_e = sum(gradient_sca(4:6,elem)*iwe2_cn(elnodes1)) + + !___________________________________________________________________ + ! compute 1st. idemix2 parameter over the vertical water column and + ! local horizontal parameters on elements !!!: + ! IN VARIABLES: + ! -------------- + ! nlev ... number of mid-depth levels + ! nfbin ... number of spectral bins used for the M2 tidal and + ! near-inertial wave (niw) + ! dtime ... time step + ! coriolis ... coriolis parameter + ! grady_coriol ... lat gradient of coriolis paramter + ! coslat ... cosine of latitude @elem + ! Nsqr ... squared buoyancy frequency + ! omega_M2 ... M2 frequency (fixed) + ! omega_niw ... NIW frequency (lat dependent) + ! cn ... baroclionic gravity wave speed + ! cn_gradx ... zonal gradient of baroclionic gravity wave speed + ! cn_grady ... merid gradient of baroclionic gravity wave speed + ! phit ... edge of the k-th spectral bin + ! phiu ... center of the k-th spectral bin + ! + ! OUT VARIABLES: + ! -------------- + ! alpha_c ... 3d enery dissipation coefficient + ! c0 ... 3d horizontal group velocities (m/s) for the continuous + ! z internal wave spectrum + ! v0 ... 3d vertical group velocities (m/s) for the continuous + ! internal wave spectrum + ! cg_M2 ... 2d group velocity of M2 internal tidal waves + ! cg_niw ... 2d group velocity of near-inertial waves (NIW) + ! u_M2 ... zonal component of M2 internal tide group velocity + ! v_M2 ... meridional component of M2 internal tide group velocity + ! w_M2 ... vertical component of M2 internal tide group velocity + ! u_niw ... zonal component of NIW internal group velocity + ! v_niw ... meridional component of NIW internal group velocity + ! w_niw ... vertical component of NIW internal group velocity + call cvmix_compute_groupvel_idemix2( & + nlev = nln-uln+1 , & !IN + nfbin = idemix2_nfbin , & !IN + dtime = dt , & !IN + coriolis = mesh%coriolis( elem) , & !IN + grady_coriol= iwe2_grady_coriol( elem) , & !IN + coslat = mesh%elem_cos( elem) , & !IN + Nsqr = bvfreq2( uln:nln ) , & !IN + omega_M2 = iwe2_omega_M2 , & !IN + omega_niw = iwe2_omega_niw( elem) , & !IN + cn = cn_e , & !IN + cn_gradx = cn_gradx_e , & !IN + cn_grady = cn_grady_e , & !IN + phit = iwe2_phit , & !IN + phiu = iwe2_phiu , & !IN + alpha_c = iwe2_alpha_c(uln:nln, elem) , & !OUT + c0 = iwe2_c0( uln:nln, elem) , & !OUT + v0 = iwe2_v0( uln:nln, elem) , & !OUT + cg_M2 = iwe2_cg_M2( elem) , & !OUT + cg_niw = iwe2_cg_niw( elem) , & !OUT + u_M2 = iwe2_M2_u( :, elem) , & !OUT + v_M2 = iwe2_M2_v( :, elem) , & !OUT + w_M2 = iwe2_M2_w( :, elem) , & !OUT + u_niw = iwe2_niw_u( :, elem) , & !OUT + v_niw = iwe2_niw_v( :, elem) , & !OUT + w_niw = iwe2_niw_w( :, elem) & !OUT + ) + !___________________________________________________________________ + end do ! --> do elem = 1,elem_size + + end subroutine calc_cvmix_idemix2 + +end module g_cvmix_idemix2 \ No newline at end of file diff --git a/src/cvmix_driver/gen_modules_cvmix_tke.F90 b/src/cvmix_driver/gen_modules_cvmix_tke.F90 index 44bdf6866..bcc7d549c 100644 --- a/src/cvmix_driver/gen_modules_cvmix_tke.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_tke.F90 @@ -20,6 +20,7 @@ module g_cvmix_tke use cvmix_put_get, only: cvmix_put use cvmix_kinds_and_types use g_cvmix_idemix, only: iwe_n, iwe_Tdis_n, iwe_alpha_c_n + use g_cvmix_idemix2, only: iwe2_n, iwe2_Tdis_n, iwe2_alpha_c_n !___________________________________________________________________________ ! module calls from FESOM diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 40a7046c2..604961e08 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -174,6 +174,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) #if defined (__cvmix) use g_cvmix_tke use g_cvmix_idemix + use g_cvmix_idemix2 use g_cvmix_kpp use g_cvmix_tidal #endif diff --git a/src/io_restart.F90 b/src/io_restart.F90 index b7707d087..e0659600e 100644 --- a/src/io_restart.F90 +++ b/src/io_restart.F90 @@ -19,6 +19,7 @@ MODULE io_RESTART #if defined (__cvmix) use g_cvmix_tke use g_cvmix_idemix + use g_cvmix_idemix2 #endif #if defined(__recom) use recom_glovar diff --git a/src/oce_ale.F90 b/src/oce_ale.F90 index b86c7a87f..4cac8ceeb 100644 --- a/src/oce_ale.F90 +++ b/src/oce_ale.F90 @@ -3327,6 +3327,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) #if defined (__cvmix) use g_cvmix_tke use g_cvmix_idemix + use g_cvmix_idemix2 use g_cvmix_pp use g_cvmix_kpp use g_cvmix_tidal diff --git a/src/oce_setup_step.F90 b/src/oce_setup_step.F90 index 18900f749..4eae6fe11 100755 --- a/src/oce_setup_step.F90 +++ b/src/oce_setup_step.F90 @@ -88,6 +88,7 @@ subroutine ocean_setup(dynamics, tracers, partit, mesh) #if defined (__cvmix) use g_cvmix_tke use g_cvmix_idemix + use g_cvmix_idemix2 use g_cvmix_pp use g_cvmix_kpp use g_cvmix_tidal @@ -143,19 +144,21 @@ subroutine ocean_setup(dynamics, tracers, partit, mesh) ! here translate mix_scheme string into integer --> for later usage only ! integer comparison is required select case (trim(mix_scheme)) - case ('KPP' ) ; mix_scheme_nmb = 1 - case ('PP' ) ; mix_scheme_nmb = 2 + case ('KPP' ) ; mix_scheme_nmb = 1 + case ('PP' ) ; mix_scheme_nmb = 2 #if defined (__cvmix) - case ('cvmix_KPP' ) ; mix_scheme_nmb = 3 - case ('cvmix_PP' ) ; mix_scheme_nmb = 4 - case ('cvmix_TKE' ) ; mix_scheme_nmb = 5 - case ('cvmix_IDEMIX' ) ; mix_scheme_nmb = 6 - case ('cvmix_TIDAL' ) ; mix_scheme_nmb = 7 - case ('KPP+cvmix_TIDAL' ) ; mix_scheme_nmb = 17 - case ('PP+cvmix_TIDAL' ) ; mix_scheme_nmb = 27 - case ('cvmix_KPP+cvmix_TIDAL' ) ; mix_scheme_nmb = 37 - case ('cvmix_PP+cvmix_TIDAL' ) ; mix_scheme_nmb = 47 - case ('cvmix_TKE+cvmix_IDEMIX') ; mix_scheme_nmb = 56 + case ('cvmix_KPP' ) ; mix_scheme_nmb = 3 + case ('cvmix_PP' ) ; mix_scheme_nmb = 4 + case ('cvmix_TKE' ) ; mix_scheme_nmb = 5 + case ('cvmix_IDEMIX' ) ; mix_scheme_nmb = 6 + case ('cvmix_IDEMIX2' ) ; mix_scheme_nmb = 7 + case ('cvmix_TIDAL' ) ; mix_scheme_nmb = 8 + case ('KPP+cvmix_TIDAL' ) ; mix_scheme_nmb = 17 + case ('PP+cvmix_TIDAL' ) ; mix_scheme_nmb = 27 + case ('cvmix_KPP+cvmix_TIDAL' ) ; mix_scheme_nmb = 37 + case ('cvmix_PP+cvmix_TIDAL' ) ; mix_scheme_nmb = 48 + case ('cvmix_TKE+cvmix_IDEMIX' ) ; mix_scheme_nmb = 56 + case ('cvmix_TKE+cvmix_IDEMIX2') ; mix_scheme_nmb = 57 #endif case default stop "!not existing mixing scheme!" @@ -176,12 +179,12 @@ subroutine ocean_setup(dynamics, tracers, partit, mesh) call init_cvmix_kpp(partit, mesh) ! initialise cvmix_PP - elseif (mix_scheme_nmb==4 .or. mix_scheme_nmb==47) then + elseif (mix_scheme_nmb==4 .or. mix_scheme_nmb==48) then if (flag_debug .and. partit%mype==0) print *, achar(27)//'[36m'//' --> call init_cvmix_pp'//achar(27)//'[0m' call init_cvmix_pp(partit, mesh) ! initialise cvmix_TKE - elseif (mix_scheme_nmb==5 .or. mix_scheme_nmb==56) then + elseif (mix_scheme_nmb==5 .or. mix_scheme_nmb==56 .or. mix_scheme_nmb==57) then if (flag_debug .and. partit%mype==0) print *, achar(27)//'[36m'//' --> call init_cvmix_tke'//achar(27)//'[0m' call init_cvmix_tke(partit, mesh) #endif @@ -193,11 +196,17 @@ subroutine ocean_setup(dynamics, tracers, partit, mesh) if (mod(mix_scheme_nmb,10)==6) then if (flag_debug .and. partit%mype==0) print *, achar(27)//'[36m'//' --> call init_cvmix_idemix'//achar(27)//'[0m' call init_cvmix_idemix(partit, mesh) + + ! initialise additional mixing cvmix_IDEMIX2 --> only in combination with + ! cvmix_TKE+cvmix_IDEMIX2 or stand alone for debbuging as cvmix_TKE + elseif (mod(mix_scheme_nmb,10)==7) then + if (flag_debug .and. partit%mype==0) print *, achar(27)//'[36m'//' --> call init_cvmix_idemix2'//achar(27)//'[0m' + call init_cvmix_idemix2(partit, mesh) ! initialise additional mixing cvmix_TIDAL --> only in combination with ! KPP+cvmix_TIDAL, PP+cvmix_TIDAL, cvmix_KPP+cvmix_TIDAL, cvmix_PP+cvmix_TIDAL ! or stand alone for debbuging as cvmix_TIDAL - elseif (mod(mix_scheme_nmb,10)==7) then + elseif (mod(mix_scheme_nmb,10)==8) then if (flag_debug .and. partit%mype==0) print *, achar(27)//'[36m'//' --> call init_cvmix_tidal'//achar(27)//'[0m' call init_cvmix_tidal(partit, mesh) end if From b0c0d51bce2fedfc8e770f86d6ced93f5754f5eb Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 2 Feb 2026 12:21:17 +0100 Subject: [PATCH 02/63] add module to compute the distance of every points to the closest coastal point --- src/gen_modules_dist2coast.F90 | 344 +++++++++++++++++++++++++++++++++ 1 file changed, 344 insertions(+) create mode 100644 src/gen_modules_dist2coast.F90 diff --git a/src/gen_modules_dist2coast.F90 b/src/gen_modules_dist2coast.F90 new file mode 100644 index 000000000..137f4ae30 --- /dev/null +++ b/src/gen_modules_dist2coast.F90 @@ -0,0 +1,344 @@ +module dist2coast + !___________________________________________________________________________ + use MOD_MESH + use MOD_PARTIT + use MOD_PARSUP + use o_param + use o_arrays + use g_comm_auto + implicit none + private + public :: find_coast_pnts, build_coast_bins, nearest_coast_dist, compute_dist2coast + + !___________________________________________________________________________ + contains + + ! + ! + !___________________________________________________________________________ + subroutine compute_dist2coast(dist, mesh, partit) + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_mesh) , intent(inout), target :: mesh + type(t_partit), intent(inout), target :: partit + real(kind=WP) , intent(out ), allocatable :: dist(:) + !___LOCAL VARIABLES_____________________________________________________ + real(kind=WP) , allocatable :: coast_lon(:), coast_lat(:) + integer :: n_coast + real(kind=WP) :: bin_dlon=10.0, bin_dlat=10.0 + integer , allocatable :: bin_head(:,:), bin_next(:), visited(:,:) + integer :: bin_nlon, bin_nlat, vis_stamp + integer :: elem, elnodes(3) + real(kind=WP) :: lon_e_deg, lat_e_deg + + ! find all coastal points across all partitions and combine them in + ! lon/lat array that is known to all partitions + call find_coast_pnts(coast_lon, coast_lat, n_coast, mesh, partit) + + ! build coastal binning array with a linked list of all coastal points + ! within a list so that we do not need to loop everytime over all coastal + ! points to compute the distance + call build_coast_bins(coast_lon, coast_lat , & + bin_dlon, bin_dlat , & + bin_nlon, bin_nlat , & + bin_head, bin_next) + + ! i do this here with visited and vis_stamp to skip the initialisation + ! that would be neccessary if i would use a logical array for visited + ! each elem iteration i would needto reset it with false + allocate(visited(bin_nlon, bin_nlat)) + visited = 0 + vis_stamp = 0 + + ! compute distance for each local elem point to the coastline + allocate(dist(partit%myDim_elem2D)) + dist = 0.0_WP + + do elem = 1, partit%myDim_elem2D + vis_stamp = vis_stamp + 1 + + elnodes = mesh%elem2d_nodes(:,elem) + lon_e_deg = sum(mesh%geo_coord_nod2D(1,elnodes))/3.0 / rad + lat_e_deg = sum(mesh%geo_coord_nod2D(2,elnodes))/3.0 / rad + + call nearest_coast_dist(lon_e_deg, lat_e_deg, & + coast_lon, coast_lat, & + bin_dlon, bin_dlat, bin_head, bin_next, & + visited, vis_stamp, & + dist(elem)) + end do ! --> do elem = 1, partit%myDim_elem2D + + deallocate(bin_head, bin_next) + deallocate(coast_lon, coast_lat) + deallocate(visited) + + end subroutine compute_dist2coast + + + + ! + ! + !___________________________________________________________________________ + ! create array with all coastal lon/lat coordinate points. This array has to be + ! visible to all partitions is need to compute smallest distance of every vertice + ! with respect to the coast + ! coast_lon/lat only needed for distance computation will be deallocated + ! immediately after + subroutine find_coast_pnts(coast_lon, coast_lat, n_coast, mesh, partit) + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_mesh) , intent(inout), target :: mesh + type(t_partit), intent(inout), target :: partit + real(kind=WP) , intent(out) , allocatable :: coast_lon(:), coast_lat(:) + integer , intent(out) :: n_coast + !___LOCAL VARIABLES_____________________________________________________ + integer :: pi, edge, ednodes(2), lcl_n_coast + real(kind=WP), allocatable :: lcl_coast_lon(:), lcl_coast_lat(:) + logical, allocatable :: lcl_coast_isT(:) + integer, allocatable :: all_counts(:), all_displs(:) + + ! Identify local coastal vertices + allocate(lcl_coast_isT(partit%myDim_nod2D)) + lcl_coast_isT = .false. + do edge = 1, partit%myDim_edge2D + ednodes = mesh%edges(:, edge) + ! Check if this is a boundary edge + if (partit%myList_edge2D(edge) > mesh%edge2D_in) then ! boundary edge + lcl_coast_isT(ednodes(1)) = .true. + lcl_coast_isT(ednodes(2)) = .true. + end if + end do + + ! How many coastal boundary point are in this partition + lcl_n_coast = COUNT(lcl_coast_isT) + + ! Determine coordiantes of local coastal points + if (lcl_n_coast > 0) THEN + allocate(lcl_coast_lon(lcl_n_coast)) + allocate(lcl_coast_lat(lcl_n_coast)) + lcl_coast_lon = PACK(mesh%coord_nod2D(1,1:partit%myDim_nod2D), lcl_coast_isT) + lcl_coast_lat = PACK(mesh%coord_nod2D(2,1:partit%myDim_nod2D), lcl_coast_isT) + else + allocate(lcl_coast_lon(0)) + allocate(lcl_coast_lat(0)) + end if + + ! Gather all counts from all processors into array + allocate(all_counts(partit%npes)) + call MPI_ALLGATHER(lcl_n_coast, 1, MPI_INTEGER, all_counts, 1, MPI_INTEGER, & + partit%MPI_COMM_FESOM, partit%MPIERR) + + ! Calculate displacements across processors + allocate(all_displs(partit%npes)) + all_displs(1) = 0 + DO pi = 2, partit%npes + all_displs(pi) = all_displs(pi-1) + all_counts(pi-1) + ENDDO + + ! Total number of all coastal points + n_coast = sum(all_counts) + + ! Gather all coastal coordinates + allocate(coast_lon(n_coast)) + allocate(coast_lat(n_coast)) + call MPI_ALLGATHERV(lcl_coast_lon, lcl_n_coast, MPI_DOUBLE_PRECISION, & + coast_lon, all_counts, all_displs, & + MPI_DOUBLE_PRECISION, partit%MPI_COMM_FESOM, partit%MPIERR) + + call MPI_ALLGATHERV(lcl_coast_lat, lcl_n_coast, MPI_DOUBLE_PRECISION, & + coast_lat, all_counts, all_displs, & + MPI_DOUBLE_PRECISION, partit%MPI_COMM_FESOM, partit%MPIERR) + + !_______________________________________________________________________ + deallocate(lcl_coast_isT, lcl_coast_lon, lcl_coast_lat) + deallocate(all_counts, all_displs) + + end subroutine find_coast_pnts + + + + ! + ! + !___________________________________________________________________________ + ! Build bin linked-lists for coastal points + ! Inputs: coast_lon/coast_lat (degrees), dlon/dlat (degrees) + ! Outputs: + ! nlon,nlat, head(nlon,nlat), next(ncoast) + subroutine build_coast_bins(coast_lon, coast_lat, dlon, dlat, nlon, nlat, head, next) + !___INPUT/OUTPUT VARIABLES______________________________________________ + real(WP), intent(in) :: coast_lon(:), coast_lat(:) + real(WP), intent(in) :: dlon, dlat + integer, intent(out) :: nlon, nlat + integer, intent(out), allocatable :: head(:,:), next(:) + !___LOCAL VARIABLES_____________________________________________________ + integer :: ci, loni, lati, ncoast + + ! number of coastal points + ncoast = size(coast_lon) + + ! number of lon/lat points depending on binning resolution + nlon = int(360.0_WP/dlon) + nlat = int(180.0_WP/dlat) + if (nlon < 1) nlon = 1 + if (nlat < 1) nlat = 1 + + ! allocate fields for linked list + allocate(head(nlon, nlat)) + allocate(next(ncoast)) + head = 0 + next = 0 + + ! fill linked list head and next array with indices, How does it work: + ! next array has length number of coastal point, a next array indices position + ! next(i) contains the index of the next point in coast_lon/coast_lat + ! head(ib,jb) contains only the starting index from the list from which you + ! then proceed to next --> to next --> to next index until you reach next(i)=0 + ! which is the end of the list at this bin location + do ci = 1, ncoast + loni = lon_bin(coast_lon(ci), dlon, nlon) + lati = lat_bin(coast_lat(ci), dlat, nlat) + next(ci) = head(loni, lati) + head(loni, lati) = ci + end do + end subroutine build_coast_bins + + ! + ! + !___________________________________________________________________________ + ! pure declares a Fortran procedure as side-effect free: it cannot modify global + ! data or perform I/O and depends only on its arguments. It guarantees that + ! the same inputs always produce the same output (its rekursive). This makes + ! the procedure thread-safe and safe for use in DO CONCURRENT and parallel regions. + ! While it doesn’t make the function itself faster, it enables safer optimization + ! and vectorization. + pure integer function lon_bin(lon, dlon, nlon) result(ib) + real(WP), intent(in) :: lon, dlon + integer, intent(in) :: nlon + real(WP) :: l + l = wrap_lon(lon) + ib = int((l + 180.0_WP) / dlon) + 1 + if (ib < 1) ib = 1 + if (ib > nlon) ib = nlon + end function lon_bin + + + + ! + ! + !___________________________________________________________________________ + pure integer function lat_bin(lat, dlat, nlat) result(jb) + real(WP), intent(in) :: lat, dlat + integer, intent(in) :: nlat + real(WP) :: a + a = max(-90.0_WP, min(90.0_WP, lat)) + jb = int((a + 90.0_WP) / dlat) + 1 + if (jb < 1) jb = 1 + if (jb > nlat) jb = nlat + end function lat_bin + + + + ! + ! + !___________________________________________________________________________ + pure real(WP) function wrap_lon(lon) result(lw) + real(WP), intent(in) :: lon ! degrees, any range + lw = modulo(lon + 180.0_WP, 360.0_WP) - 180.0_WP + end function wrap_lon + + + + ! + ! + !___________________________________________________________________________ + ! Find nearest coastal distance for one vertex by expanding bin rings + ! If your bins are too fine, remote ocean expands r a bit until it finds coast. + subroutine nearest_coast_dist(vlon, vlat, coast_lon, coast_lat, dlon, dlat, & + head, next, visited, vis_stamp, dist) + !___INPUT/OUTPUT VARIABLES______________________________________________ + real(WP), intent(in) :: vlon, vlat + real(WP), intent(in) :: coast_lon(:), coast_lat(:) + real(WP), intent(in) :: dlon, dlat + integer, intent(in) :: head(:,:), next(:) + integer, intent(inout):: visited(:,:), vis_stamp + real(WP), intent(out) :: dist + !___LOCAL VARIABLES_____________________________________________________ + integer :: nlon, nlat, lati0, loni0, r, loni, lati, idx, ii + real(WP) :: d, best + + ! number of lon/lat bins + nlon = size(head, 1) + nlat = size(head, 2) + + ! vlon, vlat are the coordinates of the reference points for which we want + ! to compute the smallest distance to the coast line + loni0 = lon_bin(vlon, dlon, nlon) + lati0 = lat_bin(vlat, dlat, nlat) + + ! returning huge number best=1.7977E+308 + best = huge(1.0_WP) + + ! Expand rings r = 0,1,2,... until we have a candidate and further rings + ! cannot beat current best (simple conservative stop rule). + ! scan through concentric index rings around index location of reverence + ! point + do r = 0, max(nlon, nlat) + ! Scan all bins in the (2r+1)x(2r+1) neighborhood. + do lati = max(1, lati0-r), min(nlat, lati0+r) + do ii = -r, r + ! wrap longitude bins cyclically + loni = loni0 + ii + if (loni < 1) loni = loni + nlon + if (loni > nlon) loni = loni - nlon + + ! only scan the outer ring don't double the scanning of the inner rings + if (visited(loni,lati) == vis_stamp) cycle + visited(loni,lati) = vis_stamp + + idx = head(loni, lati) + + do while (idx /= 0) + d = haversine_m(vlon, vlat, coast_lon(idx), coast_lat(idx)) + if (d < best) best = d + idx = next(idx) + end do + end do !--> do ii = -r, r + end do ! --> lati = max(1, lati0-r), min(nlat, lati0+r) + + if (best < huge(1.0_WP)) then + ! Conservative early stop: + ! Minimum possible distance to points beyond this ring is at least ~ r*min(dlon,dlat) degrees. + ! If that exceeds best, stop. + !if ( (real(r+1,WP) * min(dlon*cos(vlat*rad),dlat) * rad * r_earth) > best ) exit + if ( (real(r+1,WP) * dlat * rad * r_earth) > best ) exit + end if + end do ! --> do r = 0, max(nlon, nlat) + + dist = best + end subroutine nearest_coast_dist + + + ! + ! + !___________________________________________________________________________ + ! computes the great-circle distance between two lon/lat points on a sphere (Earth), + ! using the haversine formula, and returns the distance in meters. + pure real(WP) function haversine_m(lon1, lat1, lon2, lat2) result(d) + real(WP), intent(in) :: lon1, lat1, lon2, lat2 ! degrees + real(WP) :: phi1, phi2, dlam, dphi, a + phi1 = lat1*rad + phi2 = lat2*rad + dphi = (lat2 - lat1)*rad + dlam = (wrap_lon(lon2 - lon1))*rad + + ! The standard haversine expression: + ! a=sin⁡2(dphi/2)+cos⁡(phi1)cos⁡(phi2)sin⁡2(dlam/2) + ! where phi is latitude, lam is longitude. + a = sin(dphi*0.5_WP)**2 + cos(phi1)*cos(phi2)*sin(dlam*0.5_WP)**2 + + ! central angle is: c=2arcsin⁡(a) + ! then distance on a sphere is: d=R⋅c + d = 2.0_WP*r_earth*asin(min(1.0_WP, sqrt(a))) + + end function haversine_m + + +end module dist2coast \ No newline at end of file From d12fbe18073db1c56d55162310dd8e2182832b0c Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 5 Feb 2026 19:05:32 +0100 Subject: [PATCH 03/63] finish and test module to compute distance from coast for elements and vertices --- src/gen_modules_dist2coast.F90 | 413 +++++++++++++++++++++++---------- 1 file changed, 295 insertions(+), 118 deletions(-) diff --git a/src/gen_modules_dist2coast.F90 b/src/gen_modules_dist2coast.F90 index 137f4ae30..ce54b6cc8 100644 --- a/src/gen_modules_dist2coast.F90 +++ b/src/gen_modules_dist2coast.F90 @@ -1,75 +1,171 @@ -module dist2coast +module g_dist2coast !___________________________________________________________________________ use MOD_MESH use MOD_PARTIT use MOD_PARSUP + use g_config, only: flag_debug, cyclic_length use o_param use o_arrays use g_comm_auto + use, intrinsic :: iso_fortran_env, only: real32, real64 implicit none private public :: find_coast_pnts, build_coast_bins, nearest_coast_dist, compute_dist2coast + interface allgatherv_coast + module procedure allgatherv_coast_real4 + module procedure allgatherv_coast_real8 + end interface + !___________________________________________________________________________ contains - + ! ! !___________________________________________________________________________ - subroutine compute_dist2coast(dist, mesh, partit) + ! compute distance in [m] for each elemental surface points to the closest + ! coastal point across partition domains + subroutine compute_dist2coast(dist, mesh, partit, modein) !___INPUT/OUTPUT VARIABLES______________________________________________ - type(t_mesh) , intent(inout), target :: mesh - type(t_partit), intent(inout), target :: partit - real(kind=WP) , intent(out ), allocatable :: dist(:) + real(kind=WP) , intent(inout) :: dist(:) + type(t_mesh) , intent(in) , target :: mesh + type(t_partit) , intent(inout), target :: partit + character(len=*), intent(in), optional :: modein !___LOCAL VARIABLES_____________________________________________________ real(kind=WP) , allocatable :: coast_lon(:), coast_lat(:) integer :: n_coast - real(kind=WP) :: bin_dlon=10.0, bin_dlat=10.0 - integer , allocatable :: bin_head(:,:), bin_next(:), visited(:,:) - integer :: bin_nlon, bin_nlat, vis_stamp - integer :: elem, elnodes(3) - real(kind=WP) :: lon_e_deg, lat_e_deg + real(kind=WP) :: bin_dlon=10.0*rad, bin_dlat=10.0*rad + integer , allocatable :: bin_head(:,:), bin_next(:) + integer :: bin_nlon, bin_nlat + integer :: elem, node, elnodes(3) + real(kind=WP) :: lon_e, lat_e, lonr(3), xmin + character(len=10) :: mode + real(kind=WP) :: t0, t1, t2, t3 + !_______________________________________________________________________ + mode = 'elem' + if (present(modein)) mode=trim(modein) + if (partit%mype==0 .and. (trim(mode) .eq. 'elem')) then + write(*,*) ' └> compute dist2coast for elements' + elseif (partit%mype==0 .and. (trim(mode) .eq. 'node')) then + write(*,*) ' └> compute dist2coast for vertices' + end if + + !_______________________________________________________________________ ! find all coastal points across all partitions and combine them in ! lon/lat array that is known to all partitions + if (flag_debug .and. partit%mype==0) print *, achar(27)//'[37m'//' --> call find_coast_pnts'//achar(27)//'[0m' + t0=MPI_Wtime() call find_coast_pnts(coast_lon, coast_lat, n_coast, mesh, partit) + !_______________________________________________________________________ ! build coastal binning array with a linked list of all coastal points ! within a list so that we do not need to loop everytime over all coastal ! points to compute the distance + if (flag_debug .and. partit%mype==0) print *, achar(27)//'[37m'//' --> call build_coast_bins'//achar(27)//'[0m' + t1=MPI_Wtime() call build_coast_bins(coast_lon, coast_lat , & - bin_dlon, bin_dlat , & - bin_nlon, bin_nlat , & - bin_head, bin_next) - - ! i do this here with visited and vis_stamp to skip the initialisation - ! that would be neccessary if i would use a logical array for visited - ! each elem iteration i would needto reset it with false - allocate(visited(bin_nlon, bin_nlat)) - visited = 0 - vis_stamp = 0 + bin_dlon , bin_dlat , & + bin_nlon , bin_nlat , & + bin_head , bin_next) + !_______________________________________________________________________ ! compute distance for each local elem point to the coastline - allocate(dist(partit%myDim_elem2D)) - dist = 0.0_WP - - do elem = 1, partit%myDim_elem2D - vis_stamp = vis_stamp + 1 + ! allocate(dist(partit%myDim_elem2D)) --> dist should be allocated and + ! initialised outside + t2=MPI_Wtime() + if (trim(mode) .eq. 'elem') then + !___________________________________________________________________ + if ( .not. (size(dist) == partit%myDim_elem2D+partit%eDim_elem2D .or. & + size(dist) == partit%myDim_elem2D)) then + if (partit%mype==0) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: size(dist)=', size(dist), ' does not agree to element computation' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + end if + end if + + !___________________________________________________________________ + if (flag_debug .and. partit%mype==0) print *, achar(27)//'[37m'//' --> call nearest_coast_dist'//achar(27)//'[0m' + do elem = 1, partit%myDim_elem2D + elnodes = mesh%elem2d_nodes(:,elem) + lat_e = sum(mesh%geo_coord_nod2D(2,elnodes))/3.0_WP + + ! do properly computing of elem centroid lon position across + ! periodic boundary + lonr = mesh%geo_coord_nod2D(1, elnodes) + xmin = minval(lonr) + do node=1,3 + if(lonr(node)-xmin>=cyclic_length/2.0_WP) lonr(node)=lonr(node)-cyclic_length + if(lonr(node)-xmin<-cyclic_length/2.0_WP) lonr(node)=lonr(node)+cyclic_length + end do + lon_e = sum(lonr)/3.0_WP + + ! compute elem centoid distance to nearest coast line point + call nearest_coast_dist(lon_e , lat_e , & + coast_lon, coast_lat , & + bin_dlon , bin_dlat , & + bin_head , bin_next , & + dist(elem)) + end do ! --> do elem = 1, partit%myDim_elem2D + + elseif (trim(mode) .eq. 'node') then + !___________________________________________________________________ + if ( .not. (size(dist) == partit%myDim_nod2D+partit%eDim_nod2D .or. & + size(dist) == partit%myDim_nod2D)) then + if (partit%mype==0) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: size(dist)=', size(dist), ' does not agree to vertice computation' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + end if + end if - elnodes = mesh%elem2d_nodes(:,elem) - lon_e_deg = sum(mesh%geo_coord_nod2D(1,elnodes))/3.0 / rad - lat_e_deg = sum(mesh%geo_coord_nod2D(2,elnodes))/3.0 / rad - - call nearest_coast_dist(lon_e_deg, lat_e_deg, & - coast_lon, coast_lat, & - bin_dlon, bin_dlat, bin_head, bin_next, & - visited, vis_stamp, & - dist(elem)) - end do ! --> do elem = 1, partit%myDim_elem2D + !___________________________________________________________________ + if (flag_debug .and. partit%mype==0) print *, achar(27)//'[37m'//' --> call nearest_coast_dist'//achar(27)//'[0m' + do node = 1, partit%myDim_nod2D + lat_e = mesh%geo_coord_nod2D(2,node) ! convert in degree + + ! do properly computing of elem centroid lon position across + ! periodic boundary + lon_e = mesh%geo_coord_nod2D(1,node) ! convert in degree + + ! compute elem centoid distance to nearest coast line point + call nearest_coast_dist(lon_e , lat_e , & + coast_lon, coast_lat , & + bin_dlon , bin_dlat , & + bin_head , bin_next , & + dist(node)) + end do ! --> do node = 1, partit%myDim_nod2D + + else + if (partit%mype==0) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: This mode=', trim(mode), ' is not supported when computing distance ' + write(*,*) ' to coast line.' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + end if + end if ! --> if (trim(mode) .eq. 'elem') then + t3=MPI_Wtime() + + !_______________________________________________________________________ + if (partit%mype==0) then + write(*,*) ' └> time find coast pnts:', t1-t0 + write(*,*) ' └> time build bins :', t2-t1 + write(*,*) ' └> time comp. dist :', t3-t2 + end if + !_______________________________________________________________________ deallocate(bin_head, bin_next) deallocate(coast_lon, coast_lat) - deallocate(visited) end subroutine compute_dist2coast @@ -85,12 +181,12 @@ end subroutine compute_dist2coast ! immediately after subroutine find_coast_pnts(coast_lon, coast_lat, n_coast, mesh, partit) !___INPUT/OUTPUT VARIABLES______________________________________________ - type(t_mesh) , intent(inout), target :: mesh + type(t_mesh) , intent(in) , target :: mesh type(t_partit), intent(inout), target :: partit real(kind=WP) , intent(out) , allocatable :: coast_lon(:), coast_lat(:) integer , intent(out) :: n_coast !___LOCAL VARIABLES_____________________________________________________ - integer :: pi, edge, ednodes(2), lcl_n_coast + integer :: p, edge, ednodes(2), lcl_n_coast, cnt real(kind=WP), allocatable :: lcl_coast_lon(:), lcl_coast_lat(:) logical, allocatable :: lcl_coast_isT(:) integer, allocatable :: all_counts(:), all_displs(:) @@ -99,53 +195,58 @@ subroutine find_coast_pnts(coast_lon, coast_lat, n_coast, mesh, partit) allocate(lcl_coast_isT(partit%myDim_nod2D)) lcl_coast_isT = .false. do edge = 1, partit%myDim_edge2D + if (partit%myList_edge2D(edge) <= mesh%edge2D_in) cycle ! boundary edge ednodes = mesh%edges(:, edge) ! Check if this is a boundary edge - if (partit%myList_edge2D(edge) > mesh%edge2D_in) then ! boundary edge - lcl_coast_isT(ednodes(1)) = .true. - lcl_coast_isT(ednodes(2)) = .true. - end if + if (ednodes(1)<=partit%myDim_nod2D) lcl_coast_isT(ednodes(1)) = .true. + if (ednodes(2)<=partit%myDim_nod2D) lcl_coast_isT(ednodes(2)) = .true. end do ! How many coastal boundary point are in this partition - lcl_n_coast = COUNT(lcl_coast_isT) + lcl_n_coast = 0 + do p = 1, partit%myDim_nod2D + if (lcl_coast_isT(p)) lcl_n_coast = lcl_n_coast+1 + end do ! Determine coordiantes of local coastal points if (lcl_n_coast > 0) THEN - allocate(lcl_coast_lon(lcl_n_coast)) - allocate(lcl_coast_lat(lcl_n_coast)) - lcl_coast_lon = PACK(mesh%coord_nod2D(1,1:partit%myDim_nod2D), lcl_coast_isT) - lcl_coast_lat = PACK(mesh%coord_nod2D(2,1:partit%myDim_nod2D), lcl_coast_isT) + allocate(lcl_coast_lon(lcl_n_coast), lcl_coast_lat(lcl_n_coast)) + cnt=1 + do p=1,partit%myDim_nod2D + if (lcl_coast_isT(p)) then + lcl_coast_lon(cnt)=mesh%geo_coord_nod2D(1,p) ! is in radian + lcl_coast_lat(cnt)=mesh%geo_coord_nod2D(2,p) ! is in radian + cnt=cnt+1 + end if + end do else - allocate(lcl_coast_lon(0)) - allocate(lcl_coast_lat(0)) + allocate(lcl_coast_lon(0), lcl_coast_lat(0)) end if ! Gather all counts from all processors into array allocate(all_counts(partit%npes)) + all_counts = 0 call MPI_ALLGATHER(lcl_n_coast, 1, MPI_INTEGER, all_counts, 1, MPI_INTEGER, & partit%MPI_COMM_FESOM, partit%MPIERR) ! Calculate displacements across processors allocate(all_displs(partit%npes)) - all_displs(1) = 0 - DO pi = 2, partit%npes - all_displs(pi) = all_displs(pi-1) + all_counts(pi-1) - ENDDO + all_displs=0 + do p = 2, partit%npes + all_displs(p) = all_displs(p-1) + all_counts(p -1) + end do ! Total number of all coastal points n_coast = sum(all_counts) - - ! Gather all coastal coordinates - allocate(coast_lon(n_coast)) - allocate(coast_lat(n_coast)) - call MPI_ALLGATHERV(lcl_coast_lon, lcl_n_coast, MPI_DOUBLE_PRECISION, & - coast_lon, all_counts, all_displs, & - MPI_DOUBLE_PRECISION, partit%MPI_COMM_FESOM, partit%MPIERR) - call MPI_ALLGATHERV(lcl_coast_lat, lcl_n_coast, MPI_DOUBLE_PRECISION, & - coast_lat, all_counts, all_displs, & - MPI_DOUBLE_PRECISION, partit%MPI_COMM_FESOM, partit%MPIERR) + ! Gather all coastal coordinates from all partitions + allocate(coast_lon(n_coast), coast_lat(n_coast)) + call allgatherv_coast(lcl_coast_lon, lcl_n_coast , & + coast_lon, all_counts, all_displs , & + partit) + call allgatherv_coast(lcl_coast_lat, lcl_n_coast , & + coast_lat, all_counts, all_displs , & + partit) !_______________________________________________________________________ deallocate(lcl_coast_isT, lcl_coast_lon, lcl_coast_lat) @@ -153,7 +254,34 @@ subroutine find_coast_pnts(coast_lon, coast_lat, n_coast, mesh, partit) end subroutine find_coast_pnts - + + + ! + ! + !___________________________________________________________________________ + ! make sure MPI_ALLGATHERV for all coastal points is precision selectiv by + ! its self through interface for the case WP is changed + subroutine allgatherv_coast_real8(send, sendcount, recv, counts, displs, partit) + real(real64) , intent(in) :: send(:) + real(real64) , intent(out) :: recv(:) + integer , intent(in) :: sendcount, counts(:), displs(:) + type(t_partit), intent(inout), target :: partit + call MPI_ALLGATHERV(send, sendcount, MPI_DOUBLE_PRECISION , & + recv, counts, displs, MPI_DOUBLE_PRECISION , & + partit%MPI_COMM_FESOM, partit%MPIERR) + end subroutine allgatherv_coast_real8 + + subroutine allgatherv_coast_real4(send, sendcount, recv, counts, displs, partit) + real(real32) , intent(in) :: send(:) + real(real32) , intent(out) :: recv(:) + integer , intent(in) :: sendcount, counts(:), displs(:) + type(t_partit), intent(inout), target :: partit + call MPI_ALLGATHERV(send, sendcount, MPI_REAL , & + recv, counts, displs, MPI_REAL , & + partit%MPI_COMM_FESOM, partit%MPIERR) + end subroutine allgatherv_coast_real4 + + ! ! @@ -175,8 +303,8 @@ subroutine build_coast_bins(coast_lon, coast_lat, dlon, dlat, nlon, nlat, head, ncoast = size(coast_lon) ! number of lon/lat points depending on binning resolution - nlon = int(360.0_WP/dlon) - nlat = int(180.0_WP/dlat) + nlon = int(2.0_WP*pi/dlon) + nlat = int( pi/dlat) if (nlon < 1) nlon = 1 if (nlat < 1) nlat = 1 @@ -193,13 +321,15 @@ subroutine build_coast_bins(coast_lon, coast_lat, dlon, dlat, nlon, nlat, head, ! then proceed to next --> to next --> to next index until you reach next(i)=0 ! which is the end of the list at this bin location do ci = 1, ncoast - loni = lon_bin(coast_lon(ci), dlon, nlon) - lati = lat_bin(coast_lat(ci), dlat, nlat) - next(ci) = head(loni, lati) + loni = lon_bin(coast_lon(ci), dlon, nlon) + lati = lat_bin(coast_lat(ci), dlat, nlat) + next(ci) = head(loni, lati) head(loni, lati) = ci end do end subroutine build_coast_bins + + ! ! !___________________________________________________________________________ @@ -214,7 +344,7 @@ pure integer function lon_bin(lon, dlon, nlon) result(ib) integer, intent(in) :: nlon real(WP) :: l l = wrap_lon(lon) - ib = int((l + 180.0_WP) / dlon) + 1 + ib = int((l + pi) / dlon) + 1 if (ib < 1) ib = 1 if (ib > nlon) ib = nlon end function lon_bin @@ -228,8 +358,8 @@ pure integer function lat_bin(lat, dlat, nlat) result(jb) real(WP), intent(in) :: lat, dlat integer, intent(in) :: nlat real(WP) :: a - a = max(-90.0_WP, min(90.0_WP, lat)) - jb = int((a + 90.0_WP) / dlat) + 1 + a = max(-0.5_WP*pi, min(0.5_WP*pi, lat)) + jb = int((a + 0.5_WP*pi) / dlat) + 1 if (jb < 1) jb = 1 if (jb > nlat) jb = nlat end function lat_bin @@ -241,7 +371,7 @@ end function lat_bin !___________________________________________________________________________ pure real(WP) function wrap_lon(lon) result(lw) real(WP), intent(in) :: lon ! degrees, any range - lw = modulo(lon + 180.0_WP, 360.0_WP) - 180.0_WP + lw = modulo(lon + pi, 2.0_WP*pi) - pi end function wrap_lon @@ -252,17 +382,16 @@ end function wrap_lon ! Find nearest coastal distance for one vertex by expanding bin rings ! If your bins are too fine, remote ocean expands r a bit until it finds coast. subroutine nearest_coast_dist(vlon, vlat, coast_lon, coast_lat, dlon, dlat, & - head, next, visited, vis_stamp, dist) + head, next, dist) !___INPUT/OUTPUT VARIABLES______________________________________________ real(WP), intent(in) :: vlon, vlat real(WP), intent(in) :: coast_lon(:), coast_lat(:) real(WP), intent(in) :: dlon, dlat integer, intent(in) :: head(:,:), next(:) - integer, intent(inout):: visited(:,:), vis_stamp real(WP), intent(out) :: dist !___LOCAL VARIABLES_____________________________________________________ - integer :: nlon, nlat, lati0, loni0, r, loni, lati, idx, ii - real(WP) :: d, best + integer :: nlon, nlat, lati0, loni0, r + real(WP) :: dist_best, minstep, cos_lat ! number of lon/lat bins nlon = size(head, 1) @@ -270,52 +399,103 @@ subroutine nearest_coast_dist(vlon, vlat, coast_lon, coast_lat, dlon, dlat, & ! vlon, vlat are the coordinates of the reference points for which we want ! to compute the smallest distance to the coast line - loni0 = lon_bin(vlon, dlon, nlon) - lati0 = lat_bin(vlat, dlat, nlat) + loni0 = lon_bin(vlon, dlon, nlon) + lati0 = lat_bin(vlat, dlat, nlat) + cos_lat = max(0.0_WP, cos(vlat)) + minstep = min(dlat, dlon*cos_lat) - ! returning huge number best=1.7977E+308 - best = huge(1.0_WP) + ! returning huge number dist_best=1.7977E+308 + dist_best = huge(1.0_WP) ! Expand rings r = 0,1,2,... until we have a candidate and further rings - ! cannot beat current best (simple conservative stop rule). + ! cannot beat current dist_best (simple conservative stop rule). ! scan through concentric index rings around index location of reverence ! point + ! r=0 r=1 r=2 + ! .-------. + ! .---. | | + ! # | # | | # | ... + ! `---´ | | + ! `-------´ + ! + ! do not rescan bins that already have been scanned scan only new outer + ! shell do r = 0, max(nlon, nlat) - ! Scan all bins in the (2r+1)x(2r+1) neighborhood. - do lati = max(1, lati0-r), min(nlat, lati0+r) - do ii = -r, r - ! wrap longitude bins cyclically - loni = loni0 + ii - if (loni < 1) loni = loni + nlon - if (loni > nlon) loni = loni - nlon - - ! only scan the outer ring don't double the scanning of the inner rings - if (visited(loni,lati) == vis_stamp) cycle - visited(loni,lati) = vis_stamp - + + ! top row + call scan_row(lati0+r, -r, r) + + if (r > 0) then + ! bottom row (avoid double count when r=0) + call scan_row(lati0-r, -r , r ) + + ! left/right columns excluding corners (already done by rows) + call scan_col(-r , lati0-r+1, lati0+r-1) + call scan_col( r , lati0-r+1, lati0+r-1) + end if + + ! Conservative early stop (safe globally): lon/lat spacing + ! do not accept center value r=0 as automatically being the best + if (dist_best < huge(1.0_WP) .and. r>0) then + if ( real(r,WP) * minstep * r_earth > dist_best ) exit + end if + + end do + dist = dist_best + + !_______________________________________________________________________ + contains + ! + !___________________________________________________________________ + ! make sure lon indices properly wrap across the periodic boiundary + pure integer function wrap_loni(i) result(iw) + integer, intent(in) :: i + iw = i + if (iw < 1) iw = iw + nlon + if (iw > nlon) iw = iw - nlon + end function wrap_loni + ! + !___________________________________________________________________ + ! scan outer row of binning shell with radius r + subroutine scan_row(lati, ii1, ii2) + integer, intent(in) :: lati, ii1, ii2 + integer :: ii, loni, idx + real(WP) :: d + if (lati < 1 .or. lati > nlat) return + + do ii = ii1, ii2 + loni = wrap_loni(loni0 + ii) + idx = head(loni, lati) + do while (idx /= 0) + d = haversine_m(vlon, vlat, coast_lon(idx), coast_lat(idx)) + if (d < dist_best) dist_best = d + idx = next(idx) + end do + end do + end subroutine scan_row + ! + !___________________________________________________________________ + ! scan outer column of binning shell with radius r + subroutine scan_col(ii, lat1, lat2) + integer, intent(in) :: ii, lat1, lat2 + integer :: lati, loni, idx + real(WP) :: d + loni = wrap_loni(loni0 + ii) + + do lati = max(1, lat1), min(nlat, lat2) idx = head(loni, lati) - do while (idx /= 0) d = haversine_m(vlon, vlat, coast_lon(idx), coast_lat(idx)) - if (d < best) best = d + if (d < dist_best) dist_best = d idx = next(idx) end do - end do !--> do ii = -r, r - end do ! --> lati = max(1, lati0-r), min(nlat, lati0+r) - - if (best < huge(1.0_WP)) then - ! Conservative early stop: - ! Minimum possible distance to points beyond this ring is at least ~ r*min(dlon,dlat) degrees. - ! If that exceeds best, stop. - !if ( (real(r+1,WP) * min(dlon*cos(vlat*rad),dlat) * rad * r_earth) > best ) exit - if ( (real(r+1,WP) * dlat * rad * r_earth) > best ) exit - end if - end do ! --> do r = 0, max(nlon, nlat) + end do + end subroutine scan_col - dist = best end subroutine nearest_coast_dist + ! ! !___________________________________________________________________________ @@ -323,22 +503,19 @@ end subroutine nearest_coast_dist ! using the haversine formula, and returns the distance in meters. pure real(WP) function haversine_m(lon1, lat1, lon2, lat2) result(d) real(WP), intent(in) :: lon1, lat1, lon2, lat2 ! degrees - real(WP) :: phi1, phi2, dlam, dphi, a - phi1 = lat1*rad - phi2 = lat2*rad - dphi = (lat2 - lat1)*rad - dlam = (wrap_lon(lon2 - lon1))*rad + real(WP) :: dlam, dphi, a + dphi = (lat2 - lat1) + dlam = (wrap_lon(lon2 - lon1)) ! The standard haversine expression: ! a=sin⁡2(dphi/2)+cos⁡(phi1)cos⁡(phi2)sin⁡2(dlam/2) ! where phi is latitude, lam is longitude. - a = sin(dphi*0.5_WP)**2 + cos(phi1)*cos(phi2)*sin(dlam*0.5_WP)**2 + a = sin(dphi*0.5_WP)**2 + cos(lat1)*cos(lat2)*sin(dlam*0.5_WP)**2 ! central angle is: c=2arcsin⁡(a) ! then distance on a sphere is: d=R⋅c d = 2.0_WP*r_earth*asin(min(1.0_WP, sqrt(a))) - end function haversine_m - + end function haversine_m -end module dist2coast \ No newline at end of file +end module g_dist2coast \ No newline at end of file From 3f0caf24f35c4789abe38a63f0af40d9fb80160b Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 5 Feb 2026 19:06:58 +0100 Subject: [PATCH 04/63] improve routine to read from netcdf with various checks and error messages if something is wrong in the forcing files --- src/gen_modules_read_NetCDF.F90 | 115 +++++++++++++++++++++++++++----- 1 file changed, 97 insertions(+), 18 deletions(-) diff --git a/src/gen_modules_read_NetCDF.F90 b/src/gen_modules_read_NetCDF.F90 index 8ab8b94fd..9263cf86f 100755 --- a/src/gen_modules_read_NetCDF.F90 +++ b/src/gen_modules_read_NetCDF.F90 @@ -45,8 +45,21 @@ subroutine read_other_NetCDF(file, vari, itime, model_2Darray, check_dummy, do_o if (mype==0) then - ! open file - status=nf90_open(file, nf90_nowrite, ncid) + ! open file + status=nf90_open(file, nf90_nowrite, ncid) + if (status /= nf90_noerr) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: File not found: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ', nf90_strerror(status) + write(*,*) ' └> check: namelist.*' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if end if call MPI_BCast(status, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) @@ -58,12 +71,39 @@ subroutine read_other_NetCDF(file, vari, itime, model_2Darray, check_dummy, do_o endif if (mype==0) then - ! lat - status=nf90_inq_dimid(ncid, 'lat', latid) - status=nf90_inquire_dimension(ncid, latid, len=latlen) - ! lon - status=nf90_inq_dimid(ncid, 'lon', lonid) - status=nf90_inquire_dimension(ncid, lonid, len=lonlen) + ! lat + status=nf90_inq_dimid(ncid, 'lat', latid) + if (status == NF90_EBADDIM) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Dimension lat not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lat' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + status=nf90_inquire_dimension(ncid, latid, len=latlen) + + ! lon + status=nf90_inq_dimid(ncid, 'lon', lonid) + if (status == NF90_EBADDIM) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Dimension lon not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lon' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + status=nf90_inquire_dimension(ncid, lonid, len=lonlen) end if call MPI_BCast(latlen, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) call MPI_BCast(lonlen, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) @@ -71,16 +111,42 @@ subroutine read_other_NetCDF(file, vari, itime, model_2Darray, check_dummy, do_o ! lat allocate(lat(latlen)) if (mype==0) then - status=nf90_inq_varid(ncid, 'lat', varid) - status=nf90_get_var(ncid, varid, lat, start=(/1/), count=(/latlen/)) + status=nf90_inq_varid(ncid, 'lat', varid) + if (status == NF90_ENOTVAR) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Variable lat not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lat' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + status=nf90_get_var(ncid, varid, lat, start=(/1/), count=(/latlen/)) end if call MPI_BCast(lat, latlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) ! lon allocate(lon(lonlen)) if (mype==0) then - status=nf90_inq_varid(ncid, 'lon', varid) - status=nf90_get_var(ncid, varid, lon, start=(/1/), count=(/lonlen/)) + status=nf90_inq_varid(ncid, 'lon', varid) + if (status == NF90_ENOTVAR) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Variable lon not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lon' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + status=nf90_get_var(ncid, varid, lon, start=(/1/), count=(/lonlen/)) end if call MPI_BCast(lon, lonlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) @@ -96,13 +162,26 @@ subroutine read_other_NetCDF(file, vari, itime, model_2Darray, check_dummy, do_o if (mype==0) then ! data - status=nf90_inq_varid(ncid, vari, varid) - istart = (/1,1,itime/) - icount= (/lonlen,latlen,1/) - status=nf90_get_var(ncid, varid, ncdata, start=istart, count=icount) + status=nf90_inq_varid(ncid, vari, varid) + if (status == NF90_ENOTVAR) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Variable ',vari,' not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: namelist.* ' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if + istart= (/1,1,itime/) + icount= (/lonlen,latlen,1/) + status=nf90_get_var(ncid, varid, ncdata, start=istart, count=icount) ! missing value - status= nf90_get_att(ncid, varid, 'missing_value', miss) + status= nf90_get_att(ncid, varid, 'missing_value', miss) ! close file status=nf90_close(ncid) end if @@ -176,7 +255,7 @@ subroutine read_other_NetCDF(file, vari, itime, model_2Darray, check_dummy, do_o !___________________________________________________________________________ ! do interpolation - flag=0 + flag=0 call interp_2d_field(lonlen, latlen, lon, lat, ncdata, num, temp_x, temp_y, & model_2Darray, flag, partit) deallocate(temp_y, temp_x, ncdata_temp, ncdata, lon, lat) From 36fd213a35e3bcda407cb7b19090cb576c92204d Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 5 Feb 2026 19:08:18 +0100 Subject: [PATCH 05/63] add idemix 2 option to oce_ale.F90 --- src/oce_ale.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/oce_ale.F90 b/src/oce_ale.F90 index 4cac8ceeb..7bf6244fb 100644 --- a/src/oce_ale.F90 +++ b/src/oce_ale.F90 @@ -3440,7 +3440,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) !___MAIN MIXING SCHEMES_____________________________________________________ ! use FESOM2.0 tuned k-profile parameterization for vertical mixing - if (mix_scheme_nmb==1 .or. mix_scheme_nmb==17) then + if (mix_scheme_nmb==1 .or. mix_scheme_nmb==18 ) then if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call oce_mixing_KPP'//achar(27)//'[0m' call oce_mixing_KPP(Av, Kv_double, dynamics, tracers, partit, mesh) !$OMP PARALLEL DO @@ -3453,13 +3453,13 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! use FESOM2.0 tuned pacanowski & philander parameterization for vertical ! mixing - else if(mix_scheme_nmb==2 .or. mix_scheme_nmb==27) then + else if(mix_scheme_nmb==2 .or. mix_scheme_nmb==28) then if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call oce_mixing_PP'//achar(27)//'[0m' call oce_mixing_PP(dynamics, partit, mesh) call mo_convect(ice, partit, mesh) #if defined (__cvmix) ! use CVMIX KPP (Large at al. 1994) - else if(mix_scheme_nmb==3 .or. mix_scheme_nmb==37) then + else if(mix_scheme_nmb==3 .or. mix_scheme_nmb==38) then if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call calc_cvmix_kpp'//achar(27)//'[0m' call calc_cvmix_kpp(ice, dynamics, tracers, partit, mesh) call mo_convect(ice, partit, mesh) @@ -3467,7 +3467,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! use CVMIX PP (Pacanowski and Philander 1981) parameterisation for mixing ! based on Richardson number Ri = N^2/(du/dz)^2, using Brunt Väisälä frequency ! N^2 and vertical horizontal velocity shear dui/dz - else if(mix_scheme_nmb==4 .or. mix_scheme_nmb==47) then + else if(mix_scheme_nmb==4 .or. mix_scheme_nmb==48) then if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call calc_cvmix_pp'//achar(27)//'[0m' call calc_cvmix_pp(dynamics, partit, mesh) call mo_convect(ice, partit, mesh) @@ -3476,7 +3476,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! vertical mixing with or without the IDEMIX (dissipation of energy by ! internal gravity waves) extension from Olbers and Eden, 2013, "A global ! Model for the diapycnal diffusivity induced by internal gravity waves" - else if(mix_scheme_nmb==5 .or. mix_scheme_nmb==56) then + else if(mix_scheme_nmb==5 .or. mix_scheme_nmb==56 .or. mix_scheme_nmb==57) then if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call calc_cvmix_tke'//achar(27)//'[0m' call calc_cvmix_tke(dynamics, partit, mesh) call mo_convect(ice, partit, mesh) @@ -3490,7 +3490,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! the already computed viscosities/diffusivities of KPP, PP, cvmix_KPP or ! cvmix_PP --> use standalone for debugging --> needs to be called after main ! mixing schemes - if ( mod(mix_scheme_nmb,10)==7) then + if ( mod(mix_scheme_nmb,10)==8) then if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call calc_cvmix_tidal'//achar(27)//'[0m' call calc_cvmix_tidal(partit, mesh) From 2931e05621048aaf2671f1f412b6f738e96976b7 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 5 Feb 2026 19:09:48 +0100 Subject: [PATCH 06/63] proceed with implementation of idemix2 --- src/cvmix_driver/cvmix_idemix2.F90 | 159 ++++++++-- .../gen_modules_cvmix_idemix2.F90 | 290 ++++++++++++------ src/io_meandata.F90 | 22 +- 3 files changed, 355 insertions(+), 116 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 8f1358738..24ba091a5 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -25,6 +25,7 @@ module cvmix_idemix2 !public member functions public :: cvmix_init_idemix2 public :: cvmix_compute_groupvel_idemix2 +public :: cvmix_compute_interact_tscale_idemix2 ! public :: calc_idemix2_v0 ! public :: cvmix_coeffs_idemix2 public :: gofx2, hofx1, hofx2 @@ -38,13 +39,17 @@ module cvmix_idemix2 ! end interface cvmix_coeffs_idemix2 interface cvmix_init_idemix2 - module procedure init_idemix2 + module procedure compute_init end interface cvmix_init_idemix2 interface cvmix_compute_groupvel_idemix2 - module procedure compute_groupvel_idemix2 + module procedure compute_groupvel end interface cvmix_compute_groupvel_idemix2 +interface cvmix_compute_interact_tscale_idemix2 + module procedure compute_interact_tscale +end interface cvmix_compute_interact_tscale_idemix2 + interface idemix2_put module procedure vmix_tke_put_idemix2_int module procedure vmix_tke_put_idemix2_real @@ -60,7 +65,8 @@ module cvmix_idemix2 tau_h , & ! time scale for horizontal symmetrisation, only necessary for lateral diffusion (sec) gamma , & ! constant of order one derived from the shape of the spectrum in m space (dimensionless) jstar , & ! spectral bandwidth in modes (dimensionless) - mu0 ! dissipation parameter (dimensionless) + mu0 , & ! dissipation parameter (dimensionless) + shelf_dist ! shelf definition in meters from coast logical :: & enable_M2 , & @@ -85,12 +91,13 @@ module cvmix_idemix2 ! ! !_______________________________________________________________________________ -subroutine init_idemix2(tau_v , & ! time scale for vertical symmetrisation +subroutine compute_init(tau_v , & ! time scale for vertical symmetrisation tau_h , & ! time scale for horizontal symmetrisation gamma , & ! const. derived from the shape of the spectrum in m spac jstar , & ! mode number scale mu0 , & ! dissipation parameter (dimensionless) nfbin , & ! number of spectral bins + shelf_dist , & ! shelf definition in meters from coast enable_M2 , & enable_niw , & enable_superbee_adv , & @@ -100,7 +107,7 @@ subroutine init_idemix2(tau_v , & ! time scale for vertical symmet handle_old_vals, idemix2_userdef_constants) ! This subroutine sets user or default values for IDEMIX parameters - real(cvmix_r8), optional, intent(in) :: tau_v, tau_h, gamma, jstar, mu0 + real(cvmix_r8), optional, intent(in) :: tau_v, tau_h, gamma, jstar, mu0, shelf_dist logical , optional, intent(in) :: enable_M2, enable_niw, & enable_superbee_adv, enable_AB_timestep, & enable_hor_diffusion @@ -165,6 +172,13 @@ subroutine init_idemix2(tau_v , & ! time scale for vertical symmet call idemix2_put('mu0', 4._cvmix_r8/3.0 , idemix2_userdef_constants) end if + !___ shelf_dist ____________________________________________________________ + if (present(shelf_dist)) then + call idemix2_put('shelf_dist', shelf_dist, idemix2_userdef_constants) + else + call idemix2_put('shelf_dist', 300000._cvmix_r8, idemix2_userdef_constants) + end if + !___ superbee_adv __________________________________________________________ if (present(nfbin)) then call idemix2_put('nfbin', nfbin, idemix2_userdef_constants) @@ -223,7 +237,7 @@ subroutine init_idemix2(tau_v , & ! time scale for vertical symmet else call idemix2_put('handle_old_vals', 1, idemix2_userdef_constants) end if -end subroutine init_idemix2 +end subroutine compute_init ! @@ -231,7 +245,7 @@ end subroutine init_idemix2 !_______________________________________________________________________________ ! Compute idemix representative vertical (v0) and horizontal (c0) group velocites ! as well as the enery dissipation coefficient alpha_c -subroutine compute_groupvel_idemix2(nlev , & +subroutine compute_groupvel(nlev , & nfbin , & dtime , & coriolis , & @@ -422,26 +436,120 @@ subroutine compute_groupvel_idemix2(nlev , & w_niw(fbin_i) = (kdot_y_niw*cos(phiu(fbin_i)) + kdot_x_niw*sin(phiu(fbin_i)) ) enddo end if -end subroutine compute_groupvel_idemix2 +end subroutine compute_groupvel -! ! -! ! -! !_______________________________________________________________________________ -! subroutine set_compute_groupvel_idemix2(dzt , & -! nlev , & -! dtime , & -! coriolis , & -! Nsqr , & -! omega_M2 , & -! omega_niw , & -! alpha_c , & -! c0 , & -! v0 , & -! idemix2_const_userdef & -! ) - - + +! +! +!_______________________________________________________________________________ +subroutine compute_interact_tscale(dtime , & + lat , & + coriolis , & + omega_M2 , & + omega_niw , & + cn , & + zbottom , & + topo_hrms , & + topo_hlam , & + topo_shelf , & + tau_M2 , & + tau_niw , & + alpha_M2_c , & + idemix2_const_userdef & + ) + !___Input___________________________________________________________________ + type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef + real(cvmix_r8) , intent(in) :: dtime , & + lat , & + coriolis , & + omega_M2 , & + omega_niw , & + cn , & + zbottom , & + topo_hrms , & + topo_hlam , & + topo_shelf + !___Output__________________________________________________________________ + real(cvmix_r8) , intent(out) :: tau_M2 , & + tau_niw , & + alpha_M2_c + !___Local___________________________________________________________________ + integer :: di, fbin_i, N0 + real(cvmix_r8) :: fxb, fxc + real(cvmix_r8) :: mstar=0.01 ,& + M2_f=2*cvmix_PI/(12.42*60*60) + type(idemix2_type), pointer :: idemix2_const_in + + ! do pointer into save variable or into user defined input variable + idemix2_const_in => idemix2_constants_saved + if (present(idemix2_const_userdef)) then + idemix2_const_in => idemix2_const_userdef + end if + + !___________________________________________________________________________ + ! compute NIW Dissipation Timescale + if (idemix2_const_in%enable_niw) then + if (zbottom>0) then + N0=cn*cvmix_PI/zbottom + if ( N0> abs(coriolis) .and. omega_niw> abs(coriolis) ) then + fxc = topo_hrms**2.0 * 2.0*cvmix_PI/(1d-12+topo_hlam) + fxb = 0.5* N0*( (omega_niw**2.0 + coriolis**2.0)/omega_niw**2.0 )**2.0 & + *(omega_niw**2.0 - coriolis**2.0)**0.5/omega_niw + tau_niw = min(0.5/dtime, fxc*fxb/zbottom) + endif + endif + + ! on shelf limitation + if (topo_shelf == 1.0) tau_niw = 1./(3.*86400.0) + tau_niw = max(1d0/(50.*86400.0), tau_niw ) + end if + + !___________________________________________________________________________ + ! compute tau_M2 M2 Tidal Dissipation Timescale + if (idemix2_const_in%enable_M2) then + if (zbottom>0) then + N0=cn*cvmix_PI/zbottom + if ( N0> abs(coriolis) .and. omega_M2> abs(coriolis) ) then + fxc = topo_hrms**2.0 * 2.0*cvmix_PI/(1d-12+topo_hlam) + fxb = 0.5* N0*( (omega_M2**2.0 + coriolis**2.0)/omega_M2**2.0 )**2.0 & + *(omega_M2**2.0 - coriolis**2.0)**0.5/omega_M2 + tau_M2 = min(0.5/dtime, fxc*fxb/zbottom) + endif + endif + + ! on shelf limitation + if (topo_shelf == 1.0) tau_M2 = 1./(3.*86400.0) + + ! ensure background value + tau_M2 = max(1d0/(50.*86400.0), tau_M2 ) + + ! compute alpha_M2_c M2 Continuous Dissipation Rate (Background M2 tidal + ! dissipation rate (not topographic)) + alpha_M2_c = 0.0 + if (zbottom > 0.) then + N0 = cn*cvmix_PI/zbottom+1D-20 + if (abs(lat) < 28.5 ) then + ! lambda+/M2=15*E*mstar/N * (sin(phi-28.5)/sin(28.5))^1/2 + alpha_M2_c=alpha_M2_c+ M2_f*15*mstar/N0* (sin( abs(abs(lat) -28.5)/180.*cvmix_PI )/sin(28.5/180.*cvmix_PI) )**0.5 + endif + if (abs(lat) < 74.5 ) then + ! lambda-/M2 = 0.7*E*mstar/N *sin^2(phi) + alpha_M2_c=alpha_M2_c+ M2_f*0.7*mstar/N0* sin( abs(lat)/180.*cvmix_PI )**2 + endif + alpha_M2_c=alpha_M2_c/zbottom + endif + + ! ensure background value + alpha_M2_c = max(0D0, min( 1d-5,alpha_M2_c )) + + endif + + +end subroutine compute_interact_tscale + + + ! ! !_______________________________________________________________________________ @@ -461,6 +569,7 @@ subroutine vmix_tke_put_idemix2_real(varname, val, idemix2_userdef_constants) case('jstar') ; idemix2_constants_out%jstar = val case('gamma') ; idemix2_constants_out%gamma = val case('mu0' ) ; idemix2_constants_out%mu0 = val + case('shelf_dist' ) ; idemix2_constants_out%shelf_dist = val case DEFAULT print*, "ERROR:", trim(varname), " not a valid choice" stop 1 diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 5f112c819..9c741625d 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -16,14 +16,16 @@ module g_cvmix_idemix2 !___________________________________________________________________________ ! module calls from cvmix library - use cvmix_idemix2, only : cvmix_init_idemix2, & - cvmix_compute_groupvel_idemix2 !calc_idemix2_v0, cvmix_coeffs_idemix2 + use cvmix_idemix2, only : cvmix_init_idemix2 , & + cvmix_compute_groupvel_idemix2 , & + cvmix_compute_interact_tscale_idemix2 + use cvmix_put_get, only : cvmix_put use cvmix_kinds_and_types !___________________________________________________________________________ ! module calls from FESOM - use g_config , only: dt + use g_config , only: dt, flag_debug use o_param use mod_mesh USE MOD_PARTIT @@ -31,6 +33,7 @@ module g_cvmix_idemix2 use o_arrays use g_comm_auto use g_read_other_NetCDF + use g_dist2coast, only: compute_dist2coast implicit none public @@ -117,13 +120,18 @@ module g_cvmix_idemix2 character(MAX_PATH):: idemix2_hlamforc_file = './idemix2_forcing_t-scattering_1deg.nc' character(MAX_PATH):: idemix2_hlamforc_vname= 'LAMBDA_G10' + ! define shelf is defined as distance from coast (default 300km) + real(kind=WP) :: idemix2_shelf_dist = 300.0e3 + namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, & idemix2_enable_M2, idemix2_enable_niw, idemix2_fniw_usage, & idemix2_enable_superbee_adv, idemix2_enable_AB_timestep, idemix2_nfbin, & idemix2_enable_hor_diffusion, idemix2_hor_diffusion_niter, & - idemix2_M2forc_file, idemix2_M2forc_vname, & - idemix2_niwforc_file, idemix2_niwforc_file, & - idemix2_botforc_file, idemix2_botforc_vname, idemix2_botforc_Etot, & + idemix2_shelf_dist, & + idemix2_botforc_Etot, & + idemix2_M2forc_file , idemix2_M2forc_vname , & + idemix2_niwforc_file , idemix2_niwforc_vname , & + idemix2_botforc_file , idemix2_botforc_vname , & idemix2_hrmsforc_file, idemix2_hrmsforc_vname, & idemix2_hlamforc_file, idemix2_hlamforc_vname @@ -148,8 +156,9 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,:) :: iwe2_c0, iwe2_v0 real(kind=WP), allocatable, dimension(:,:) :: iwe2_alpha_c, iwe2_alpha_c_n + real(kind=WP), allocatable, dimension(:) :: iwe2_alpha_M2_c - real(kind=WP), allocatable, dimension(:) :: iwe2_topo_hrms, iwe2_topo_hlam + real(kind=WP), allocatable, dimension(:) :: iwe2_topo_hrms, iwe2_topo_hlam, iwe2_topo_dist, iwe2_topo_shelf real(kind=WP), allocatable, dimension(:) :: iwe2_M2_tau, iwe2_niw_tau real(kind=WP), allocatable, dimension(:) :: iwe2_fbot, iwe2_fsrf @@ -185,6 +194,7 @@ subroutine init_cvmix_idemix2(partit, mesh) logical :: file_exist=.False. integer :: node_size, elem_size, elem, nfbin, fbin_i, elnodes(3) real(kind=WP) :: loc_Etot=0.0_WP, glb_Etot=0.0_WP + real(kind=WP) :: t0, t1 #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" @@ -192,7 +202,7 @@ subroutine init_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ if(mype==0) then write(*,*) '____________________________________________________________' - write(*,*) ' --> initialise IDEMIX' + write(*,*) ' --> initialise IDEMIX2' write(*,*) end if @@ -207,10 +217,10 @@ subroutine init_cvmix_idemix2(partit, mesh) aux(:) = 0.0_WP ! lat gradient in coriolis (is only computed @init) - allocate(iwe2_grady_coriol(elem_size)) + allocate(iwe2_grady_coriol(myDim_elem2D)) iwe2_grady_coriol(:)= 0.0_WP - allocate(iwe2_omega_niw(elem_size)) + allocate(iwe2_omega_niw(myDim_elem2D)) iwe2_omega_niw(:) = 0.0_WP ! allocate 1d Spectral space coordinates @@ -258,7 +268,7 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_niw_v(:,:) = 0.0_WP iwe2_niw_w(:,:) = 0.0_WP - ! Vertical group velocity c0, Horizontal group velocity v0 + ! Vertical group velocity c0, Horizontal gfxaroup velocity v0 allocate(iwe2_c0(nl,elem_size), iwe2_v0(nl,elem_size)) iwe2_c0(:,:) = 0.0_WP iwe2_v0(:,:) = 0.0_WP @@ -271,42 +281,45 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_cn(:) = 0.0_WP ! Dissipation coefficient - allocate(iwe2_alpha_c(nl,elem_size), iwe2_alpha_c_n(nl,node_size)) + allocate(iwe2_alpha_c(nl,elem_size), iwe2_alpha_c_n(nl,node_size), iwe2_alpha_M2_c(elem_size)) iwe2_alpha_c(:,:) = 0.0_WP + iwe2_alpha_M2_c(:) = 0.0_WP iwe2_alpha_c_n(:,:) = 0.0_WP + ! forcing fields, M2 tidal forcing (spectral) and NIW forcing (spectral) + allocate(iwe2_fbot(myDim_elem2D), iwe2_fsrf(myDim_elem2D)) + allocate(iwe2_fM2(nfbin, myDim_elem2D), iwe2_fniw(nfbin, myDim_elem2D)) + iwe2_fbot(:) = 0.0_WP + iwe2_fsrf(:) = 0.0_WP + iwe2_fM2(:,:) = 0.0_WP + iwe2_fniw(:,:) = 0.0_WP + ! Topographic height and Topographic wavelength - allocate(iwe2_topo_hrms(elem_size),iwe2_topo_hlam(elem_size)) + allocate(iwe2_topo_hrms(myDim_elem2D), iwe2_topo_hlam(myDim_elem2D), iwe2_topo_shelf(myDim_elem2D), iwe2_topo_dist(myDim_elem2D)) iwe2_topo_hrms(:) = 0.0_WP iwe2_topo_hlam(:) = 0.0_WP + iwe2_topo_shelf(:) = 0.0_WP + iwe2_topo_dist(:) = 0.0_WP ! M2 and NIW dissipation timescale - allocate(iwe2_M2_tau(elem_size),iwe2_niw_tau(elem_size)) + allocate(iwe2_M2_tau(myDim_elem2D),iwe2_niw_tau(myDim_elem2D)) iwe2_M2_tau(:) = 0.0_WP iwe2_niw_tau(:) = 0.0_WP - ! forcing fields, M2 tidal forcing (spectral) and NIW forcing (spectral) - allocate(iwe2_fbot(elem_size), iwe2_fsrf(elem_size)) - allocate(iwe2_fM2(nfbin, elem_size), iwe2_fniw(nfbin, elem_size)) - iwe2_fbot(:) = 0.0_WP - iwe2_fsrf(:) = 0.0_WP - iwe2_fM2(:,:) = 0.0_WP - iwe2_fniw(:,:) = 0.0_WP - - ! diagnostic - allocate(iwe2_Ttot(nl,elem_size)) - allocate(iwe2_Tdif(nl,elem_size)) - allocate(iwe2_Thdi(nl,elem_size)) - allocate(iwe2_Tdis(nl,elem_size), iwe2_Tdis_n(nl,node_size)) - allocate(iwe2_Tsur(nl,elem_size)) - allocate(iwe2_Tbot(nl,elem_size)) - iwe2_Ttot(:,:) = 0.0_WP - iwe2_Tdif(:,:) = 0.0_WP - iwe2_Thdi(:,:) = 0.0_WP - iwe2_Tdis(:,:) = 0.0_WP - iwe2_Tsur(:,:) = 0.0_WP - iwe2_Tbot(:,:) = 0.0_WP - iwe2_Tdis_n(:,:) = 0.0_WP +! ! diagnostic +! allocate(iwe2_Ttot(nl,elem_size)) +! allocate(iwe2_Tdif(nl,elem_size)) +! allocate(iwe2_Thdi(nl,elem_size)) +! allocate(iwe2_Tdis(nl,elem_size), iwe2_Tdis_n(nl,node_size)) +! allocate(iwe2_Tsur(nl,elem_size)) +! allocate(iwe2_Tbot(nl,elem_size)) +! iwe2_Ttot(:,:) = 0.0_WP +! iwe2_Tdif(:,:) = 0.0_WP +! iwe2_Thdi(:,:) = 0.0_WP +! iwe2_Tdis(:,:) = 0.0_WP +! iwe2_Tsur(:,:) = 0.0_WP +! iwe2_Tbot(:,:) = 0.0_WP +! iwe2_Tdis_n(:,:) = 0.0_WP ! allocate(cvmix_dummy_1(nl,elem_size)) ! allocate(cvmix_dummy_2(nl,elem_size)) @@ -349,31 +362,46 @@ subroutine init_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ if (mype==0) then - write(*,*) " idemix2_tau_v = ", idemix2_tau_v - write(*,*) " idemix2_tau_h = ", idemix2_tau_h - write(*,*) " idemix2_gamma = ", idemix2_gamma - write(*,*) " idemix2_jstar = ", idemix2_jstar - write(*,*) " idemix2_mu0 = ", idemix2_mu0 - write(*,*) " idemix2_enable_M2 = ", idemix2_enable_M2 - write(*,*) " idemix2_enable_niw = ", idemix2_enable_niw - write(*,*) " idemix2_fniw_usage = ", idemix2_fniw_usage - write(*,*) " idemix2_superbee_adv = ", idemix2_enable_superbee_adv - write(*,*) " idemix2_AB_timestep = ", idemix2_enable_AB_timestep - write(*,*) " idemix2_nfbin = ", idemix2_nfbin - write(*,*) " idemix2_M2forc_file = ", trim(idemix2_M2forc_file) - write(*,*) " idemix2_niwforc_file = ", trim(idemix2_niwforc_file) - write(*,*) " idemix2_botforc_file = ", trim(idemix2_botforc_file) - write(*,*) " idemix2_botforc_Etot = ", idemix2_botforc_Etot - - write(*,*) " idemix2_hrmsforc_file= ", trim(idemix2_hrmsforc_file) - write(*,*) " idemix2_hlamforc_file= ", trim(idemix2_hlamforc_file) + write(*,*) " IDEMIX2 parameters:" + write(*,*) " ├> idemix2_tau_v = ", idemix2_tau_v + write(*,*) " ├> idemix2_tau_h = ", idemix2_tau_h + write(*,*) " ├> idemix2_gamma = ", idemix2_gamma + write(*,*) " ├> idemix2_jstar = ", idemix2_jstar + write(*,*) " ├> idemix2_mu0 = ", idemix2_mu0 + write(*,*) " │ " + write(*,*) " ├> idemix2_superbee_adv = ", idemix2_enable_superbee_adv + write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB_timestep + write(*,*) " ├> idemix2_nfbin = ", idemix2_nfbin + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_M2 = ", idemix2_enable_M2 + write(*,*) " │ └> idemix2_M2forc_file = ", trim(idemix2_M2forc_file) + write(*,*) " │ └> idemix2_M2forc_vname = ", trim(idemix2_M2forc_vname) + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_niw = ", idemix2_enable_niw + write(*,*) " │ ├> idemix2_fniw_usage = ", idemix2_fniw_usage + write(*,*) " │ └> idemix2_niwforc_file = ", trim(idemix2_niwforc_file) + write(*,*) " │ └> idemix2_niwforc_vname= ", trim(idemix2_niwforc_vname) + write(*,*) " │ " + write(*,*) " ├> idemix2_botforc_file = ", trim(idemix2_botforc_file) + write(*,*) " │ ├> idemix2_botforc_vname = ", trim(idemix2_botforc_vname) + write(*,*) " │ └> idemix2_botforc_Etot = ", idemix2_botforc_Etot + write(*,*) " │ " + write(*,*) " ├> idemix2_hrmsforc_file = ", trim(idemix2_hrmsforc_file) + write(*,*) " │ └> idemix2_hrmsforc_vname = ", trim(idemix2_hrmsforc_vname) + write(*,*) " │ " + write(*,*) " ├> idemix2_hlamforc_file = ", trim(idemix2_hlamforc_file) + write(*,*) " │ └> idemix2_hlamforc_vname = ", trim(idemix2_hlamforc_vname) + write(*,*) " │ " + WRITE(*,*) " └> idemix2_shelf_dist = ", idemix2_shelf_dist write(*,*) + write(*,*) " IDEMIX2 inputs:" end if !_______________________________________________________________________ ! read idemix M2 forcing from cfsr data --> file if (idemix2_enable_M2) then + t0=MPI_Wtime() ! omega_M2 is fixed, as the M2 tidal forcing is independent of the local inertial frequency. ! Physical Implication: At high latitudes where |f| > ω_M2, the M2 tide becomes evanescent ! (cannot propagate as internal waves). This is handled in the code by checking ω_M2 > |f| @@ -383,54 +411,68 @@ subroutine init_cvmix_idemix2(partit, mesh) file_exist=.False. inquire(file=trim(idemix2_M2forc_file),exist=file_exist) if (file_exist) then - if (mype==0) write(*,*) ' --> read IDEMIX M2 wave forcing' + if (mype==0) write(*,*) ' ├> read IDEMIX2 M2 wave forcing' do fbin_i =2, nfbin-1 - call read_other_NetCDF(idemix2_M2forc_file, idemix2_M2forc_vname, fbin_i, aux, .true., .false., partit, mesh) - ! | - ! .false.=interpolate on element centroids instead of vertices <---+ + call read_other_NetCDF(trim(idemix2_M2forc_file), trim(idemix2_M2forc_vname), fbin_i, aux, .true., .false., partit, mesh) + ! | + ! .false.=interpolate on element centroids instead of vertices <---+ iwe2_fM2(fbin_i, :) = aux/density_0/iwe2_dphit - end do + end do + deallocate(aux) else if (mype==0) then + print *, achar(27)//'[33m' write(*,*) '____________________________________________________________________' write(*,*) ' ERROR: IDEMIX2 M2 forcing file not found! Cant apply IDEMIX2' write(*,*) ' vertical mixing parameterisation! ' - write(*,*) ' --> check your namelist.cvmix, idemix2_M2forc_file & ' + write(*,*) ' ├> file: ', trim(idemix2_M2forc_file) + write(*,*) ' └> check: namelist.cvmix, idemix2_M2forc_file & ' write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if + t1=MPI_Wtime() + if (mype==0) write(*,*) ' | └> elapsed time:', t1-t0 end if ! --> if (idemix2_enable_M2) then !_______________________________________________________________________ ! read idemix niw oe srf forcing from cfsr data --> file + t0=MPI_Wtime() file_exist=.False. inquire(file=trim(idemix2_niwforc_file),exist=file_exist) if (file_exist) then - if (mype==0) write(*,*) ' --> read IDEMIX niw/surface wave forcing' - call read_other_NetCDF(idemix2_niwforc_file, idemix2_niwforc_vname, 1, iwe2_fsrf, .true., .false., partit, mesh) + + call read_other_NetCDF(trim(idemix2_niwforc_file), trim(idemix2_niwforc_vname), 1, iwe2_fsrf, .true., .false., partit, mesh) ! only 20% (idemix2_fniw_usage) from the surface forcing goes into internal waves ! iwe2_fsrf becomes surface forcing variable when idemix2_enable_niw=.false. ! in this case standard idemix1 behaviour iwe2_fsrf = iwe2_fsrf/density_0*idemix2_fniw_usage if (idemix2_enable_niw) then + if (mype==0) write(*,*) ' ├> read IDEMIX2 niw wave forcing' do fbin_i =2, nfbin-1 iwe2_fniw(fbin_i, :) = iwe2_fsrf/iwe2_dphit !!!ATTENTION CHECK THIS AGAIN!!! end do - else iwe2_fsrf(:) = 0.0_WP + else + if (mype==0) write(*,*) ' ├> read IDEMIX2 surface wave forcing' end if else if (mype==0) then + print *, achar(27)//'[33m' write(*,*) '____________________________________________________________________' write(*,*) ' ERROR: IDEMIX2 NIW forcing file not found! Cant apply IDEMIX2' write(*,*) ' vertical mixing parameterisation! ' - write(*,*) ' --> check your namelist.cvmix, idemix2_niwforc_file & ' + write(*,*) ' ├> file: ', trim(idemix2_niwforc_file) + write(*,*) ' └> check: namelist.cvmix, idemix2_niwforc_file & ' write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if ! NIWs are super-inertial (ω_niw > |f|), which is essential for their propagation as internal waves. @@ -439,19 +481,23 @@ subroutine init_cvmix_idemix2(partit, mesh) ! from background flows. Physical Context: NIWs are generated by wind events and have frequencies ! close to f. They can only propagate as internal waves if ω > |f|. if (idemix2_enable_niw) then - do elem = 1, elem_size + do elem = 1, myDim_elem2D iwe2_omega_niw(elem) = max(1d-8, abs( 1.05 * mesh%coriolis(elem) ) ) end do + call exchange_elem(iwe2_omega_niw, partit) end if + t1=MPI_Wtime() + if (mype==0) write(*,*) ' | └> elapsed time:', t1-t0 !_______________________________________________________________________ ! read idemix bottom near tidal forcing from cesm data set --> file ! from N. Brüggemann interpoalted to regular grid + t0=MPI_Wtime() file_exist=.False. inquire(file=trim(idemix2_botforc_file),exist=file_exist) if (file_exist) then - if (mype==0) write(*,*) ' --> read IDEMIX near tidal bottom forcing' - call read_other_NetCDF(idemix2_botforc_file, idemix2_botforc_vname, 1, iwe2_fbot, .true., .false., partit, mesh) + if (mype==0) write(*,*) ' ├> read IDEMIX2 near tidal bottom forcing' + call read_other_NetCDF(trim(idemix2_botforc_file), trim(idemix2_botforc_vname), 1, iwe2_fbot, .true., .false., partit, mesh) ! | ! .false.=interpolate on element centroids instead of vertices <---+ @@ -468,7 +514,7 @@ subroutine init_cvmix_idemix2(partit, mesh) end if end do call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) - if (mype==0) write(*,*) " --> IDEMIX2 total tidal energy Etot_bot =", glb_Etot*1.0e-12, ' TW' + if (mype==0) write(*,*) " │ └> IDEMIX2 total tidal energy Etot_bot =", glb_Etot*1.0e-12, ' TW' ! normalize total tidal energy at bottom with respect to the total ! tidal energy that is e.g in the original forcing files to accomodate @@ -487,7 +533,7 @@ subroutine init_cvmix_idemix2(partit, mesh) end if end do call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) - if (mype==0) write(*,*) " --> IDEMIX2 Etot_bot after normalizing =", glb_Etot*1.0e-12, ' TW' + if (mype==0) write(*,*) " │ └> IDEMIX2 Etot_bot after normalizing =", glb_Etot*1.0e-12, ' TW' end if ! divide by density_0 --> convert from W/m^2 to m^3/s^3 @@ -495,36 +541,46 @@ subroutine init_cvmix_idemix2(partit, mesh) else if (mype==0) then + print *, achar(27)//'[33m' write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: IDEMIX bottom forcing file not found! Cant apply IDEMIX' + write(*,*) ' ERROR: IDEMIX2 bottom forcing file not found! Cant apply IDEMIX' write(*,*) ' vertical mixing parameterisation! ' - write(*,*) ' --> check your namelist.cvmix, idemix_surforc_file & ' - write(*,*) ' idemix_botforc_file' + write(*,*) ' ├> file: ', trim(idemix2_botforc_file) + write(*,*) ' └> check: namelist.cvmix, idemix2_botforc_file' write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if + t1=MPI_Wtime() + if (mype==0) write(*,*) ' │ └> elapsed time:', t1-t0 !_______________________________________________________________________ ! read idemix HRMS and HLAM forcing --> file if (idemix2_enable_M2 .or. idemix2_enable_niw ) then + t0=MPI_Wtime() ! topo_hrms (Root Mean Square Topographic Height), Definition: Measures the roughness or variability of seafloor topography. ! Units: Meters (m), Role: Represents the standard deviation of seafloor height variations. Used to calculate ! energy transfer from tides/NIW to internal waves. ! file_exist=.False. inquire(file=trim(idemix2_hrmsforc_file),exist=file_exist) if (file_exist) then - if (mype==0) write(*,*) ' --> read IDEMIX HRMS forcing' - call read_other_NetCDF(idemix2_hrmsforc_file, idemix2_hrmsforc_vname, 1, iwe2_topo_hrms, .true., .false., partit, mesh) + if (mype==0) write(*,*) ' ├> read IDEMIX2 HRMS forcing' + call read_other_NetCDF(trim(idemix2_hrmsforc_file), trim(idemix2_hrmsforc_vname), 1, iwe2_topo_hrms, .true., .false., partit, mesh) else if (mype==0) then + print *, achar(27)//'[33m' write(*,*) '____________________________________________________________________' write(*,*) ' ERROR: IDEMIX2 HRMS forcing file not found! Cant apply IDEMIX2' write(*,*) ' vertical mixing parameterisation! ' - write(*,*) ' --> check your namelist.cvmix, idemix2_hrmsforc_file & ' + write(*,*) ' ├> file: ', trim(idemix2_hrmsforc_file) + write(*,*) ' └> check: namelist.cvmix, idemix2_hrmsforc_file' write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if ! topo_hlam (Topographic Wavelength), Definition: Characteristic horizontal length scale of topographic features. @@ -532,17 +588,21 @@ subroutine init_cvmix_idemix2(partit, mesh) file_exist=.False. inquire(file=trim(idemix2_hlamforc_file),exist=file_exist) if (file_exist) then - if (mype==0) write(*,*) ' --> read IDEMIX HLAM forcing' - call read_other_NetCDF(idemix2_hlamforc_file, idemix2_hlamforc_vname, 1, iwe2_topo_hlam, .true., .false., partit, mesh) + if (mype==0) write(*,*) ' ├> read IDEMIX2 HLAM forcing' + call read_other_NetCDF(trim(idemix2_hlamforc_file), trim(idemix2_hlamforc_vname), 1, iwe2_topo_hlam, .true., .false., partit, mesh) else if (mype==0) then + print *, achar(27)//'[33m' write(*,*) '____________________________________________________________________' write(*,*) ' ERROR: IDEMIX2 HLAM forcing file not found! Cant apply IDEMIX2' write(*,*) ' vertical mixing parameterisation! ' - write(*,*) ' --> check your namelist.cvmix, idemix2_hlamforc_file & ' + write(*,*) ' ├> file: ', trim(idemix2_hlamforc_file) + write(*,*) ' └> check: namelist.cvmix, idemix2_hlamforc_file' write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if ! In the M2 tidal and NIW energy calculations: @@ -555,11 +615,22 @@ subroutine init_cvmix_idemix2(partit, mesh) ! These parameters are crucial for accurately representing the conversion of barotropic tidal energy to internal ! waves over rough topography. + t1=MPI_Wtime() + if (mype==0) write(*,*) ' | └> elapsed time:', t1-t0 + end if ! --> if (idemix2_enable_niw) then + !_______________________________________________________________________ + ! compute centroid distance from nearset coastal point together with + ! idemix2_shelf_dist defines what is shelf and what not + t0=MPI_Wtime() + call compute_dist2coast(iwe2_topo_dist, mesh, partit, 'elem') + t1=MPI_Wtime() + if (partit%mype==0) write(*,*) ' └> dist2coast elapsed time:', t1-t0 + !_______________________________________________________________________ ! compute d/dy of coriolis - do elem = 1, elem_size + do elem = 1, myDim_elem2D elnodes = elem2d_nodes(:,elem) iwe2_grady_coriol(elem) = sum(gradient_sca(4:6, elem)*mesh%coriolis_node(elnodes)) end do @@ -571,7 +642,8 @@ subroutine init_cvmix_idemix2(partit, mesh) gamma = idemix2_gamma , & jstar = idemix2_jstar , & mu0 = idemix2_mu0 , & - nfbin = idemix2_nfbin , & + nfbin = idemix2_nfbin , & + shelf_dist = idemix2_shelf_dist , & enable_M2 = idemix2_enable_M2 , & enable_niw = idemix2_enable_niw , & enable_superbee_adv = idemix2_enable_superbee_adv , & @@ -579,7 +651,8 @@ subroutine init_cvmix_idemix2(partit, mesh) enable_hor_diffusion= idemix2_enable_hor_diffusion, & hor_diffusion_niter = idemix2_hor_diffusion_niter & ) - + + if (partit%mype==0) write(*,*) end subroutine init_cvmix_idemix2 ! @@ -595,7 +668,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) integer :: nz, nln, nl1, nl2, nl12, nu1, nu2, nu12, uln, niter integer :: elnodes1(3), elnodes2(3), el(2), ednodes(2) real(kind=WP) :: dz_trr(mesh%nl), dz_trr2(mesh%nl), bvfreq2(mesh%nl), vflux, dz_el, aux, cflfac - real(kind=WP) :: grad_v0Eiw(2), deltaX1, deltaY1, deltaX2, deltaY2 + real(kind=WP) :: grad_v0Eiw(2), lat_e_deg, deltaX1, deltaY1, deltaX2, deltaY2 real(kind=WP) :: tsum1, tsum2, tsum3, tsum4, tvol real(kind=WP) :: cn, cn_e, cn_gradx_e, cn_grady_e logical :: debug=.false. @@ -632,7 +705,9 @@ subroutine calc_cvmix_idemix2(partit, mesh) nln = nlevels(elem)-1 uln = ulevels(elem) elnodes1 = elem2d_nodes(:,elem) - + + lat_e_deg = sum(geo_coord_nod2D(2,elnodes1))/3.0 * 180.0/pi + !___________________________________________________________________ ! calculate for TKE square of Brünt-Väisälä frequency, be aware that ! bvfreq contains already the squared brünt Väisälä frequency ... @@ -658,7 +733,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) cn_grady_e = sum(gradient_sca(4:6,elem)*iwe2_cn(elnodes1)) !___________________________________________________________________ - ! compute 1st. idemix2 parameter over the vertical water column and + ! 1st. compute idemix2 parameter over the vertical water column and ! local horizontal parameters on elements !!!: ! IN VARIABLES: ! -------------- @@ -720,6 +795,43 @@ subroutine calc_cvmix_idemix2(partit, mesh) v_niw = iwe2_niw_v( :, elem) , & !OUT w_niw = iwe2_niw_w( :, elem) & !OUT ) + + !___________________________________________________________________ + ! 2st. compute dissipation time scales and rates + ! IN VARIABLES: + ! -------------- + ! dtime ... time step + ! lat ... elem lat coordinates + ! coriolis ... coriolis parameter + ! omega_M2 ... M2 frequency (fixed) + ! omega_niw ... NIW frequency (lat dependent) + ! cn ... baroclionic gravity wave speed + ! zbottom ... bottom depth at elements + ! topo_hrms ... root mean square topographic height + ! topo_hlam ... characteristic horiz. length scale of topographic features + ! topo_shelf... point is considered shelf + ! + ! OUT VARIABLES: + ! -------------- + ! tau_M2 ... M2 Tidal Dissipation Timescale + ! tau_niw ... NIW Dissipation Timescale + ! alpha_M2_cont... M2 Continuous Dissipation Rate (Background M2 tidal + ! dissipation rate + call cvmix_compute_interact_tscale_idemix2( & + dtime = dt , & !IN + lat = lat_e_deg , & !IN + coriolis = mesh%coriolis( elem) , & !IN + omega_M2 = iwe2_omega_M2 , & !IN + omega_niw = iwe2_omega_niw( elem) , & !IN + cn = cn_e , & !IN + zbottom = zbar_e_bot( elem) , & !IN + topo_hrms = iwe2_topo_hrms( elem) , & !IN + topo_hlam = iwe2_topo_hlam( elem) , & !IN + topo_shelf = iwe2_topo_shelf( elem) , & !IN + tau_M2 = iwe2_M2_tau( elem) , & !OUT + tau_niw = iwe2_niw_tau( elem) , & !OUT + alpha_M2_c = iwe2_alpha_M2_c( elem) & !OUT + ) !___________________________________________________________________ end do ! --> do elem = 1,elem_size diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 604961e08..646bb73b8 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1278,7 +1278,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) !_______________________________________________________________________________ ! TKE mixing diagnostic CASE ('TKE ') - if (mix_scheme_nmb==5 .or. mix_scheme_nmb==56) then + if (mix_scheme_nmb==5 .or. mix_scheme_nmb==56 .or. mix_scheme_nmb==57) then call def_stream((/nl,nod2D/), (/nl,myDim_nod2D/), 'tke' , 'turbulent kinetic energy' , 'm^2/s^2', tke(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2D/), (/nl,myDim_nod2D/), 'tke_Ttot', 'total production of turbulent kinetic energy', 'm^2/s^3', tke_Ttot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2D/), (/nl,myDim_nod2D/), 'tke_Tbpr', 'TKE production by buoyancy' , 'm^2/s^3', tke_Tbpr(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1312,10 +1312,28 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream(elem2D , myDim_elem2D , 'iwe_fsrf', 'IDEMIX surface forcing' , 'm^3/s^3', iwe_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) end if +!_______________________________________________________________________________ +! IDEMIX2 mixing Internal-Wave-Energy diagnostics +CASE ('IDEMIX2 ') + if (mod(mix_scheme_nmb,10)==7) then + call def_stream(elem2D, myDim_elem2D, 'dist2coast', 'distance from coast', 'm', iwe2_topo_dist, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe' , 'internal wave energy' , 'm^2/s^2', iwe(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Ttot', 'total production of internal wave energy' , 'm^2/s^2', iwe_Ttot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tdif', 'IWE production by vertical diffusion' , 'm^2/s^3', iwe_Tdif(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tdis', 'IWE production by dissipation' , 'm^2/s^3', iwe_Tdis(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tsur', 'IWE production from surface forcing' , 'm^2/s^2', iwe_Tsur(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tbot', 'IWE production from bottom forcing' , 'm^2/s^2', iwe_Tbot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Thdi', 'IWE production from hori. diffusion' , 'm^2/s^2', iwe_Thdi(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_c0' , 'IWE vertical group velocity' , 'm/s' , iwe_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_v0' , 'IWE horizontal group velocity' , 'm/s' , iwe_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream(elem2D , myDim_elem2D , 'iwe_fbot', 'IDEMIX bottom forcing' , 'm^3/s^3', iwe_fbot(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) +! call def_stream(elem2D , myDim_elem2D , 'iwe_fsrf', 'IDEMIX surface forcing' , 'm^3/s^3', iwe_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + !_______________________________________________________________________________ ! TIDAL mixing diagnostics CASE ('TIDAL ') - if (mod(mix_scheme_nmb,10)==7) then + if (mod(mix_scheme_nmb,10)==8) then ! cvmix_TIDAL diagnostics call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'tidal_Kv' , 'tidal diffusivity' , 'm^2/s' , tidal_Kv(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'tidal_Av' , 'tidal viscosity' , 'm^2/s' , tidal_Av(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) From d35f2cc642524cfb576b3c1e49b8b70d0f75170d Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:13:04 +0100 Subject: [PATCH 07/63] add idemix2 variables to IO --- src/io_meandata.F90 | 66 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 54 insertions(+), 12 deletions(-) diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 646bb73b8..b88e0a98a 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1316,18 +1316,48 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) ! IDEMIX2 mixing Internal-Wave-Energy diagnostics CASE ('IDEMIX2 ') if (mod(mix_scheme_nmb,10)==7) then - call def_stream(elem2D, myDim_elem2D, 'dist2coast', 'distance from coast', 'm', iwe2_topo_dist, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe' , 'internal wave energy' , 'm^2/s^2', iwe(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Ttot', 'total production of internal wave energy' , 'm^2/s^2', iwe_Ttot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tdif', 'IWE production by vertical diffusion' , 'm^2/s^3', iwe_Tdif(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tdis', 'IWE production by dissipation' , 'm^2/s^3', iwe_Tdis(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tsur', 'IWE production from surface forcing' , 'm^2/s^2', iwe_Tsur(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tbot', 'IWE production from bottom forcing' , 'm^2/s^2', iwe_Tbot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Thdi', 'IWE production from hori. diffusion' , 'm^2/s^2', iwe_Thdi(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_c0' , 'IWE vertical group velocity' , 'm/s' , iwe_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_v0' , 'IWE horizontal group velocity' , 'm/s' , iwe_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream(elem2D , myDim_elem2D , 'iwe_fbot', 'IDEMIX bottom forcing' , 'm^3/s^3', iwe_fbot(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) -! call def_stream(elem2D , myDim_elem2D , 'iwe_fsrf', 'IDEMIX surface forcing' , 'm^3/s^3', iwe_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw' , 'internal wave energy ' , 'm^2/s^2', iwe2_E_iw(taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_dt' , 'Eiw total production ' , 'm^2/s^3', iwe2_E_iw_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_diss', 'Eiw production from dissipation', 'm^2/s^3', iwe2_E_iw_diss( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_hdif', 'Eiw production from hor. diff.' , 'm^2/s^3', iwe2_E_iw_hdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_vdif', 'Eiw production from ver. diff.' , 'm^2/s^3', iwe2_E_iw_vdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_Eiw_fsrf', 'Eiw production from srf. forc.' , 'm^2/s^3', iwe2_E_iw_fsrf( :) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_fbot', 'Eiw production from bot. forc.' , 'm^2/s^3', iwe2_E_iw_fbot( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_c0' , 'Eiw vertical group velocity' , 'm/s' , iwe2_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_v0' , 'Eiw horizontal group velocity' , 'm/s' , iwe2_v0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_alpha_c' , 'Eiw dissipation coefficien' , 'none' , iwe2_alpha_c(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( elem2D , myDim_elem2D , 'iwe2_fbot' , 'bottom forcing' , 'm^3/s^3', iwe2_fbot_e(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_fsrf' , 'surface forcing' , 'm^3/s^3', iwe2_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + + if (idemix2_enable_M2) then + call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_alphac', 'M2 energy dissipation' , 'none' , iwe2_alpha_M2_c(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_tau' , 'M2 dissipation timescale' , 's' , iwe2_M2_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_forc' , 'M2 forcing' , 's' , iwe2_fM2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_w' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_u' , 'M2 zonal propag.' , 'm/s' , iwe2_M2_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_v' , 'M2 merid. propag.' , 'm/s' , iwe2_M2_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_E' , 'M2 wave energy' , 'm^2/s^2' , iwe2_E_M2(taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_Ediv' , 'M2 wave energy divergence' , 'm^2/s^2' , iwe2_Ediv_M2(taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_Estrct', 'M2 structure function energy' , 'm^2/s^2' , iwe2_E_struct_M2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + + if (idemix2_enable_niw) then + call def_stream( nod2d , myDim_nod2D , 'iwe2_niw_omega', 'niw frequency' , '1/s' , iwe2_omega_niw(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_niw_tau' , 'niw dissipation timescale' , 's' , iwe2_niw_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_forc' , 'niw forcing' , 's' , iwe2_fniw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_w' , 'niw cross. spectr. propag.' , 'rad/s' , iwe2_niw_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_u' , 'niw zonal propag.' , 'm/s' , iwe2_niw_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_v' , 'niw merid. propag.' , 'm/s' , iwe2_niw_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_E' , 'niw wave energy' , 'm^2/s^2', iwe2_E_niw(taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_Ediv' , 'niw wave energy divergence' , 'm^2/s^2', iwe2_Ediv_niw(taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_Estrct','niw structure function energy' , 'm^2/s^2',iwe2_E_struct_niw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + + if (idemix2_enable_M2 .or. idemix2_enable_niw) then + call def_stream(nod2d, myDim_nod2D, 'topo_dist2c', 'distance from coast', 'm', iwe2_topo_dist, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream(nod2d, myDim_nod2D, 'topo_hrms' , 'Root Mean Square Topographic Heigh', 'm', iwe2_topo_hrms, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream(nod2d, myDim_nod2D, 'topo_hlam' , 'Topographic Wavelength', 'm', iwe2_topo_hrms, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if end if !_______________________________________________________________________________ @@ -1792,6 +1822,7 @@ function mesh_dimname_from_dimsize(size, partit, mesh) result(name) #if defined (__icepack) use icedrv_main, only: ncat ! number of ice thickness cathegories #endif + use g_cvmix_idemix2, only: idemix2_nfbin implicit none integer :: size type(t_mesh) , intent(in) :: mesh @@ -1812,6 +1843,8 @@ function mesh_dimname_from_dimsize(size, partit, mesh) result(name) elseif (size==ncat) then name='ncat' #endif + elseif (size==idemix2_nfbin) then + name='nfbin' else name='unknown' if (partit%mype==0) write(*,*) 'WARNING: unknown dimension in mean I/O with size of ', size @@ -1830,6 +1863,7 @@ subroutine create_new_file(entry, ice, dynamics, partit, mesh) use fesom_version_info_module use g_config use o_PARAM + use g_cvmix_idemix2, only: idemix2_nfbin, iwe2_phit use diagnostics, only: std_dens implicit none @@ -1878,6 +1912,10 @@ subroutine create_new_file(entry, ice, dynamics, partit, mesh) call assert_nf( nf90_def_var(entry%ncid, entry%dimname(1), nf90_int, (/entry%dimID(1)/), entry%dimvarID(1)), __LINE__) call assert_nf( nf90_put_att(entry%ncid, entry%dimvarID(1), 'long_name', 'sigma2 density class'), __LINE__) + elseif (entry%dimname(1)=='nfbin') then + call assert_nf( nf90_def_var(entry%ncid, entry%dimname(1), nf90_int, (/entry%dimID(1)/), entry%dimvarID(1)), __LINE__) + call assert_nf( nf90_put_att(entry%ncid, entry%dimvarID(1), 'long_name', 'spectral bins'), __LINE__) + else if (partit%mype==0) write(*,*) 'WARNING: unknown first dimension in 2d mean I/O data' @@ -1967,6 +2005,10 @@ subroutine create_new_file(entry, ice, dynamics, partit, mesh) #endif elseif (entry%dimname(1)=='ndens') then call assert_nf( nf90_put_var(entry%ncid, entry%dimvarID(1), std_dens), __LINE__) + + elseif (entry%dimname(1)=='nfbin') then + call assert_nf( nf90_put_var(entry%ncid, entry%dimvarID(1), iwe2_phit), __LINE__) + else if (partit%mype==0) write(*,*) 'WARNING: unknown first dimension in 2d mean I/O data' end if From 72ff9abef6747ea2b46c2378cb9fbeb1bc94918f Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:14:49 +0100 Subject: [PATCH 08/63] add idemix2 variables to the TKE interface --- src/cvmix_driver/gen_modules_cvmix_tke.F90 | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_tke.F90 b/src/cvmix_driver/gen_modules_cvmix_tke.F90 index bcc7d549c..762272376 100644 --- a/src/cvmix_driver/gen_modules_cvmix_tke.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_tke.F90 @@ -20,7 +20,7 @@ module g_cvmix_tke use cvmix_put_get, only: cvmix_put use cvmix_kinds_and_types use g_cvmix_idemix, only: iwe_n, iwe_Tdis_n, iwe_alpha_c_n - use g_cvmix_idemix2, only: iwe2_n, iwe2_Tdis_n, iwe2_alpha_c_n + use g_cvmix_idemix2, only: iwe2_E_iw, iwe2_E_iw_diss, iwe2_alpha_c, taup1 !___________________________________________________________________________ ! module calls from FESOM @@ -224,7 +224,7 @@ subroutine init_cvmix_tke(partit, mesh) end if !_______________________________________________________________________ - if(mix_scheme_nmb==56) tke_only=.False. + if(mix_scheme_nmb==56 .or. mix_scheme_nmb==57) tke_only=.False. if (mype==0) then write(*,*) " tke_only = ", tke_only @@ -303,9 +303,15 @@ subroutine calc_cvmix_tke(dynamics, partit, mesh) ! load things from idemix when selected if (.not. tke_only) then - tke_in3d_iwe = iwe_n - tke_in3d_iwdis = -iwe_Tdis_n - tke_in3d_iwealphac = iwe_alpha_c_n + if (mod(mix_scheme_nmb,10)==6) then + tke_in3d_iwe = iwe_n + tke_in3d_iwdis = -iwe_Tdis_n + tke_in3d_iwealphac = iwe_alpha_c_n + else if (mod(mix_scheme_nmb,10)==7) then + tke_in3d_iwe = iwe2_E_iw(taup1,:,:) + tke_in3d_iwdis = -iwe2_E_iw_diss + tke_in3d_iwealphac = iwe2_alpha_c + end if endif !_______________________________________________________________________ From 0aca2ac761278558c885a83066216b28c0d9fd77 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:37:55 +0100 Subject: [PATCH 09/63] add interpolation routine for elem2node in 1d,2d,3d --- src/gen_interpolation.F90 | 214 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 207 insertions(+), 7 deletions(-) diff --git a/src/gen_interpolation.F90 b/src/gen_interpolation.F90 index 0b17e7c46..e3455ff9d 100644 --- a/src/gen_interpolation.F90 +++ b/src/gen_interpolation.F90 @@ -1,3 +1,23 @@ +module g_interp + use MOD_MESH + use MOD_PARTIT + use MOD_PARSUP + use o_PARAM, only: WP + implicit none + + !___________________________________________________________________________ + interface interp_e2n + module procedure interp_e2n_3d + module procedure interp_e2n_2d + module procedure interp_e2n_1d + end interface interp_e2n + + !___________________________________________________________________________ + contains + + + + ! routines doing 3D, 2D and 1D interpolation subroutine interp_2d_field_v2(num_lon_reg, num_lat_reg, lon_reg, lat_reg, data_reg, missvalue, & num_mod, lon_mod, lat_mod, data_mod, partit) @@ -28,9 +48,6 @@ subroutine interp_2d_field_v2(num_lon_reg, num_lat_reg, lon_reg, lat_reg, data_r ! Coded by Qiang Wang ! Reviewed by ?? !------------------------------------------------------------------------------------- - USE MOD_PARTIT - USE MOD_PARSUP - use o_PARAM, only: WP implicit none integer :: n, i, ii, jj, k, nod_find integer :: ind_lat_h, ind_lat_l, ind_lon_h, ind_lon_l @@ -170,9 +187,6 @@ subroutine interp_2d_field(num_lon_reg, num_lat_reg, lon_reg, lat_reg, data_reg, ! Coded by Qiang Wang ! Reviewed by ?? !------------------------------------------------------------------------------------- - USE MOD_PARTIT - USE MOD_PARSUP - use o_PARAM, only: WP implicit none integer :: n, i integer :: ind_lat_h, ind_lat_l, ind_lon_h, ind_lon_l @@ -447,5 +461,191 @@ subroutine interp_3d_field(num_lon_reg, num_lat_reg, num_lay_reg, & end do end subroutine interp_3d_field ! -!--------------------------------------------------------------------------- ! +!_______________________________________________________________________________ +! interpolate from node to elements 3d (2, nz, elem) +subroutine interp_e2n_3d(data_e, data_n, mesh, partit, do_overz_in) + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + real(kind=WP) , intent(in ), dimension(:,:,:) :: data_e + real(kind=WP) , intent(inout), dimension(:,:,:) :: data_n + type(t_mesh) , intent(in ), target :: mesh + type(t_partit) , intent(inout), target :: partit + logical , intent(in) , optional :: do_overz_in + !___LOCAL VARIABLES_____________________________________________________ + integer :: node, elem, nz, nl1, ul1, k + real(kind=WP) :: vx, vy + logical :: do_overz +#include "associate_part_def.h" +#include "associate_mesh_def.h" +#include "associate_part_ass.h" +#include "associate_mesh_ass.h" + ! + !___________________________________________________________________________ + do_overz = .True. + if (present(do_overz_in)) do_overz = do_overz_in + + ! + !___________________________________________________________________________ + ! Do interpolation over vertical depth dimension consider bottom topography + if (do_overz) then + do node = 1, myDim_nod2D + nl1 = nlevels_nod2D(node)-1 + ul1 = ulevels_nod2D(node) + do nz = ul1, nl1 + vx = 0.0_WP + vy = 0.0_WP + do k = 1, nod_in_elem2D_num(node) + elem = nod_in_elem2D(k, node) + if( nz.LE.(nlevels(elem)-1) .and. nz.GE.(ulevels(elem))) then + vx = vx + data_e(1, nz, elem) * elem_area(elem) + vy = vy + data_e(2, nz, elem) * elem_area(elem) + endif + end do + data_n(1, nz, node)=vx/3.0_WP/areasvol(nz, node) + data_n(2, nz, node)=vy/3.0_WP/areasvol(nz, node) + end do + end do + + ! + !___________________________________________________________________________ + ! Do interpolation along spectral domain no bottom topography to consider + else + ul1=1 + nl1=size(data_e,2) + do node = 1, myDim_nod2D + do nz = ul1+1, nl1-1 + vx = 0.0_WP + vy = 0.0_WP + do k = 1, nod_in_elem2D_num(node) + elem = nod_in_elem2D(k, node) + vx = vx + data_e(1, nz, elem) * elem_area(elem) + vy = vy + data_e(2, nz, elem) * elem_area(elem) + end do + data_n(1, nz, node)=vx/3.0_WP/areasvol(1, node) + data_n(2, nz, node)=vy/3.0_WP/areasvol(1, node) + end do + end do + end if + +end subroutine interp_e2n_3d + + +! +! +!_______________________________________________________________________________ +! interpolate from elem to nodes 2d (2, elem), (nz, elem), (nfbin, elem) --> (.., node) +subroutine interp_e2n_2d(data_e, data_n, mesh, partit, do_overz_in) + use MOD_MESH + USE MOD_PARTIT + USE MOD_PARSUP + use o_param, only: WP + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + real(kind=WP) , intent(in ), dimension(:,:) :: data_e + real(kind=WP) , intent(inout), dimension(:,:) :: data_n + type(t_mesh) , intent(in ), target :: mesh + type(t_partit) , intent(inout), target :: partit + logical , intent(in) , optional :: do_overz_in + !___LOCAL VARIABLES_____________________________________________________ + integer :: node, elem, nz, nl1, ul1, k + real(kind=WP) :: vx, vy + logical :: do_overz +#include "associate_part_def.h" +#include "associate_mesh_def.h" +#include "associate_part_ass.h" +#include "associate_mesh_ass.h" + ! + !___________________________________________________________________________ + do_overz = .True. + if (present(do_overz_in)) do_overz = do_overz_in + + !___________________________________________________________________________ + ! Do interpolation for 2d vector data e.g 2d gradient (2, elem) + if (size(data_e, 1) == 2) then + do node = 1, myDim_nod2D + vx = 0.0_WP + vy = 0.0_WP + do k = 1, nod_in_elem2D_num(node) + elem = nod_in_elem2D(k, node) + vx = vx + data_e(1, elem) * elem_area(elem) + vy = vy + data_e(2, elem) * elem_area(elem) + end do + data_n(1, node)=vx/3.0_WP/areasvol(1, node) + data_n(2, node)=vy/3.0_WP/areasvol(1, node) + end do + + !___________________________________________________________________________ + ! Do interpolation over vertical depth dimension consider bottom topography (nz,elem) + else if (do_overz) then + do node = 1, myDim_nod2D + nl1 = nlevels_nod2D(node)-1 + ul1 = ulevels_nod2D(node) + do nz = ul1, nl1 + vx = 0.0_WP + do k = 1, nod_in_elem2D_num(node) + elem = nod_in_elem2D(k, node) + if( nz.LE.(nlevels(elem)-1) .and. nz.GE.(ulevels(elem))) then + vx = vx + data_e(nz, elem) * elem_area(elem) + endif + end do + data_n(nz, node)=vx/3.0_WP/areasvol(nz, node) + end do + end do + + !___________________________________________________________________________ + ! Do interpolation along spectral domain no bottom topography to consider (nfbin, elem) + else + ul1=1 + nl1=size(data_e,1) + do node = 1, myDim_nod2D + do nz = ul1+1, nl1-1 + vx = 0.0_WP + do k = 1, nod_in_elem2D_num(node) + elem = nod_in_elem2D(k, node) + vx = vx + data_e(nz, elem) * elem_area(elem) + end do + data_n(nz, node)=vx/3.0_WP/areasvol(1, node) + end do + end do + end if + +end subroutine interp_e2n_2d + + +! +! +!_______________________________________________________________________________ +! interpolate from elem to nodes 1d (elem) --> (node) +subroutine interp_e2n_1d(data_e, data_n, mesh, partit) + use MOD_MESH + USE MOD_PARTIT + USE MOD_PARSUP + use o_param, only: WP + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + real(kind=WP) , intent(in ), dimension(:) :: data_e + real(kind=WP) , intent(inout), dimension(:) :: data_n + type(t_mesh) , intent(in ), target :: mesh + type(t_partit) , intent(inout), target :: partit + !___LOCAL VARIABLES_____________________________________________________ + integer :: node, elem, nz, nl1, ul1, k + real(kind=WP) :: vx +#include "associate_part_def.h" +#include "associate_mesh_def.h" +#include "associate_part_ass.h" +#include "associate_mesh_ass.h" + ! + !___________________________________________________________________________ + ! Do interpolation for 1d vector data (elem) --> (node) + do node = 1, myDim_nod2D + vx = 0.0_WP + do k = 1, nod_in_elem2D_num(node) + elem = nod_in_elem2D(k, node) + vx = vx + data_e(elem) * elem_area(elem) + data_n(node)=vx/3.0_WP/areasvol(1, node) + end do + end do +end subroutine interp_e2n_1d + +end module g_interp \ No newline at end of file From 307b2f8b96cd233d615c90ea5c6680197cfd77a6 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:41:11 +0100 Subject: [PATCH 10/63] change interface for subroutine find_up_downwind_triangles --- src/oce_muscl_adv.F90 | 49 +++++++++++++---------- src/oce_tracer_mod.F90 | 89 ++++++++++++++++++++++++++++++------------ 2 files changed, 92 insertions(+), 46 deletions(-) diff --git a/src/oce_muscl_adv.F90 b/src/oce_muscl_adv.F90 index cb3c0638a..052f08828 100755 --- a/src/oce_muscl_adv.F90 +++ b/src/oce_muscl_adv.F90 @@ -1,13 +1,15 @@ module find_up_downwind_triangles_interface interface - subroutine find_up_downwind_triangles(twork, partit, mesh) + subroutine find_up_downwind_triangles(partit, mesh, edge_up_dn_tri, edge_up_dn_grad ) use MOD_MESH USE MOD_PARTIT USE MOD_PARSUP use MOD_TRACER - type(t_mesh), intent(in) , target :: mesh + type(t_mesh), intent(inout) , target :: mesh type(t_partit), intent(inout), target :: partit - type(t_tracer_work), intent(inout), target :: twork +! type(t_tracer_work), intent(inout), target :: twork + integer , intent(inout), allocatable,dimension(:,:) :: edge_up_dn_tri + real(kind=WP), intent(inout), allocatable,dimension(:,:,:), optional :: edge_up_dn_grad end subroutine find_up_downwind_triangles end interface end module find_up_downwind_triangles_interface @@ -53,7 +55,7 @@ subroutine muscl_adv_init(twork, partit, mesh) !___________________________________________________________________________ ! find upwind and downwind triangle for each local edge - call find_up_downwind_triangles(twork, partit, mesh) + call find_up_downwind_triangles(partit, mesh, twork%edge_up_dn_tri, twork%edge_up_dn_grad) !___________________________________________________________________________ nn_size=0 @@ -159,7 +161,7 @@ end SUBROUTINE muscl_adv_init ! ! !_______________________________________________________________________________ -SUBROUTINE find_up_downwind_triangles(twork, partit, mesh) +SUBROUTINE find_up_downwind_triangles(partit, mesh, edge_up_dn_tri, edge_up_dn_grad) USE MOD_MESH USE MOD_PARTIT USE MOD_PARSUP @@ -174,17 +176,19 @@ SUBROUTINE find_up_downwind_triangles(twork, partit, mesh) real(kind=WP), allocatable :: coord_elem(:, :,:), temp(:) integer, allocatable :: temp_i(:), e_nodes(:,:) -type(t_mesh), intent(in) , target :: mesh +type(t_mesh), intent(inout), target :: mesh type(t_partit), intent(inout), target :: partit -type(t_tracer_work), intent(inout), target :: twork +! type(t_tracer_work), intent(inout), target :: twork +integer , intent(inout), allocatable, dimension(:,:) :: edge_up_dn_tri +real(kind=WP), intent(inout), allocatable, dimension(:,:,:), optional :: edge_up_dn_grad #include "associate_part_def.h" #include "associate_mesh_def.h" #include "associate_part_ass.h" #include "associate_mesh_ass.h" -allocate(twork%edge_up_dn_tri(2,myDim_edge2D)) -allocate(twork%edge_up_dn_grad(4,nl-1,myDim_edge2D)) -twork%edge_up_dn_tri=0 +allocate(edge_up_dn_tri(2,myDim_edge2D)) +edge_up_dn_tri=0 + ! ===== ! In order that this procedure works, we need to know nodes and their coordinates ! on the extended set of elements (not only my, but myDim+eDim+eXDim) @@ -275,15 +279,15 @@ SUBROUTINE find_up_downwind_triangles(twork, partit, mesh) ! Since b and c are the sides of triangle, |ab|0.0_WP).and.(ax>0.0_WP).and.(axab)) then - twork%edge_up_dn_tri(1,n)=elem + edge_up_dn_tri(1,n)=elem cycle endif if((ab==ax).or.(ax==0.0_WP)) then - twork%edge_up_dn_tri(1,n)=elem + edge_up_dn_tri(1,n)=elem cycle endif END DO @@ -318,15 +322,15 @@ SUBROUTINE find_up_downwind_triangles(twork, partit, mesh) ! Since b and c are the sides of triangle, |ab|0.0_WP).and.(ax>0.0_WP).and.(axab)) then - twork%edge_up_dn_tri(2,n)=elem + edge_up_dn_tri(2,n)=elem cycle endif if((ab==ax).or.(ax==0.0)) then - twork%edge_up_dn_tri(2,n)=elem + edge_up_dn_tri(2,n)=elem cycle endif END DO @@ -340,14 +344,19 @@ SUBROUTINE find_up_downwind_triangles(twork, partit, mesh) ! Count the number of 'good' edges: !k=0 !DO n=1, myDim_edge2D -! if((twork%edge_up_dn_tri(1,n).ne.0).and.(twork%edge_up_dn_tri(2,n).ne.0)) k=k+1 +! if((edge_up_dn_tri(1,n).ne.0).and.(edge_up_dn_tri(2,n).ne.0)) k=k+1 !END DO + +if (present(edge_up_dn_grad)) then + allocate(edge_up_dn_grad(4,nl-1,myDim_edge2D)) !$OMP PARALLEL DO -DO n=1, myDim_edge2D - twork%edge_up_dn_grad(:, :, n)=0.0_WP -END DO + DO n=1, myDim_edge2D + edge_up_dn_grad(:, :, n)=0.0_WP + END DO !$OMP END PARALLEL DO +end if + deallocate(e_nodes, coord_elem) end SUBROUTINE find_up_downwind_triangles ! diff --git a/src/oce_tracer_mod.F90 b/src/oce_tracer_mod.F90 index 2fb963fe0..7646bff1b 100755 --- a/src/oce_tracer_mod.F90 +++ b/src/oce_tracer_mod.F90 @@ -124,11 +124,11 @@ SUBROUTINE init_tracers_AB(tr_num, tracers, partit, mesh) if (flag_debug .and. partit%mype==0) print *, achar(27)//'[38m'//' --> call tracer_gradient_elements'//achar(27)//'[0m' !PS call tracer_gradient_elements(tracers%data(tr_num)%valuesAB, partit, mesh) - call tracer_gradient_elements(tracers%data(tr_num)%values, partit, mesh) + call tracer_gradient_elements(tracers%data(tr_num)%values, tr_xy, partit, mesh) call exchange_elem_begin(tr_xy, partit) if (flag_debug .and. partit%mype==0) print *, achar(27)//'[38m'//' --> call tracer_gradient_z'//achar(27)//'[0m' - call tracer_gradient_z(tracers%data(tr_num)%values, partit, mesh) !WHY NOT AB HERE? DSIDOREN! + call tracer_gradient_z(tracers%data(tr_num)%values, tr_z, partit, mesh) !WHY NOT AB HERE? DSIDOREN! call exchange_elem_end(partit) ! tr_xy used in fill_up_dn_grad !$OMP BARRIER @@ -139,14 +139,14 @@ SUBROUTINE init_tracers_AB(tr_num, tracers, partit, mesh) call exchange_nod_end(partit) ! tr_z halos should have arrived by now. if (flag_debug .and. partit%mype==0) print *, achar(27)//'[38m'//' --> call tracer_gradient_elements'//achar(27)//'[0m' - call tracer_gradient_elements(tracers%data(tr_num)%values, partit, mesh) !redefine tr_arr to the current timestep + call tracer_gradient_elements(tracers%data(tr_num)%values, tr_xy, partit, mesh) !redefine tr_arr to the current timestep call exchange_elem(tr_xy, partit) END SUBROUTINE init_tracers_AB ! ! !======================================================================= -SUBROUTINE tracer_gradient_elements(ttf, partit, mesh) +SUBROUTINE tracer_gradient_elements(ttf, ttf_grad, partit, mesh, do_overz_in) !computes elemental gradient of tracer USE MOD_MESH USE MOD_PARTIT @@ -156,42 +156,76 @@ SUBROUTINE tracer_gradient_elements(ttf, partit, mesh) USE o_ARRAYS IMPLICIT NONE - type(t_mesh), intent(in), target :: mesh - type(t_partit), intent(inout), target :: partit - real(kind=WP) :: ttf(mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D) - integer :: elem, elnodes(3) - integer :: nz, nzmin, nzmax + real(kind=WP) , intent(in) , dimension(:,:) :: ttf !(mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(inout), dimension(:,:,:) :: ttf_grad + type(t_mesh) , intent(in) , target :: mesh + type(t_partit), intent(inout), target :: partit + logical , intent(in) , optional :: do_overz_in + integer :: elem, elnodes(3) + integer :: nz, nzmin, nzmax + logical :: do_overz #include "associate_part_def.h" #include "associate_mesh_def.h" #include "associate_part_ass.h" #include "associate_mesh_ass.h" + + ! + !___________________________________________________________________________ + do_overz = .True. + if (present(do_overz_in)) do_overz = do_overz_in + ! + !___________________________________________________________________________ + if (do_overz) then #ifndef ENABLE_OPENACC !$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(elem, elnodes, nz, nzmin, nzmax) #else !ACC PARALLEL LOOP DEFAULT(PRESENT) PRIVATE(elnodes) #endif - DO elem=1, myDim_elem2D - elnodes=elem2D_nodes(:,elem) - nzmin = ulevels(elem) - nzmax = nlevels(elem) - !!PS DO nz=1, nlevels(elem)-1 - DO nz=nzmin, nzmax-1 - tr_xy(1,nz, elem)=sum(gradient_sca(1:3,elem)*ttf(nz,elnodes)) - tr_xy(2,nz, elem)=sum(gradient_sca(4:6,elem)*ttf(nz,elnodes)) - END DO - END DO + do elem=1, myDim_elem2D + elnodes=elem2D_nodes(:,elem) + nzmin = ulevels(elem) + nzmax = nlevels(elem) + do nz=nzmin, nzmax-1 + ttf_grad(1,nz, elem)=sum(gradient_sca(1:3,elem)*ttf(nz,elnodes)) + ttf_grad(2,nz, elem)=sum(gradient_sca(4:6,elem)*ttf(nz,elnodes)) + end do + end do #ifndef ENABLE_OPENACC !$OMP END PARALLEL DO #else !ACC END PARALLEL LOOP #endif + + ! + !___________________________________________________________________________ + else ! (do_overz==.False.) +#ifndef ENABLE_OPENACC +!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(elem, elnodes, nz, nzmin, nzmax) +#else +!ACC PARALLEL LOOP DEFAULT(PRESENT) PRIVATE(elnodes) +#endif + nzmin = 1 + nzmax = size(ttf, 1) + do elem=1, myDim_elem2D + elnodes=elem2D_nodes(:,elem) + do nz=nzmin+1, nzmax-1 + ttf_grad(1,nz, elem)=sum(gradient_sca(1:3,elem)*ttf(nz,elnodes)) + ttf_grad(2,nz, elem)=sum(gradient_sca(4:6,elem)*ttf(nz,elnodes)) + end do + end do +#ifndef ENABLE_OPENACC +!$OMP END PARALLEL DO +#else +!ACC END PARALLEL LOOP +#endif + end if END SUBROUTINE tracer_gradient_elements ! ! !======================================================================================== -SUBROUTINE tracer_gradient_z(ttf, partit, mesh) +SUBROUTINE tracer_gradient_z(ttf, ttf_grad, partit, mesh) !computes vertical gradient of tracer USE MOD_MESH USE MOD_PARTIT @@ -201,9 +235,12 @@ SUBROUTINE tracer_gradient_z(ttf, partit, mesh) USE o_ARRAYS USE g_CONFIG IMPLICIT NONE - type(t_mesh), intent(in), target :: mesh - type(t_partit), intent(inout), target :: partit - real(kind=WP) :: ttf(mesh%nl-1,partit%myDim_nod2D+partit%eDim_nod2D) + + real(kind=WP), intent(in ), dimension(:,:) :: ttf !(mesh%nl-1,partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(inout), dimension(:,:) :: ttf_grad !(mesh%nl-1,partit%myDim_nod2D+partit%eDim_nod2D) + type(t_partit), intent(inout), target :: partit + type(t_mesh), intent(in), target :: mesh + real(kind=WP) :: dz integer :: n, nz, nzmin, nzmax @@ -221,10 +258,10 @@ SUBROUTINE tracer_gradient_z(ttf, partit, mesh) nzmin=ulevels_nod2D(n) DO nz=nzmin+1, nzmax-1 dz=0.5_WP*(hnode(nz-1,n)+hnode(nz,n)) - tr_z(nz, n)=(ttf(nz-1,n)-ttf(nz,n))/dz + ttf_grad(nz, n)=(ttf(nz-1,n)-ttf(nz,n))/dz END DO - tr_z(nzmin, n)=0.0_WP - tr_z(nzmax, n)=0.0_WP + ttf_grad(nzmin, n)=0.0_WP + ttf_grad(nzmax, n)=0.0_WP END DO #ifndef ENABLE_OPENACC !$OMP END PARALLEL DO From 9daed55290d337463d46de5dd9b3333b3518328c Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:42:15 +0100 Subject: [PATCH 11/63] change interface for subroutine find_up_downwind_triangle and tracer_gradient_z --- src/gen_modules_diag.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/gen_modules_diag.F90 b/src/gen_modules_diag.F90 index 0fc940790..db02cc421 100644 --- a/src/gen_modules_diag.F90 +++ b/src/gen_modules_diag.F90 @@ -1251,9 +1251,9 @@ subroutine compute_dvd(mode, dynamics, tracers, partit, mesh) !_______________________________________________________________________ ! need to recompute tracer gradients - call tracer_gradient_elements(trold, partit, mesh) + call tracer_gradient_elements(trold, tr_xy, partit, mesh) call exchange_elem(tr_xy, partit) - call tracer_gradient_z(trold, partit, mesh) + call tracer_gradient_z(trold, tr_z, partit, mesh) call exchange_nod(tr_z, partit) !=== DVD Knut Klingbeil et al. 2014 ==================================== From 246003cb67dd8a0aa9341177161d02fc18e8baf7 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:43:45 +0100 Subject: [PATCH 12/63] add routine for horizontal/vertical superbee advection, this is not tested yet, it is discarded for the moment for the idemix2 implementation --- src/oce_adv_tra_driver.F90 | 2 +- src/oce_adv_tra_hor.F90 | 419 +++++++++++++++++++++++++++++++++++++ src/oce_adv_tra_ver.F90 | 201 +++++++++++++++++- 3 files changed, 615 insertions(+), 7 deletions(-) diff --git a/src/oce_adv_tra_driver.F90 b/src/oce_adv_tra_driver.F90 index 9b9606ea8..f45089849 100644 --- a/src/oce_adv_tra_driver.F90 +++ b/src/oce_adv_tra_driver.F90 @@ -326,7 +326,7 @@ subroutine do_oce_adv_tra(dt, vel, w, wi, we, tr_num, dynamics, tracers, partit, CASE('CDIFF') call adv_tra_ver_cdiff( pwvel, ttfAB, partit, mesh, adv_flux_ver, o_init_zero=do_zero_flux) CASE('PPM') - call adv_tra_vert_ppm(dt, pwvel, ttfAB, partit, mesh, adv_flux_ver, o_init_zero=do_zero_flux) + call adv_tra_ver_ppm(dt, pwvel, ttfAB, partit, mesh, adv_flux_ver, o_init_zero=do_zero_flux) CASE('UPW1') call adv_tra_ver_upw1 ( pwvel, ttfAB, partit, mesh, adv_flux_ver, o_init_zero=do_zero_flux) CASE DEFAULT !unknown diff --git a/src/oce_adv_tra_hor.F90 b/src/oce_adv_tra_hor.F90 index 3586f683c..730fbb11a 100644 --- a/src/oce_adv_tra_hor.F90 +++ b/src/oce_adv_tra_hor.F90 @@ -56,6 +56,23 @@ subroutine adv_tra_hor_mfct(vel, ttf, partit, mesh, num_ord, flux, edge_up_dn_gr real(kind=WP), intent(in) :: edge_up_dn_grad(4, mesh%nl-1, partit%myDim_edge2D) logical, optional :: o_init_zero end subroutine adv_tra_hor_mfct + + ! superbee advection num_ord=0: 2nd order in space num_ord=1: 2nd order in space + ! and time through Direct space-time scheme + subroutine adv_tra_hor_spbee(vel, ttf, partit, mesh, num_ord, flux, edge_up_dn_grad, flag_posdef, o_init_zero) + use MOD_MESH + USE MOD_PARTIT + USE MOD_PARSUP + type(t_partit), intent(inout), target :: partit + type(t_mesh) , intent(in) , target :: mesh + real(kind=WP) , intent(in) :: num_ord ! num_ord is the fraction of fourth-order contribution in the solution + real(kind=WP) , intent(in) :: ttf( mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(in) :: vel(2, mesh%nl-1, partit%myDim_elem2D+partit%eDim_elem2D) + real(kind=WP) , intent(inout) :: flux( mesh%nl-1, partit%myDim_edge2D) + real(kind=WP) , intent(in) :: edge_up_dn_grad(4, mesh%nl-1, partit%myDim_edge2D) + logical , intent(in) :: flag_posdef + logical , optional :: o_init_zero + end subroutine adv_tra_hor_spbee end interface end module oce_adv_tra_hor_interfaces ! @@ -832,3 +849,405 @@ subroutine adv_tra_hor_mfct(vel, ttf, partit, mesh, num_ord, flux, edge_up_dn_gr !$ACC END PARALLEL LOOP #endif end subroutine adv_tra_hor_mfct + + + +! +! +!_______________________________________________________________________________ +! horizontal advection second order in space (2nd oprder in time) using superbee +! slope limiter +subroutine adv_tra_hor_spbee( & + vel , & + ttf , & + partit , & + mesh , & + num_ord , & + flux , & + edge_up_dn_grad , & + flag_posdef , & + o_init_zero & + ) + use MOD_MESH + use MOD_TRACER + use MOD_PARTIT + use MOD_PARSUP + use g_config, only: dt + use g_comm_auto + implicit none + !___INPUT/OUTPUT VARIABLES__________________________________________________ + type(t_partit) , intent(inout), target :: partit + type(t_mesh) , intent(in) , target :: mesh + real(kind=WP) , intent(in) :: ttf( mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(in) :: vel(2, mesh%nl-1, partit%myDim_elem2D+partit%eDim_elem2D) + real(kind=WP) , intent(inout) :: flux( mesh%nl-1, partit%myDim_edge2D) + real(kind=WP) , intent(in) :: edge_up_dn_grad(4, mesh%nl-1, partit%myDim_edge2D) + real(kind=WP) , intent(in) :: num_ord + logical , intent(in) :: flag_posdef + logical , optional :: o_init_zero + !___LOCAL VARIABLES_________________________________________________________ + logical :: l_init_zero, flag_2ndord_time + real(kind=WP) :: dx1, dy1, dx2, dy2, dx0, dy0, dxdy12(2), dt_over_edlen + real(kind=WP) :: n_x, n_y, nlen, inv_nlen + real(kind=WP) :: u1, u2, v1, v2, Ue + real(kind=WP) :: vflux, cfl, T12vflux + integer :: edel(2), ednodes(2), edge, edel0 + integer :: nz, nl1, nl2, nl12, nu1, nu2, nu12, nzs, nze +#include "associate_part_def.h" +#include "associate_mesh_def.h" +#include "associate_part_ass.h" +#include "associate_mesh_ass.h" + + !___________________________________________________________________________ + if (num_ord == 1.0_WP) then + flag_2ndord_time = .True. + else + flag_2ndord_time = .False. + end if + + !___________________________________________________________________________ + l_init_zero=.true. + if (present(o_init_zero)) then + l_init_zero=o_init_zero + end if + if (l_init_zero) then +#ifndef ENABLE_OPENACC + !$OMP PARALLEL DO +#else + !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) +#endif + do edge=1, myDim_edge2D + do nz=1, mesh%nl-1 + flux(nz,edge)=0.0_WP + end do + end do +#ifndef ENABLE_OPENACC + !$OMP END PARALLEL DO +#else + !$ACC END PARALLEL LOOP +#endif + end if + + !___________________________________________________________________________ +!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(edge, ednodes, edel, edel0, & +!$OMP nz, nl1, nl2, nl12, nu1, nu2, nu12, nzs, nze, & +!$OMP dx1, dy1, dx2, dy2, dxdy12, dx0, dy0, & +!$OMP vflux, cfl, dt_over_edlen, T12vflux, & +!$OMP u1, u2, v1, v2, n_x, n_y, Ue) +!$OMP DO + do edge=1, myDim_edge2D + !_______________________________________________________________________ + ! local indice of nodes that span up edge ed + ednodes= edges(:,edge) + + ! local index of element that contribute to edge + edel = edge_tri(:,edge) + + nl1 = nlevels(edel(1))-1 + ! nu1 ... upper index of ocean default = 1 but can consider cavity !=1 + nu1 = ulevels(edel(1)) + + ! edge_cross_dxdy(1:2,ed)... dx,dy distance from center of edge to + ! element centroid el(1) --> needed to calc flux perpedicular to edge from elem el(1) + dx1 = edge_cross_dxdy(1,edge) + dy1 = edge_cross_dxdy(2,edge) + + ! length of edge dx dy + dxdy12 = edge_dxdy(:,edge)*r_earth + + !_______________________________________________________________________ + ! same parameter but for other element el(2) that contributes to edge ed + ! if el(2)==0 than edge is boundary edge + nl2 = 0 + nu2 = 0 + dx2 = 0.0_WP + dy2 = 0.0_WP + if(edel(2)>0) then + nl2 = nlevels(edel(2))-1 + nu2 = ulevels(edel(2)) + dx2 = edge_cross_dxdy(3,edge) + dy2 = edge_cross_dxdy(4,edge) + dxdy12(1)= dxdy12(1) * (elem_cos(edel(1)) + elem_cos(edel(2))) * 0.5_WP + + ! compute mean edge-segment normal vector + ! (dx1,dy1) + ! ^ + ! │ + ! ├──> (dy1,-dx1) + ! │ + ! ●━━━━━━━━━━━┿━━━━━━━━━━►● + ! │ + ! (dy2,-dx2) <──┼──> (-dy2,dx2) + ! │ + ! v + ! (dx2,dy2) + ! + n_x = ( dy1 + (-dy2))/2 + n_y = ((-dx1) + dx2 )/2 + + else + dxdy12(1)= dxdy12(1) * elem_cos(edel(1)) + ! compute edge-segment normal vector + n_x = dy1 + n_y = -dx1 + end if + + ! normalize n_vec=(n_x, n_y) + nlen = sqrt(n_x**2 + n_y**2) + inv_nlen = 1/max(nlen, tiny(1.0_WP)) + n_x = n_x * inv_nlen + n_y = n_y * inv_nlen + + dt_over_edlen = dt/sqrt(dxdy12(1)**2 + dxdy12(2)**2) + + !_______________________________________________________________________ + ! compute volume fluxes + nu12=max(nu1,nu2) + nl12=min(nl1,nl2) + + !_______________________________________________________________________ + ! loop over upper uncommon edge levels between edel(1) and edel(2) + ! --> edge is boundary edge, edel(2) does not exist + ! In this case the entire advection of this edge is only handled by the first + ! loop the other two loop will be skiped + if (edel(2) <= 0) then + nzs = nu1 + nze = nl1 + edel0 = edel(1) + dx0 = -dx1 + dy0 = dy1 + ! --> edge is interior edge + elseif (nu1 < nu2) then + nzs = nu1 + nze = nu12-1 + edel0 = edel(1) + dx0 = -dx1 + dy0 = dy1 + ! --> edge is interior edge + else ! (nu1 > nu2) + nzs = nu2 + nze = nu12-1 + edel0 = edel(2) + dx0 = dx2 + dy0 = -dy2 + end if + do nz=nzs, nze + ! compute volume flux across the segments from el(1) + u1 = vel(1, nz, edel0) + v1 = vel(2, nz, edel0) + vflux = (v1*dx0 + u1*dy0)*helem(nz,edel0) + + ! compute approximated edge centered and along edge projected + ! mean velocity --> need to add component to make second order + ! in time + Ue = abs( (u1 * n_x) + (v1 * n_y) ) + cfl = Ue*dt_over_edlen + + ! compute upwind, downwind edge centered tracers volume flux, based on + ! gradient projected ttfm1 and ttfp2 values and applied superbee limiter + T12vflux = spbee_compute_T12vflux(ttf(nz, ednodes(1)), ttf(nz, ednodes(2)), & + edge_up_dn_grad(:, nz, edge), & + vflux, cfl, dxdy12, flag_2ndord_time, flag_posdef) + + flux(nz, edge)= -T12vflux - flux(nz, edge) + end do ! --> do nz=nu0, nu12-1 + + !_______________________________________________________________________ + ! if edge is boundary edge skip this code block everything is handled by the + ! first loop + if (edel(2)>0) then + !_______________________________________________________________________ + ! loop over common edge depth levels between edel(1) and edel(2) + do nz = nu12, nl12 + ! compute volume flux across the segments from el(1) + u1 = vel(1, nz, edel(1)) + v1 = vel(2, nz, edel(1)) + u2 = vel(1, nz, edel(2)) + v2 = vel(2, nz, edel(2)) + vflux = (-v1*dx1 + u1*dy1)*helem(nz,edel(1)) + ( v2*dx2 - u2*dy2)*helem(nz,edel(2)) + + ! compute approximated edge centered and along edge projected + ! mean velocity --> need to add component to make second order + ! in time + Ue = abs( 0.5_WP*( u1 + u2 )*n_x + 0.5_WP*( v1 + v2 )*n_y ) + cfl = Ue*dt_over_edlen + + ! compute upwind, downwind edge centered tracers volume flux, based on + ! gradient projected ttfm1 and ttfp2 values and applied superbee limiter + T12vflux = spbee_compute_T12vflux(ttf(nz, ednodes(1)), ttf(nz, ednodes(2)), & + edge_up_dn_grad(:, nz, edge), & + vflux, cfl, dxdy12, flag_2ndord_time, flag_posdef) + + flux(nz, edge)= -T12vflux - flux(nz, edge) + end do !--> do nz=nu12, nl12 + + !_______________________________________________________________________ + ! loop over lower uncommon edge levels between edel(1) and edel(2) + if (nl1 > nl2) then + nzs = nl12+1 + nze = nl1 + edel0 = edel(1) + dx0 = -dx1 + dy0 = dy1 + else ! (nl1 < nl2) + nzs = nl12+1 + nze = nl2 + edel0 = edel(2) + dx0 = dx2 + dy0 = -dy2 + end if + do nz = nzs, nze + ! compute volume flux across the segments from el(1) + u1 = vel(1, nz, edel0) + v1 = vel(2, nz, edel0) + vflux = (v1*dx0 + u1*dy0)*helem(nz,edel0) + + ! compute approximated edge centered and along edge projected + ! mean velocity --> need to add component to make second order + ! in time + Ue = abs( u1 * n_x + v1 * n_y) + cfl = Ue*dt_over_edlen + + ! compute upwind, downwind edge centered tracers volume flux, based on + ! gradient projected ttfm1 and ttfp2 values and applied superbee limiter + T12vflux = spbee_compute_T12vflux(ttf(nz, ednodes(1)), ttf(nz, ednodes(2)), & + edge_up_dn_grad(:, nz, edge), & + vflux, cfl, dxdy12, flag_2ndord_time, flag_posdef) + + flux(nz, edge)= -T12vflux - flux(nz, edge) + end do ! --> do nz=nl12+1,nl1 + end if ! --> if (edel(2)>0) then + end do !--> do edge=1, myDim_edge2D +!$OMP END DO +!$OMP END PARALLEL + + contains + + ! + ! + !___________________________________________________________________________ + ! superbee slope limiter + pure elemental real(kind=WP) function spbee_limiter(R) result(Cr) + real(kind=WP), intent(in) :: R + Cr = max(0._WP, min( min(2._WP*R, 0.5_WP+R/2._WP), 2._WP )) + end function spbee_limiter + + ! + ! + !___________________________________________________________________________ + ! compute edge centered superbee limited tracer volume flux + pure real(kind=WP) function spbee_compute_T12vflux(& + ttf0 , & + ttfp1 , & + ttf_grad_ed , & + vflux , & + cfl , & + dxdy12 , & + flag_2ndord_time , & + flag_posdef & + ) result(T12vflux) + real(kind=WP), intent(in) :: ttf0, ttfp1, ttf_grad_ed(4), & + vflux, cfl, dxdy12(2) + logical , intent(in) :: flag_2ndord_time, flag_posdef + real(kind=WP) :: dttf0p1, ttfp2, ttfm1, R, Cr, vfabs, Tmean1, Tmean2 + + !_______________________________________________________________________ + ! compute tracer difference allong edge + dttf0p1 = ttfp1-ttf0 + + !_______________________________________________________________________ + ! tracer Slope Ratio Calculation for upwind augmented point + ! + ! o + ! ○._ .´ `. .-○ + ! | `._ .´ ^ dx1,dy1 .-´ | + ! | `._ .´ ├─> `. .-´ | + ! | □ `●━━━━━━┿━━━━━►●´----□---|-->●ttf_p2 + ! | .-´│`. <─┤ .´│`._ | + ! | .-´ dx2,dy2 v .´ │ `._ | + ! ○.-´ │ `. .´ │ `._○ + ! │ o │ + ! ├------------>┤ + ! │ dxdy12 │ + ! │ dttf0p1 │ + ! v v + ! ttf_0 ttf_grad_ed(3:4) + ! ttf_p1 + ttfp2 = ttf0 & + + 2.0_WP * dxdy12(1)*ttf_grad_ed(3) & + + 2.0_WP * dxdy12(2)*ttf_grad_ed(4) + + ! considering here we want to advect energy we can ensure the + ! variable to be positiv definit + ttfp2 = merge(max(0.0_WP,ttfp2), ttfp2, flag_posdef) + + ! compute tracer slope + R = (ttfp1-ttfp2)/(-dttf0p1+small) + + ! apply superbee limiter + Cr = spbee_limiter(R) + + ! construct edge centered tracer value + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dx ]_Limited * dx/2 + ! --> this is seconds order in space, but first order in time + ! + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dx ]_Limited * (dx/2 - u_ed*n_ed*dt/2) + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dx ]_Limited * dx/2 *(1 - CFL_h) + ! --> becomes second order in space and time (Direct space-time scheme) + ! --> u_ed = (vel(el(1)) + vel(el(2)))/2 + ! --> n_ed = (n_1 + n_2)/2 + ! --> CFL_h = u_ed*n_ed*dt/dx + Tmean2 = ttfp1 + 0.5_WP * Cr * (-dttf0p1) * (1.0_WP-merge(cfl, 0.0_WP, flag_2ndord_time)) + + !_______________________________________________________________________ + ! tracer Slope Ratio Calculation for downwind augmented point + ! + ! o + ! ○._ .´ `. .-○ + ! | `._ .´ ^ dx1,dy1 .-´ | + ! | `._ .´ ├─> `. .-´ | + ! ttf_m1●<--|---□----`●━━━━━━┿━━━━━►●´ □ | + ! | .-´│`. <─┤ .´│`._ | + ! | .-´ dx2,dy2 v .´ │ `._ | + ! ○.-´ │ `. .´ │ `._○ + ! │ o │ + ! ├------------>┤ + ! │ dxdy12 │ + ! │ dttf0p1 │ + ! v v + ! ttf_grad_ed(1:2) ttf_p1 + ! ttf0 + ttfm1 = ttfp1 & + - 2.0_WP * dxdy12(1)*ttf_grad_ed(1) & + - 2.0_WP * dxdy12(2)*ttf_grad_ed(2) + + ! considering here we want to advect energy we can ensure the + ! variable to be positiv definit + ttfm1 = merge(max(0.0_WP,ttfm1), ttfm1, flag_posdef) + + ! compute tracer slope + R = (ttf0-ttfm1)/(dttf0p1+small) + + ! apply superbee limiter + Cr = spbee_limiter(R) + + ! construct edge centered tracer value + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dx ]_Limited * dx/2 + ! --> this is seconds order in space, but first order in time + ! + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dx ]_Limited * (dx/2 - u_ed*n_ed*dt/2) + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dx ]_Limited * dx/2 *(1 - CFL_h) + ! --> becomes second order in space and time (Direct space-time scheme) + ! --> u_ed = (vel(el(1)) + vel(el(2)))/2 + ! --> n_ed = (n_1 + n_2)/2 + ! --> CFL_h = u_ed*n_ed*dt/dx + Tmean1 = ttf0 + 0.5_WP * Cr * (dttf0p1) * (1.0_WP-merge(cfl, 0.0_WP, flag_2ndord_time)) + + ! compute upwind/downwind related tracer volume flux + vfabs = abs(vflux) + T12vflux= 0.5_WP*( (vflux+vfabs)*Tmean1+ (vflux-vfabs)*Tmean2) + end function spbee_compute_T12vflux + +end subroutine adv_tra_hor_spbee + + diff --git a/src/oce_adv_tra_ver.F90 b/src/oce_adv_tra_ver.F90 index 1cebcf089..241437332 100644 --- a/src/oce_adv_tra_ver.F90 +++ b/src/oce_adv_tra_ver.F90 @@ -2,7 +2,7 @@ module oce_adv_tra_ver_interfaces interface ! implicit 1st order upwind vertical advection with to solve for fct_LO ! updates the input tracer ttf - subroutine adv_tra_vert_impl(dt, w, ttf, partit, mesh) + subroutine adv_tra_ver_impl(dt, w, ttf, partit, mesh) use mod_mesh USE MOD_PARTIT USE MOD_PARSUP @@ -11,7 +11,7 @@ subroutine adv_tra_vert_impl(dt, w, ttf, partit, mesh) type(t_mesh), intent(in), target :: mesh real(kind=WP), intent(inout) :: ttf(mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D) real(kind=WP), intent(in) :: W (mesh%nl, partit%myDim_nod2D+partit%eDim_nod2D) - end subroutine adv_tra_vert_impl + end subroutine adv_tra_ver_impl !=============================================================================== ! 1st order upwind (explicit) ! returns flux given at vertical interfaces of scalar volumes @@ -53,7 +53,7 @@ end subroutine adv_tra_ver_qr4c ! IF o_init_zero=.TRUE. : flux will be set to zero before computation ! IF o_init_zero=.FALSE. : flux=flux-input flux ! flux is not multiplied with dt - subroutine adv_tra_vert_ppm(dt, w, ttf, partit, mesh, flux, o_init_zero) + subroutine adv_tra_ver_ppm(dt, w, ttf, partit, mesh, flux, o_init_zero) use MOD_MESH USE MOD_PARTIT USE MOD_PARSUP @@ -65,7 +65,7 @@ subroutine adv_tra_vert_ppm(dt, w, ttf, partit, mesh, flux, o_init_zero) real(kind=WP), intent(in) :: W (mesh%nl, partit%myDim_nod2D+partit%eDim_nod2D) real(kind=WP), intent(inout) :: flux(mesh%nl, partit%myDim_nod2D) logical, optional :: o_init_zero - end subroutine adv_tra_vert_ppm + end subroutine adv_tra_ver_ppm ! central difference reconstruction (2nd order, use only with FCT) ! returns flux given at vertical interfaces of scalar volumes ! IF o_init_zero=.TRUE. : flux will be set to zero before computation @@ -84,6 +84,25 @@ subroutine adv_tra_ver_cdiff(w, ttf, partit, mesh, flux, o_init_zero) real(kind=WP), intent(inout) :: flux(mesh%nl, partit%myDim_nod2D) logical, optional :: o_init_zero end subroutine adv_tra_ver_cdiff +! superbee, slope limited reconstruction (2nd order in space and time ) +! returns flux given at vertical interfaces of scalar volumes +! IF o_init_zero=.TRUE. : flux will be set to zero before computation +! IF o_init_zero=.FALSE. : flux=flux-input flux +! flux is not multiplied with dt + subroutine adv_tra_ver_spbee(w, ttf, partit, mesh, flux, flag_2ndord_time, flag_posdef, o_init_zero) + use MOD_MESH + USE MOD_PARTIT + USE MOD_PARSUP + type(t_partit),intent(in), target :: partit + type(t_mesh), intent(in), target :: mesh + real(kind=WP) :: tvert(mesh%nl), tv + real(kind=WP), intent(in) :: ttf(mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: W (mesh%nl, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(inout) :: flux(mesh%nl, partit%myDim_nod2D) + logical , intent(in) :: flag_2ndord_time + logical , intent(in) :: flag_posdef + logical, optional :: o_init_zero + end subroutine adv_tra_ver_spbee end interface end module oce_adv_tra_ver_interfaces !=============================================================================== @@ -435,7 +454,7 @@ end subroutine adv_tra_ver_qr4c ! ! !=============================================================================== -subroutine adv_tra_vert_ppm(dt, w, ttf, partit, mesh, flux, o_init_zero) +subroutine adv_tra_ver_ppm(dt, w, ttf, partit, mesh, flux, o_init_zero) use MOD_MESH use MOD_TRACER USE MOD_PARTIT @@ -628,7 +647,7 @@ subroutine adv_tra_vert_ppm(dt, w, ttf, partit, mesh, flux, o_init_zero) ! if (mype==0) write(*,*) 'PPM overshoot statistics:', real(overshoot_counter)/real(counter) !$OMP END DO !$OMP END PARALLEL -end subroutine adv_tra_vert_ppm +end subroutine adv_tra_ver_ppm ! ! !=============================================================================== @@ -693,3 +712,173 @@ subroutine adv_tra_ver_cdiff(w, ttf, partit, mesh, flux, o_init_zero) !$OMP END DO !$OMP END PARALLEL end subroutine adv_tra_ver_cdiff + + +! +! +!_______________________________________________________________________________ +! vertical advection 2nd order in space (and time) using superbee slope limiter +subroutine adv_tra_ver_spbee( & + W , & + ttf , & + partit , & + mesh , & + flux , & + flag_2ndord_time , & + flag_posdef , & + o_init_zero & + ) + use MOD_MESH + use MOD_TRACER + use MOD_PARTIT + use MOD_PARSUP + use g_config, only: dt + use g_comm_auto + implicit none + !___INPUT/OUTPUT VARIABLES__________________________________________________ + type(t_partit),intent(inout), target :: partit + type(t_mesh), intent(in) , target :: mesh + real(kind=WP), intent(in) :: W ( mesh%nl , partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: ttf( mesh%nl-1, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(inout) :: flux(mesh%nl , partit%myDim_nod2D) + logical , intent(in) :: flag_2ndord_time + logical , intent(in) :: flag_posdef + logical , optional :: o_init_zero + !___LOCAL VARIABLES_________________________________________________________ + logical :: l_init_zero + integer :: node, nz, nzmin, nzmax + real(kind=WP) :: R, ttf0, ttfp1, dttf0p1, Tmean1, Tmean2, Cr, vflux, vfabs + real(kind=WP) :: cfl +#include "associate_part_def.h" +#include "associate_mesh_def.h" +#include "associate_part_ass.h" +#include "associate_mesh_ass.h" + + !___________________________________________________________________________ + l_init_zero=.true. + if (present(o_init_zero)) then + l_init_zero=o_init_zero + end if + if (l_init_zero) then +!$OMP PARALLEL DO + do node=1, myDim_nod2D + flux(:, node)=0.0_WP + end do +!$OMP END PARALLEL DO + end if + + !___________________________________________________________________________ +#ifndef ENABLE_OPENACC +!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, nz, nzmin, nzmax, tff0, tffp1, dttf0p1, & +!$OMP R, Cr, Tmean2, Tmean1, cfl, vflux, vfabs) +!$OMP DO +#else +!$ACC PARALLEL LOOP GANG DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) +#endif + !___________________________________________________________________________ + ! this advection does !!! NOT !!! go over the vertical dimension it goes + ! over the domain of the spectral bins + do node = 1, myDim_nod2D + nzmax=nlevels_nod2D(node) + nzmin=ulevels_nod2D(node) + + !_______________________________________________________________________ + ! vert. flux at surface layer + nz=nzmin + flux(nz,node)=-W(nz,node)*ttf(nz,node)*area(nz,node)-flux(nz,node) + + !_______________________________________________________________________ + ! vert. flux at bottom - 1 layer --> centered differences + nz=nzmax-1 + flux(nz,node)=-0.5_WP*(ttf(nz-1,node)+ttf(nz,node))*W(nz,node)*area(nz,node)-flux(nz,node) + + !_______________________________________________________________________ + ! vert. flux at bottom layer --> zero bottom flux + nz=nzmax + flux(nz,node)= 0.0_WP-flux(nz,node) + + !_______________________________________________________________________ + !loop over spectral bins +!$ACC LOOP VECTOR + do nz = nzmin+1, nzmax-2 + !___________________________________________________________________ + cfl = abs(W(nz, node)) * dt * 2.0_WP / (hnode(nz-1,node)+hnode(nz,node)) + + !___________________________________________________________________ + ! compute tracer difference + ttf0 = ttf(nz , node) + ttfp1 = ttf(nz+1, node) + dttf0p1 = ttfp1 - ttf0 + + !___________________________________________________________________ + ! tracer Slope Ratio Calculation for upwind point + ! compute tracer slope + R = (ttfp1-ttf(nz+2,node))/(-dttf0p1+small) + + ! apply superbee limiter + Cr = spbee_limiter(R) + + ! construct edge centered tracer value + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * dz/2 + ! --> this is seconds order in space, but first order in time + ! + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) + ! --> CFL = W*dt/dx + Tmean2 = ttfp1 + 0.5_WP*Cr*(-dttf0p1) * (1.0_WP-merge(cfl, 0.0_WP, flag_2ndord_time)) + + ! make sure tracer are enforced to be positive definite e.g for + ! internal wave energy + Tmean2 = merge(max(0.0_WP, Tmean2), Tmean2, flag_posdef) + + !___________________________________________________________________ + ! tracer Slope Ratio Calculation for downwind point + ! compute tracer slope + R = (ttf0-ttf(nz-1,node))/(dttf0p1+small) + + ! apply superbee limiter + Cr = spbee_limiter(R) + + ! construct edge centered tracer value + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * dz/2 + ! --> this is seconds order in space, but first order in time + ! + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) + ! --> CFL = W*dt/dx + Tmean1 = ttf0 + 0.5_WP*Cr*(dttf0p1) * (1.0_WP-merge(cfl, 0.0_WP, flag_2ndord_time)) + + ! make sure tracer are enforced to be positive definite e.g for + ! internal wave energy + Tmean1 = merge(max(0.0_WP, Tmean1), Tmean1, flag_posdef) + !___________________________________________________________________ + ! cross spectral exchange rate is related to spectral width dphi + vflux = W(nz, node) + vfabs = abs(vflux) + flux(nz, node)=-0.5_WP*((vflux+vfabs)*Tmean1 + (vflux-vfabs)*Tmean2 & + )*area(nz,node) - flux(nz, node) + + end do !--> do nz = nzmin+1, nzmax-2 +!$ACC END LOOP + end do ! --> do node = 1, myDim_nod2D +#ifndef ENABLE_OPENACC +!$OMP END DO +!$OMP END PARALLEL +#else + !$ACC END PARALLEL LOOP +#endif + + contains + + ! + ! + !___________________________________________________________________________ + ! superbee slope limiter + pure elemental real(kind=WP) function spbee_limiter(R) result(Cr) + real(kind=WP), intent(in) :: R + Cr = max(0._WP, min( min(2._WP*R, 0.5_WP+R/2._WP), 2._WP )) + end function spbee_limiter + +end subroutine adv_tra_ver_spbee + + From 09b531e735b4dc0e8e987aa87e0d265f3db1a007 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:44:37 +0100 Subject: [PATCH 13/63] small fix to src/gen_modules_dist2coast.F90 --- src/gen_modules_dist2coast.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/gen_modules_dist2coast.F90 b/src/gen_modules_dist2coast.F90 index ce54b6cc8..45ba7e180 100644 --- a/src/gen_modules_dist2coast.F90 +++ b/src/gen_modules_dist2coast.F90 @@ -198,8 +198,8 @@ subroutine find_coast_pnts(coast_lon, coast_lat, n_coast, mesh, partit) if (partit%myList_edge2D(edge) <= mesh%edge2D_in) cycle ! boundary edge ednodes = mesh%edges(:, edge) ! Check if this is a boundary edge - if (ednodes(1)<=partit%myDim_nod2D) lcl_coast_isT(ednodes(1)) = .true. - if (ednodes(2)<=partit%myDim_nod2D) lcl_coast_isT(ednodes(2)) = .true. + if (ednodes(1) >= 1 .and. ednodes(1)<=partit%myDim_nod2D) lcl_coast_isT(ednodes(1)) = .true. + if (ednodes(2) >= 1 .and. ednodes(2)<=partit%myDim_nod2D) lcl_coast_isT(ednodes(2)) = .true. end do ! How many coastal boundary point are in this partition @@ -216,7 +216,7 @@ subroutine find_coast_pnts(coast_lon, coast_lat, n_coast, mesh, partit) if (lcl_coast_isT(p)) then lcl_coast_lon(cnt)=mesh%geo_coord_nod2D(1,p) ! is in radian lcl_coast_lat(cnt)=mesh%geo_coord_nod2D(2,p) ! is in radian - cnt=cnt+1 + cnt=cnt+1 end if end do else From e95dd969046991920d23a526bc8c3db3f6da5dfd Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:45:15 +0100 Subject: [PATCH 14/63] improve idemix2 routine and fesom2 interface --- src/cvmix_driver/cvmix_idemix2.F90 | 947 +++++-- .../gen_modules_cvmix_idemix2.F90 | 2267 ++++++++++++++--- 2 files changed, 2584 insertions(+), 630 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 24ba091a5..13ba5b68b 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -8,26 +8,30 @@ module cvmix_idemix2 ! Nonlinear Interaction, and Dissipation of Internal Gravity Waves , Journal of ! Physical Oceanography, 44 (8), pp. 2093-2106 . doi: 10.1175/JPO-D-13-0224.1 -use cvmix_kinds_and_types, only : cvmix_r8, & - CVMIX_OVERWRITE_OLD_VAL, & - CVMIX_SUM_OLD_AND_NEW_VALS, & - CVMIX_MAX_OLD_AND_NEW_VALS, & - cvmix_data_type, & - cvmix_PI, & - cvmix_global_params_type -use cvmix_kinds_and_types_addon, only : cvmix_data_type_addon -use cvmix_utils_addon, only : cvmix_update_tke, solve_tridiag +use cvmix_kinds_and_types, only : cvmix_r8 , & + CVMIX_OVERWRITE_OLD_VAL , & + CVMIX_SUM_OLD_AND_NEW_VALS , & + CVMIX_MAX_OLD_AND_NEW_VALS , & + cvmix_data_type , & + cvmix_PI , & + cvmix_global_params_type +use cvmix_kinds_and_types_addon, only : cvmix_data_type_addon +use cvmix_utils_addon, only : cvmix_update_tke, solve_tridiag implicit none !_______________________________________________________________________________ private save !public member functions -public :: cvmix_init_idemix2 -public :: cvmix_compute_groupvel_idemix2 -public :: cvmix_compute_interact_tscale_idemix2 -! public :: calc_idemix2_v0 -! public :: cvmix_coeffs_idemix2 +public :: cvmix_idemix2_init +public :: cvmix_idemix2_compute_param +public :: cvmix_idemix2_compute_compart_groupvel +public :: cvmix_idemix2_compute_compart_interact_tscale +public :: cvmix_idemix2_compute_M2_dissipation +public :: cvmix_idemix2_compute_vert_struct_fct +public :: cvmix_idemix2_compute_vdiff_vdiss_Eiw +public :: cvmix_idemix2_compute_Eiw_waveinteract +public :: cvmix_idemix2_compute_Eiw_diss2KvAv public :: gofx2, hofx1, hofx2 @@ -38,18 +42,42 @@ module cvmix_idemix2 ! !module procedure idemix_wrap ! necessary to handle old/new values and to hand over user_defined constants ! end interface cvmix_coeffs_idemix2 -interface cvmix_init_idemix2 +interface cvmix_idemix2_init module procedure compute_init -end interface cvmix_init_idemix2 +end interface cvmix_idemix2_init -interface cvmix_compute_groupvel_idemix2 - module procedure compute_groupvel -end interface cvmix_compute_groupvel_idemix2 +interface cvmix_idemix2_compute_param + module procedure compute_param +end interface cvmix_idemix2_compute_param -interface cvmix_compute_interact_tscale_idemix2 - module procedure compute_interact_tscale -end interface cvmix_compute_interact_tscale_idemix2 +interface cvmix_idemix2_compute_compart_groupvel + module procedure compute_compart_groupvel +end interface cvmix_idemix2_compute_compart_groupvel +interface cvmix_idemix2_compute_compart_interact_tscale + module procedure compute_compart_interact_tscale +end interface cvmix_idemix2_compute_compart_interact_tscale + +interface cvmix_idemix2_compute_M2_dissipation + module procedure compute_M2_dissipation +end interface cvmix_idemix2_compute_M2_dissipation + +interface cvmix_idemix2_compute_vert_struct_fct + module procedure compute_vert_struct_fct +end interface cvmix_idemix2_compute_vert_struct_fct + +interface cvmix_idemix2_compute_vdiff_vdiss_Eiw + module procedure compute_vdiff_vdiss_Eiw +end interface cvmix_idemix2_compute_vdiff_vdiss_Eiw + +interface cvmix_idemix2_compute_Eiw_waveinteract + module procedure compute_Eiw_waveinteract +end interface cvmix_idemix2_compute_Eiw_waveinteract + +interface cvmix_idemix2_compute_Eiw_diss2KvAv + module procedure compute_Eiw_diss2KvAv +end interface cvmix_idemix2_compute_Eiw_diss2KvAv + interface idemix2_put module procedure vmix_tke_put_idemix2_int module procedure vmix_tke_put_idemix2_real @@ -73,12 +101,13 @@ module cvmix_idemix2 enable_niw , & enable_superbee_adv , & enable_AB_timestep , & - enable_hor_diffusion + enable_hor_diffusion, & + enable_hor_diff_iter integer :: & handle_old_vals , & nfbin , & - hor_diffusion_niter + hor_diff_niter end type idemix2_type type(idemix2_type), target :: idemix2_constants_saved @@ -103,15 +132,16 @@ subroutine compute_init(tau_v , & ! time scale for vertical symmet enable_superbee_adv , & enable_AB_timestep , & enable_hor_diffusion, & - hor_diffusion_niter , & + enable_hor_diff_iter, & + hor_diff_niter , & handle_old_vals, idemix2_userdef_constants) ! This subroutine sets user or default values for IDEMIX parameters real(cvmix_r8), optional, intent(in) :: tau_v, tau_h, gamma, jstar, mu0, shelf_dist logical , optional, intent(in) :: enable_M2, enable_niw, & enable_superbee_adv, enable_AB_timestep, & - enable_hor_diffusion - integer , optional, intent(in) :: nfbin, hor_diffusion_niter + enable_hor_diffusion, enable_hor_diff_iter + integer , optional, intent(in) :: nfbin, hor_diff_niter integer , optional, intent(in) :: handle_old_vals type(idemix2_type), target, optional, intent(inout) :: idemix2_userdef_constants @@ -221,10 +251,16 @@ subroutine compute_init(tau_v , & ! time scale for vertical symmet call idemix2_put('enable_hor_diffusion', .false. , idemix2_userdef_constants) end if - if (present(hor_diffusion_niter)) then - call idemix2_put('hor_diffusion_niter', hor_diffusion_niter, idemix2_userdef_constants) + if (present(enable_hor_diff_iter)) then + call idemix2_put('enable_hor_diff_iter', enable_hor_diff_iter, idemix2_userdef_constants) else - call idemix2_put('hor_diffusion_niter', 5 , idemix2_userdef_constants) + call idemix2_put('enable_hor_diff_iter', .false. , idemix2_userdef_constants) + end if + + if (present(hor_diff_niter)) then + call idemix2_put('hor_diff_niter', hor_diff_niter, idemix2_userdef_constants) + else + call idemix2_put('hor_diff_niter', 5 , idemix2_userdef_constants) end if !___ handle_old_vals________________________________________________________ @@ -243,68 +279,34 @@ end subroutine compute_init ! ! !_______________________________________________________________________________ -! Compute idemix representative vertical (v0) and horizontal (c0) group velocites +! Compute idemix2 representative vertical (v0) and horizontal (c0) group velocites ! as well as the enery dissipation coefficient alpha_c -subroutine compute_groupvel(nlev , & - nfbin , & - dtime , & - coriolis , & - grady_coriol, & - coslat , & - Nsqr , & - omega_M2 , & - omega_niw , & - cn , & - cn_gradx , & - cn_grady , & - phit , & - phiu , & - alpha_c , & - c0 , & - v0 , & - cg_M2 , & - cg_niw , & - u_M2 , & - v_M2 , & - w_M2 , & - u_niw , & - v_niw , & - w_niw , & - idemix2_const_userdef & - ) +subroutine compute_param( & + nlev , & + coriolis , & + Nsqr , & + cn , & + alpha_c , & + c0 , & + v0 , & + idemix2_const_userdef & + ) !___Input___________________________________________________________________ type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef - integer , intent(in) :: nlev , & - nfbin - real(cvmix_r8) , intent(in) :: dtime , & - coriolis , & - grady_coriol , & - coslat , & - cn , & - cn_gradx , & - cn_grady , & - omega_M2 , & - omega_niw + integer , intent(in) :: nlev + real(cvmix_r8) , intent(in) :: coriolis , & + cn + real(cvmix_r8) , intent(in) , dimension(nlev+1):: Nsqr - real(cvmix_r8) , intent(in) , dimension(nfbin) :: phit , & - phiu + !___Output__________________________________________________________________ real(cvmix_r8) , intent(out), dimension(nlev) :: alpha_c , & c0 , & v0 - real(cvmix_r8) , intent(out) :: cg_M2 , & - cg_niw - real(cvmix_r8) , intent(out), dimension(nfbin) :: u_M2 , & - v_M2 , & - w_M2 , & - u_niw , & - v_niw , & - w_niw + !___Local___________________________________________________________________ - integer :: di, fbin_i - real(cvmix_r8) :: fxa, intNz, cstar, & - kdot_x_M2, kdot_x_niw, & - kdot_y_M2, kdot_y_niw + integer :: di + real(cvmix_r8) :: fxa, cstar !, intNz type(idemix2_type), pointer :: idemix2_const_in ! do pointer into save variable or into user defined input variable @@ -352,17 +354,62 @@ subroutine compute_groupvel(nlev , & ! enddo ! enddo ! endif - +end subroutine compute_param + + +! +! +!_______________________________________________________________________________ +! Compute idemix representative vertical (v0) and horizontal (c0) group velocites +! as well as the enery dissipation coefficient alpha_c +subroutine compute_compart_groupvel( & + nfbin , & + coriolis , & + grady_coriol , & + coslat , & + cn , & + cn_gradx , & + cn_grady , & + phit , & + phiu , & + omega_compart , & + u_compart , & + v_compart , & + w_compart , & + idemix2_const_userdef & + ) + + !___Input___________________________________________________________________ + type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef + integer , intent(in) :: nfbin + real(cvmix_r8) , intent(in) :: coriolis , & + grady_coriol , & + coslat , & + cn , & + cn_gradx , & + cn_grady , & + omega_compart + real(cvmix_r8) , intent(in) , dimension(nfbin) :: phit , & + phiu + !___Output__________________________________________________________________ + real(cvmix_r8) , intent(out), dimension(nfbin) :: u_compart , & + v_compart , & + w_compart + !___Local___________________________________________________________________ + integer :: di, fbin_i + real(cvmix_r8) :: fxa, intNz, cstar, & + kdot_x, kdot_y, cg + type(idemix2_type), pointer :: idemix2_const_in + + ! do pointer into save variable or into user defined input variable + idemix2_const_in => idemix2_constants_saved + if (present(idemix2_const_userdef)) then + idemix2_const_in => idemix2_const_userdef + end if + !___________________________________________________________________________ ! compute group velocity of M2 internal tidal waves - if (idemix2_const_in%enable_M2) then - cg_M2=sqrt( max(0d0, omega_M2**2 - coriolis**2 ) ) * cn/omega_M2 - endif - - ! compute group velocity of of near-inertial waves (NIW) - if (idemix2_const_in%enable_niw) then - cg_niw=sqrt( max(0d0, omega_niw**2 - coriolis**2 ) ) * cn/omega_niw - endif + cg=sqrt( max(0d0, omega_compart**2 - coriolis**2 ) ) * cn/omega_compart !___________________________________________________________________________ ! eq4 in EdenOlbers2014: @@ -375,110 +422,67 @@ subroutine compute_groupvel(nlev , & ! compute wave vector component for the M2 internal tides: ! kdot_M2 = (kdot_x_M2, kdot_y_M2) - if (idemix2_const_in%enable_M2) then - ! compute: sqrt(omega²-f²) - fxa = max(1d-10,omega_M2**2 - coriolis**2 ) - - ! 1st part coriolis contribution - ! compute: c_n/omega/sqrt(omega²-f²)) * f * grad_f - kdot_y_M2 = -cn/sqrt(fxa)*coriolis/omega_M2*grady_coriol - ! | - ! +-> this minus sign is from the -cos(phi) - ! - ! 2nd part topographic/buoyancy driven contribution - ! compute: sqrt(omega²-f²)/omega * grad_cn - kdot_y_M2 = kdot_y_M2 - sqrt(fxa)/omega_M2*cn_grady - ! | - ! +-> this minus sign is from the -cos(phi) - kdot_x_M2 = sqrt(fxa)/omega_M2*cn_gradx - endif - ! compute wave vector component for the near-inertial-waves: - ! kdot_niw = (kdot_x_niw, kdot_y_niw) - if (idemix2_const_in%enable_niw) then - ! compute: sqrt(omega²-f²) - fxa = max(1d-10,omega_niw**2 - coriolis**2 ) + ! compute: sqrt(omega²-f²) + fxa = max(1d-10,omega_compart**2 - coriolis**2 ) - ! 1st part coriolis contribution - ! compute: c_n/omega/sqrt(omega²-f²)) * f * grad_f - kdot_y_niw = -cn/sqrt(fxa)*coriolis/omega_niw*grady_coriol - ! | - ! +-> this minus sign is from the -cos(phi) - ! - ! 2nd part topographic/buoyancy driven contribution - ! compute: sqrt(omega²-f²)/omega * grad_cn - kdot_y_niw = kdot_y_niw - sqrt(fxa)/omega_niw*cn_grady - ! | - ! +-> this minus sign is from the -cos(phi) - kdot_x_niw = sqrt(fxa)/omega_niw*cn_gradx - endif + ! 1st part coriolis contribution + ! compute: c_n/omega/sqrt(omega²-f²)) * f * grad_f + kdot_y = -cn/sqrt(fxa)*coriolis/omega_compart*grady_coriol + ! | + ! +-> this minus sign is from the -cos(phi) + ! + ! 2nd part topographic/buoyancy driven contribution + ! compute: sqrt(omega²-f²)/omega * grad_cn + kdot_y = kdot_y - sqrt(fxa)/omega_compart*cn_grady + ! | + ! +-> this minus sign is from the -cos(phi) + kdot_x = sqrt(fxa)/omega_compart*cn_gradx !___________________________________________________________________________ - !zonal, meridional and vertial component of M2 internal tide group velocity - if (idemix2_const_in%enable_M2) then - do fbin_i=2,nfbin-1 - u_M2(fbin_i) = cg_M2*cos( phit(fbin_i) ) - v_M2(fbin_i) = cg_M2*sin( phit(fbin_i) ) * coslat - - !!! ATTENTION !!! --> this might be needed to move to nodes - w_M2(fbin_i) = (kdot_y_M2*cos(phiu(fbin_i)) + kdot_x_M2*sin(phiu(fbin_i)) ) - enddo - end if + !zonal, meridional and cross-spectral component of M2 internal tide group velocity + do fbin_i=2,nfbin-1 + u_compart(fbin_i) = cg*cos( phit(fbin_i) ) + v_compart(fbin_i) = cg*sin( phit(fbin_i) ) * coslat + w_compart(fbin_i) = (kdot_y*cos(phiu(fbin_i)) + kdot_x*sin(phiu(fbin_i)) ) + end do - !zonal, meridional and vertial component of NIW internal wave group velocity - if (idemix2_const_in%enable_niw) then - do fbin_i=2,nfbin-1 - u_niw(fbin_i) = cg_niw*cos( phit(fbin_i) ) - v_niw(fbin_i) = cg_niw*sin( phit(fbin_i) ) * coslat - - !!! ATTENTION !!! --> this might be needed to move to nodes - w_niw(fbin_i) = (kdot_y_niw*cos(phiu(fbin_i)) + kdot_x_niw*sin(phiu(fbin_i)) ) - enddo - end if -end subroutine compute_groupvel +end subroutine compute_compart_groupvel ! ! !_______________________________________________________________________________ -subroutine compute_interact_tscale(dtime , & - lat , & - coriolis , & - omega_M2 , & - omega_niw , & - cn , & - zbottom , & - topo_hrms , & - topo_hlam , & - topo_shelf , & - tau_M2 , & - tau_niw , & - alpha_M2_c , & - idemix2_const_userdef & - ) +subroutine compute_compart_interact_tscale( & + dtime , & + lat , & + coriolis , & + cn , & + zbottom , & + topo_hrms , & + topo_hlam , & + topo_shelf , & + omega_compart , & + tau_compart , & + idemix2_const_userdef & + ) !___Input___________________________________________________________________ type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef real(cvmix_r8) , intent(in) :: dtime , & lat , & coriolis , & - omega_M2 , & - omega_niw , & + omega_compart , & cn , & zbottom , & topo_hrms , & - topo_hlam , & - topo_shelf + topo_hlam + logical , intent(in) :: topo_shelf !___Output__________________________________________________________________ - real(cvmix_r8) , intent(out) :: tau_M2 , & - tau_niw , & - alpha_M2_c + real(cvmix_r8) , intent(out) :: tau_compart !___Local___________________________________________________________________ - integer :: di, fbin_i, N0 - real(cvmix_r8) :: fxb, fxc - real(cvmix_r8) :: mstar=0.01 ,& - M2_f=2*cvmix_PI/(12.42*60*60) + real(cvmix_r8) :: fxb, fxc, N0 type(idemix2_type), pointer :: idemix2_const_in ! do pointer into save variable or into user defined input variable @@ -489,65 +493,565 @@ subroutine compute_interact_tscale(dtime , & !___________________________________________________________________________ ! compute NIW Dissipation Timescale - if (idemix2_const_in%enable_niw) then - if (zbottom>0) then - N0=cn*cvmix_PI/zbottom - if ( N0> abs(coriolis) .and. omega_niw> abs(coriolis) ) then + if (zbottom>0) then + N0=cn*cvmix_PI/zbottom + if ( N0> abs(coriolis) .and. omega_compart> abs(coriolis) ) then fxc = topo_hrms**2.0 * 2.0*cvmix_PI/(1d-12+topo_hlam) - fxb = 0.5* N0*( (omega_niw**2.0 + coriolis**2.0)/omega_niw**2.0 )**2.0 & - *(omega_niw**2.0 - coriolis**2.0)**0.5/omega_niw - tau_niw = min(0.5/dtime, fxc*fxb/zbottom) - endif + fxb = 0.5* N0*( (omega_compart**2.0 + coriolis**2.0)/omega_compart**2.0 )**2.0 & + *(omega_compart**2.0 - coriolis**2.0)**0.5/omega_compart + tau_compart = min(0.5/dtime, fxc*fxb/zbottom) endif + endif - ! on shelf limitation - if (topo_shelf == 1.0) tau_niw = 1./(3.*86400.0) - tau_niw = max(1d0/(50.*86400.0), tau_niw ) - end if + ! on shelf limitation + if (topo_shelf) tau_compart = 1./(3.*86400.0) + tau_compart = max(1d0/(50.*86400.0), tau_compart ) - !___________________________________________________________________________ - ! compute tau_M2 M2 Tidal Dissipation Timescale - if (idemix2_const_in%enable_M2) then - if (zbottom>0) then - N0=cn*cvmix_PI/zbottom - if ( N0> abs(coriolis) .and. omega_M2> abs(coriolis) ) then - fxc = topo_hrms**2.0 * 2.0*cvmix_PI/(1d-12+topo_hlam) - fxb = 0.5* N0*( (omega_M2**2.0 + coriolis**2.0)/omega_M2**2.0 )**2.0 & - *(omega_M2**2.0 - coriolis**2.0)**0.5/omega_M2 - tau_M2 = min(0.5/dtime, fxc*fxb/zbottom) - endif +end subroutine compute_compart_interact_tscale + + +! +! +!_______________________________________________________________________________ +subroutine compute_M2_dissipation( & + lat , & + cn , & + zbottom , & + alpha_M2_c , & + idemix2_const_userdef & + ) + !___Input___________________________________________________________________ + type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef + real(cvmix_r8) , intent(in) :: lat , & + cn , & + zbottom + + !___Output__________________________________________________________________ + real(cvmix_r8) , intent(out) :: alpha_M2_c + !___Local___________________________________________________________________ + real(cvmix_r8) :: N0 + real(cvmix_r8) :: mstar=0.01 ,& + M2_f=2*cvmix_PI/(12.42*60*60) + type(idemix2_type), pointer :: idemix2_const_in + + ! do pointer into save variable or into user defined input variable + idemix2_const_in => idemix2_constants_saved + if (present(idemix2_const_userdef)) then + idemix2_const_in => idemix2_const_userdef + end if + + ! compute alpha_M2_c M2 Continuous Dissipation Rate (Background M2 tidal + ! dissipation rate (not topographic)) + alpha_M2_c = 0.0 + if (zbottom > 0.) then + N0 = cn*cvmix_PI/zbottom+1D-20 + if (abs(lat) < 28.5 ) then + ! lambda+/M2=15*E*mstar/N * (sin(phi-28.5)/sin(28.5))^1/2 + alpha_M2_c=alpha_M2_c+ M2_f*15*mstar/N0* (sin( abs(abs(lat) -28.5)/180.*cvmix_PI )/sin(28.5/180.*cvmix_PI) )**0.5 endif + if (abs(lat) < 74.5 ) then + ! lambda-/M2 = 0.7*E*mstar/N *sin^2(phi) + alpha_M2_c=alpha_M2_c+ M2_f*0.7*mstar/N0* sin( abs(lat)/180.*cvmix_PI )**2 + endif + alpha_M2_c=alpha_M2_c/zbottom + endif - ! on shelf limitation - if (topo_shelf == 1.0) tau_M2 = 1./(3.*86400.0) - - ! ensure background value - tau_M2 = max(1d0/(50.*86400.0), tau_M2 ) + ! ensure background value + alpha_M2_c = max(0D0, min( 1d-5,alpha_M2_c )) + +end subroutine compute_M2_dissipation + + +! +! +!_______________________________________________________________________________ +! Calculates the vertical structure functions for internal wave modes in the +! IDEMIX model. These functions describe how wave energy is distributed vertically +! in the ocean. +! +! Key Variables: +! phin: Vertical structure function φₙ(z) - the modal function itself +! phinz: Vertical derivative dφₙ/dz - the gradient of the modal function +! E_struct_M2: Energy structure function for M2 tides +! E_struct_niw: Energy structure function for near-inertial waves +subroutine compute_vert_struct_fct( & + nlev , & + dzw , & + coriolis , & + omega_M2 , & + omega_niw , & + cn , & + Nsqr , & + E_struct_M2 , & + E_struct_niw , & + idemix2_const_userdef & + ) + !___Input___________________________________________________________________ + type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef + integer , intent(in) :: nlev + real(cvmix_r8) , intent(in) :: dzw(:) + real(cvmix_r8) , intent(in) :: coriolis , & + omega_M2 , & + omega_niw , & + cn + real(cvmix_r8) , intent(in) :: Nsqr(:) + + !___Output__________________________________________________________________ + real(cvmix_r8) , intent(inout), optional :: E_struct_M2(:) , & + E_struct_niw(:) + + !___Local___________________________________________________________________ + integer :: di + real(cvmix_r8) :: fxa, norm, phin_dim1 + real(cvmix_r8), dimension(:) :: Nzw(nlev), phin(nlev), dphindz(nlev) + type(idemix2_type), pointer :: idemix2_const_in + + ! do pointer into save variable or into user defined input variable + idemix2_const_in => idemix2_constants_saved + if (present(idemix2_const_userdef)) then + idemix2_const_in => idemix2_const_userdef + end if + + !___________________________________________________________________________ + ! calculate int_(-h)^z N dz + phin(:) = 0.0_cvmix_r8 + Nzw(1) = max(0.0_cvmix_r8, (Nsqr(1)+Nsqr(2)) * 0.5_cvmix_r8) + phin(1) = sqrt(Nzw(1))*dzw(1) + phin_dim1 = phin(1) + fxa = phin(1)/cn + dphindz(1) = sin(fxa)/Nzw(1)**0.25_cvmix_r8 + phin(1) = cos(fxa)*Nzw(1)**0.25_cvmix_r8 + + do di = 2, nlev + ! interpolate N² onto tracer levels and cumulative integrate + Nzw(di) = max(0.0_cvmix_r8, (Nsqr(di)+Nsqr(di+1)) * 0.5_cvmix_r8) - ! compute alpha_M2_c M2 Continuous Dissipation Rate (Background M2 tidal - ! dissipation rate (not topographic)) - alpha_M2_c = 0.0 - if (zbottom > 0.) then - N0 = cn*cvmix_PI/zbottom+1D-20 - if (abs(lat) < 28.5 ) then - ! lambda+/M2=15*E*mstar/N * (sin(phi-28.5)/sin(28.5))^1/2 - alpha_M2_c=alpha_M2_c+ M2_f*15*mstar/N0* (sin( abs(abs(lat) -28.5)/180.*cvmix_PI )/sin(28.5/180.*cvmix_PI) )**0.5 - endif - if (abs(lat) < 74.5 ) then - ! lambda-/M2 = 0.7*E*mstar/N *sin^2(phi) - alpha_M2_c=alpha_M2_c+ M2_f*0.7*mstar/N0* sin( abs(lat)/180.*cvmix_PI )**2 - endif - alpha_M2_c=alpha_M2_c/zbottom - endif + ! calculate int_(-h)^z N dz + phin(di) = phin_dim1 + sqrt(Nzw(di))*dzw(di) + phin_dim1 = phin(di) - ! ensure background value - alpha_M2_c = max(0D0, min( 1d-5,alpha_M2_c )) + ! calculate phi_n = cos( int_(-h)^z N/c_n dz )*N^0.5 + ! and dphi_n/dz = sin( int_(-h)^z N/c_n dz )/N^0.5 + fxa = phin(di)/cn + dphindz(di) = sin(fxa)/Nzw(di)**0.25_cvmix_r8 + phin(di) = cos(fxa)*Nzw(di)**0.25_cvmix_r8 + enddo + + ! normalisation with int_(-h)^0 dz (dphi_n/dz )^2 /N^2 = 1 + norm = 0.0_cvmix_r8 + do di = 1,nlev + norm = norm + dphindz(di)**2/Nzw(di)*dzw(di) + enddo + do di = 1,nlev + if (norm>0.0_cvmix_r8) dphindz(di) = dphindz(di)/norm**0.5 + enddo + + ! normalisation with int_(-h)^0 dz phi_n^2 /c_n^2 = 1 + norm=0.0_cvmix_r8 + do di = 1,nlev + norm = norm + phin(di)**2/(cn**2)*dzw(di) + enddo + do di = 1,nlev + if (norm>0.0_cvmix_r8) phin(di) = phin(di)/norm**0.5 + enddo + + if (present(E_struct_M2)) then + ! calculate structure function for energy: + ! E(z) = E_0 0.5( (1+f^2/om^2) phi_n^2/c_n^2 + (1-f^2/om^2) (dphi_n/dz)^2/N^2) + do di = 1,nlev + E_struct_M2(di) = 0.5_cvmix_r8*( (1.0_cvmix_r8+coriolis**2/omega_M2**2)*phin( di)**2 /(cn**2) & + +(1.0_cvmix_r8-coriolis**2/omega_M2**2)*dphindz(di)**2 /Nzw(di) ) + enddo + endif + + if (present(E_struct_niw)) then + do di = 1,nlev + E_struct_niw(di) = 0.5_cvmix_r8*( (1.0_cvmix_r8+coriolis**2/omega_niw**2)*phin( di)**2/(cn**2) & + +(1.0_cvmix_r8-coriolis**2/omega_niw**2)*dphindz(di)**2/Nzw(di) ) + enddo endif +end subroutine compute_vert_struct_fct + + +! +! +!_______________________________________________________________________________ +! Integrate vertical part of internal wave energy idemix equation, solve vertical +! diffusion an dissipation implicitly over the water column. Keep in mind Eiw lives +! on the full depth levels +subroutine compute_vdiff_vdiss_Eiw( & + nlev , & + dzw , & + dt , & + c0 , & + alpha_c , & + fsrf , & + fbot , & + Eiw_old , & + Eiw_new , & + Eiw_dt , & + Eiw_vdif , & + Eiw_diss , & + Eiw_srf , & + Eiw_bot , & + idemix2_const_userdef & + ) + !___Input___________________________________________________________________ + type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef + integer , intent(in) :: nlev ! --> number of full depth levels + real(cvmix_r8) , intent(in), dimension(nlev-1) :: dzw ! --> layer thickness + real(cvmix_r8) , intent(in) :: dt + real(cvmix_r8) , intent(in), dimension(nlev) :: c0 + real(cvmix_r8) , intent(in), dimension(nlev) :: alpha_c + real(cvmix_r8) , intent(in) :: fsrf + real(cvmix_r8) , intent(in), dimension(nlev) :: fbot +! real(cvmix_r8) , intent(in), dimension(nlev) :: fadd --> in moment no additional forcings + real(cvmix_r8) , intent(in), dimension(nlev) :: Eiw_old + !___Output_________________________________________________________________ + real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_new + real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_dt + real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_vdif + real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_diss + real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_bot + real(cvmix_r8) , intent(out) :: Eiw_srf + !___Local___________________________________________________________________ + integer :: nz + real(cvmix_r8), dimension(nlev) :: Eiw_max + real(cvmix_r8), dimension(nlev) :: fadd + real(cvmix_r8), dimension(nlev-1) :: c0_zmid + real(cvmix_r8), dimension(nlev) :: dzmid + real(cvmix_r8), dimension(nlev) :: a_dif, b_dif, c_dif + real(cvmix_r8), dimension(nlev) :: a_tri, b_tri, c_tri, d_tri + type(idemix2_type), pointer :: idemix2_const_in + + ! do pointer into save variable or into user defined input variable + idemix2_const_in => idemix2_constants_saved + if (present(idemix2_const_userdef)) then + idemix2_const_in => idemix2_const_userdef + end if + !___________________________________________________________________________ + a_dif = 0.0_cvmix_r8 + b_dif = 0.0_cvmix_r8 + c_dif = 0.0_cvmix_r8 + a_tri = 0.0_cvmix_r8 + b_tri = 0.0_cvmix_r8 + c_tri = 0.0_cvmix_r8 + d_tri = 0.0_cvmix_r8 + Eiw_new = 0.0_cvmix_r8 + Eiw_diss = 0.0_cvmix_r8 + Eiw_bot = 0.0_cvmix_r8 + + !___________________________________________________________________________ + ! initialise additional forcings with zeros, there can be additional forcing terms + ! from EKE, GM disspation, lateral friction, cabbeling heat, bottom friction + ! This is not yet implemented + fadd(:) = 0.0_cvmix_r8 + + !___________________________________________________________________________ + ! prevent negative dissipation of IW energy, might not be neccessary but + ! safety first + Eiw_max = max(0.0_cvmix_r8, Eiw_old) + + !___________________________________________________________________________ + ! Solve vertical part implicitly, having Eiw on mid-depth levels like tracer + ! for easier advection + ! + ! dEiw/dt = d/dz(c0*tau_v * d/dz(c0*Eiw)) - alpha_c*Eiw + forcing + ! |___________________________| | + ! diffusion of E_iw dissipation + ! + ! ~~~~~~~o zlev=1~~~~~~~ + ! | + ! zmid=1 + --> k-0.5 + ! | + ! o 2 --> k --> Eiw_k, c0_k + ! | + ! 2 + --> k+0.5 + ! | + ! -------o 3----------- + ! ///////////////////// + ! c0_k-0.5 = (c0_k+c0_k-1) / 2 + ! c0_k+0.5 = (c0_k+c0_k+1) / 2 + ! + ! d/dz(c0*Eiw)_k = (c0_k*Eiw_k - c0_k-1*Eiw_k-1)/h(k-1) = dcE_k-0.5--> defined on middepth levels + ! d/dz(c0* dcE_k-0.5) = (c0_k+0.5*dcE_k+0.5 - c0_k-0.5*dcE_k-0.5) * 2 / (h_k+ h_k-1) + ! + ! Discrite Form: + ! -------------- + ! Eiw^(t+1) - Eiw^(t) = dz* [d/dz(c0*tau_v * d/dz(c0*Eiw)) - alpha_c*Eiw]^(t+1) + forcing^(t) + ! Eiw^(t+1)_k = Eiw^(t)_k + ! + dt * forcing^(t)_k + ! - dt * alpha_c * Eiw^(t+1)_k + ! - tau_v * [ c0_k+0.5 * (c0_k+1*Eiw_k+1 - c0_k *Eiw_k ) * 2 / h_k / (h_k+h_k-1)] + ! -c0_k-0.5 * (c0_k *Eiw_k - c0_k-1*Eiw_k-1) * 2 / h_k-1 / (h_k+h_k-1)] + ! Rearange for Tridiagonal: + ! ------------------------- + ! a_k * Eiw^(t+1)_k-1 + b_k * Eiw^(t+1)_k + c_k * Eiw^(t+1) = d_k + ! + ! Estimate coefficents a,b,c: + ! --------------------------- + ! 1) a_k --> (k-1, t+1): + ! - dt * 2 / (h_k-1*(h_k+h_k-1)) * c0_(k-0.5)*c0_k-1*Eiw^(t+1)_k-1 = a_k * Eiw^(t+1)_k-1 + ! + ! 2) b_k --> (k , t+1): + ! Eiw^(t+1)_k + ! + dt*2/(h_k *(h_k+h_k-1))*c0_(k+0.5)*c0_k*Eiw^(t+1)_k + ! + dt*2/(h_k-1*(h_k+h_k-1))*c0_(k-0.5)*c0_k*Eiw^(t+1)_k + ! + dt*alpha_c*Eiw^(t+1)_k + ! = b_k * Eiw^(t+1)_k + ! + ! 3) c_k --> (k+1 , t+1): + ! - dt * 2 / (h_k*(h_k+h_k-1)) * c0_(k+0.5)*c0_k+1*Eiw^(t+1)_k+1 = c_k * Eiw^(t+1)_k+1 + ! + ! 4) d_k --> (k , t ): + ! Eiw^t_k + dt* Forc^t_k = d_k + ! + ! Solve tridiagonal matrix: + ! ------------------------- + ! | b_1 c_1 0 0 0 | (Eiw_1) = (d_1) + ! | a_2 b_2 c_2 0 0 | (Eiw_2) = (d_2) + ! | 0 a_3 b_3 c_3 0 | (Eiw_3) = (d_3) + ! | 0 0 a_4 b_4 c_4 | (Eiw_4) = (d_4) + ! | 0 0 0 a_k b_k | (Eiw_k) = (d_k) + ! + !___________________________________________________________________________ + do nz = 2, nlev-1 + c0_zmid(nz-1) = dt * idemix2_const_in%tau_v * (c0(nz)+c0(nz-1))*0.5_cvmix_r8 / dzw(nz-1) + dzmid(nz) = (dzw(nz) + dzw(nz-1))*0.5_cvmix_r8 + end do + dzmid(1) = dzw(1)*0.5_cvmix_r8 + nz=nlev + dzmid(nz) = dzw(nz-1)*0.5_cvmix_r8 + c0_zmid(nz-1) = idemix2_const_in%tau_v * (c0(nz)+c0(nz-1))*0.5_cvmix_r8 / dzw(nz-1) + + !___________________________________________________________________________ + ! -- a -- + a_dif(1) = 0.0_cvmix_r8 ! not part of the diffusion matrix, thus value is arbitrary + do nz=2,nlev + a_dif(nz) = c0_zmid(nz-1)*c0(nz-1) / dzmid(nz) + end do + + ! -- b -- + nz = 1 + b_dif(nz) = c0_zmid(nz )*c0(nz) / dzmid(nz) + do nz=2,nlev-1 + b_dif(nz) = (c0_zmid(nz-1)*c0(nz)+c0_zmid(nz)*c0(nz)) / dzmid(nz) + end do + nz = nlev + b_dif(nz) = c0_zmid(nz-1)*c0(nz) / dzmid(nz) + + ! -- c-- + do nz=1,nlev-1 + c_dif(nz) = c0_zmid(nz)*c0(nz+1) / dzmid(nz) + end do + c_dif(nlev) = 0.0_cvmix_r8 + + !___________________________________________________________________________ + ! prepare tridiagonal matrix elements: a,b,c,d + nz = 1 + a_tri(nz) = -dt * a_dif(nz) + b_tri(nz) = 1.0_cvmix_r8 & + + dt * b_dif(nz) + c_tri(nz) = -dt * c_dif(nz) + do nz=2,nlev-1 + a_tri(nz) = -dt * a_dif(nz) + b_tri(nz) = 1.0_cvmix_r8 & + + dt * b_dif(nz) & + + dt * alpha_c(nz)*Eiw_max(nz) + c_tri(nz) = -dt * c_dif(nz) + end do + nz = nlev + a_tri(nz) = -dt * a_dif(nz) + b_tri(nz) = 1.0_cvmix_r8 & + + dt * b_dif(nz) + c_tri(nz) = -dt * c_dif(nz) + + ! -- d --- + do nz=1,nlev + ! bottom production term + Eiw_bot(nz) = fbot(nz)/dzmid(nz) + ! --> fbot(nz) must be here an array overf depth since we want this + ! in FESOM2 to operate on nodes, but our bottom topography is on elements + ! so bottom forcing is injected over the water column where elements + ! that participate to the scalar control volume turn into bottom over the + ! vertical depth + + d_tri(nz) = Eiw_old(nz) + dt*fadd(nz) + dt*Eiw_bot(nz) + + end do + d_tri(1) = d_tri(1) + dt*fsrf/dzmid(1) + + !___________________________________________________________________________ + ! solve tridiagonal matrix + call solve_tridiag(a_tri, b_tri, c_tri, d_tri, Eiw_new, nlev) + + !___________________________________________________________________________ + ! diagnose implicite tendencies (only for diagnostics) + ! production of Eiw from vertical diffusion + nz = 1 + Eiw_vdif(nz) = - b_dif(nz)*Eiw_new(nz) + c_dif(nz)*Eiw_new(nz+1) + do nz=2,nlev-1 + Eiw_vdif(nz) = a_dif(nz)*Eiw_new(nz-1) - b_dif(nz)*Eiw_new(nz) + c_dif(nz)*Eiw_new(nz+1) + enddo + nz = nlev + Eiw_vdif(nz) = a_dif(nz)*Eiw_new(nz-1) - b_dif(nz)*Eiw_new(nz) + + !___________________________________________________________________________ + ! dissipation of E_iw + Eiw_diss(:) = -alpha_c(: )*Eiw_max(:)*Eiw_new(:) +! write(*,*) "min/max Eiw_diss: ", minval(Eiw_diss), maxval(Eiw_diss) +! write(*,*) "min/max alpha_c : ", minval(alpha_c) , maxval(alpha_c) +! write(*,*) "min/max Eiw_max : ", minval(Eiw_max) , maxval(Eiw_max) +! write(*,*) "min/max Eiw_new : ", minval(Eiw_new) , maxval(Eiw_new) +! write(*,*) "min/max Eiw_old : ", minval(Eiw_old) , maxval(Eiw_old) +! write(*,*) + + ! total production of Eiw + Eiw_dt(:) = (Eiw_new(:) - Eiw_old(:))/dt + + ! surface production term + Eiw_srf = fsrf/dzmid(1) + +end subroutine compute_vdiff_vdiss_Eiw -end subroutine compute_interact_tscale +! +! +!_______________________________________________________________________________ +! Integrate vertical part of internal wave energy idemix equation, solve vertical +! diffusion an dissipation implicitly over the water column. Keep in mind Eiw lives +! on the full depth levels +subroutine compute_Eiw_waveinteract( & + nlev , & + nfbin , & + dzw , & + dphi , & + dt , & + E_iw_old , & + E_iw_new , & + E_M2_old , & + E_M2_new , & + E_M2_struct , & + alpha_M2_c , & + tau_M2 , & + E_niw_old , & + E_niw_new , & + E_niw_struct , & + tau_niw , & + idemix2_const_userdef & + ) + !___Input/Output____________________________________________________________ + type(idemix2_type), intent(in ), optional, target :: idemix2_const_userdef + integer , intent(in ) :: nlev ! --> number of full depth levels + integer , intent(in ) :: nfbin ! --> of spectral bins + real(cvmix_r8) , intent(in ) :: dzw(nlev-1) ! --> layer thickness + real(cvmix_r8) , intent(in ) :: dphi(nfbin) + real(cvmix_r8) , intent(in ) :: dt + real(cvmix_r8) , intent(in ) :: E_iw_old(nlev) + real(cvmix_r8) , intent(inout) :: E_iw_new(nlev) + real(cvmix_r8) , intent(in ), optional :: E_M2_old(nfbin) + real(cvmix_r8) , intent(inout), optional :: E_M2_new(nfbin) + real(cvmix_r8) , intent(in ), optional :: E_M2_struct(nfbin) + real(cvmix_r8) , intent(in ), optional :: alpha_M2_c + real(cvmix_r8) , intent(in ), optional :: tau_M2 + real(cvmix_r8) , intent(in ), optional :: E_niw_old(nfbin) + real(cvmix_r8) , intent(inout), optional :: E_niw_new(nfbin) + real(cvmix_r8) , intent(in ), optional :: E_niw_struct(nfbin) + real(cvmix_r8) , optional :: tau_niw + + !___Local___________________________________________________________________ + integer :: nz, fbini + real(cvmix_r8) :: vint, sint, aM2c, M2_diss, fmin + type(idemix2_type), pointer :: idemix2_const_in + + ! do pointer into save variable or into user defined input variable + idemix2_const_in => idemix2_constants_saved + if (present(idemix2_const_userdef)) then + idemix2_const_in => idemix2_const_userdef + end if + + !___________________________________________________________________________ + ! vertical integrate E_iw --> compute dzt from dzw + vint = 0.0_cvmix_r8 + nz = 1 + vint = vint + E_iw_old(nz)*dzw(nz)*0.5_cvmix_r8 + do nz = 2, nlev-1 + vint = vint + E_iw_old(nz)*(dzw(nz)+dzw(nz-1))*0.5_cvmix_r8 + end do + nz = nlev + vint = vint + E_iw_old(nz)*dzw(nz-1)*0.5_cvmix_r8 + + !___________________________________________________________________________ + if (present(E_M2_old)) then + ! spectrally integrate E_M2 + sint = 0.0_cvmix_r8 + do fbini = 2, nfbin-1 + sint = sint + E_M2_old(fbini)*dphi(fbini) + end do + + ! update M2 energy: interaction of M2 and continuum + aM2c = alpha_M2_c + aM2c = max(0.0_cvmix_r8,min(aM2c,1./max(1d-12,dt*vint))) ! FP 2020 + aM2c = max(0.0_cvmix_r8,min(aM2c,1./max(1d-12,dt*sint))) + do fbini = 2, nfbin-1 + M2_diss = aM2c*vint*E_M2_old(fbini) + E_M2_new(fbini)= E_M2_new(fbini)-dt*M2_diss + + ! update E_iw from E_M2 + fmin = min( 0.5_cvmix_r8/dt,aM2c*vint ) ! flux limiter + E_iw_new(fbini) = E_iw_new(fbini) & + + dt * tau_M2* sint * E_M2_struct(fbini) & + + dt * fmin * sint * E_M2_struct(fbini) + + end do + end if + + !___________________________________________________________________________ + if (present(E_niw_old)) then + ! spectrally integrate E_niw + sint = 0.0_cvmix_r8 + do fbini = 2, nfbin-1 + sint = sint + E_niw_old(fbini)*dphi(fbini) + end do + + ! update E_iw from E_niw + do fbini = 2, nfbin-1 + E_iw_new(fbini) = E_iw_new(fbini) & + + dt * tau_niw * sint * E_niw_struct(fbini) + end do + end if + + +end subroutine compute_Eiw_waveinteract + + + +! +! +!_______________________________________________________________________________ +! IDEMIX2 only shortcut: derive diffusivity and viscosity using Osbourne relation +subroutine compute_Eiw_diss2KvAv(nlev, Eiw_diss, Nsqr, KappaH, KappaM) + !___Input/Output____________________________________________________________ + integer , intent(in ) :: nlev ! --> number of full depth levels + real(cvmix_r8) , intent(in ) :: Eiw_diss(nlev) ! --> layer thickness + real(cvmix_r8) , intent(in ) :: Nsqr( nlev) + real(cvmix_r8) , intent(inout) :: KappaH( nlev) + real(cvmix_r8) , intent(inout) :: KappaM( nlev) + + !___Local___________________________________________________________________ + integer :: nz + + KappaH = 0.0_cvmix_r8 + KappaM = 0.0_cvmix_r8 + do nz = 2, nlev-1 + KappaH(nz) = 0.2_cvmix_r8/(1.0_cvmix_r8+0.2_cvmix_r8) * (-1.0_cvmix_r8 * Eiw_diss(nz)) / max(1.0e-12_cvmix_r8, Nsqr(nz)) + KappaH(nz) = max(1.0e-9_cvmix_r8, KappaH(nz)) + KappaH(nz) = min(1.0_cvmix_r8, KappaH(nz)) + KappaM(nz) = 10.0_cvmix_r8 * KappaH(nz) + end do +end subroutine compute_Eiw_diss2KvAv ! @@ -587,7 +1091,7 @@ subroutine vmix_tke_put_idemix2_int(varname,val,idemix2_userdef_constants) select case(trim(varname)) case('handle_old_vals' ) ; idemix2_constants_out%handle_old_vals = val case('nfbin' ) ; idemix2_constants_out%nfbin = val - case('hor_diffusion_niter') ; idemix2_constants_out%hor_diffusion_niter= val + case('hor_diff_niter' ) ; idemix2_constants_out%hor_diff_niter= val case DEFAULT print*, "ERROR:", trim(varname), " not a valid choice" stop 1 @@ -608,6 +1112,7 @@ subroutine vmix_tke_put_idemix2_bool(varname,val,idemix2_userdef_constants) case('enable_superbee_adv' ) ; idemix2_constants_out%enable_superbee_adv = val case('enable_AB_timestep' ) ; idemix2_constants_out%enable_AB_timestep = val case('enable_hor_diffusion') ; idemix2_constants_out%enable_hor_diffusion= val + case('enable_hor_diff_iter') ; idemix2_constants_out%enable_hor_diff_iter= val case DEFAULT print*, "ERROR:", trim(varname), " not a valid choice" stop 1 diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 9c741625d..a507d256f 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -16,9 +16,15 @@ module g_cvmix_idemix2 !___________________________________________________________________________ ! module calls from cvmix library - use cvmix_idemix2, only : cvmix_init_idemix2 , & - cvmix_compute_groupvel_idemix2 , & - cvmix_compute_interact_tscale_idemix2 + use cvmix_idemix2, only : cvmix_idemix2_init , & + cvmix_idemix2_compute_param , & + cvmix_idemix2_compute_compart_groupvel , & + cvmix_idemix2_compute_compart_interact_tscale , & + cvmix_idemix2_compute_M2_dissipation , & + cvmix_idemix2_compute_vert_struct_fct , & + cvmix_idemix2_compute_vdiff_vdiss_Eiw , & + cvmix_idemix2_compute_Eiw_waveinteract , & + cvmix_idemix2_compute_Eiw_diss2KvAv use cvmix_put_get, only : cvmix_put use cvmix_kinds_and_types @@ -27,13 +33,16 @@ module g_cvmix_idemix2 ! module calls from FESOM use g_config , only: dt, flag_debug use o_param - use mod_mesh + use MOD_MESH USE MOD_PARTIT USE MOD_PARSUP use o_arrays + use o_tracers use g_comm_auto + use g_interp use g_read_other_NetCDF use g_dist2coast, only: compute_dist2coast + use find_up_downwind_triangles_interface implicit none public @@ -41,73 +50,97 @@ module g_cvmix_idemix2 ! OCECTL/CVMIX_IDEMIX_PARAM namelist parameters ! time scale for vertical symmetrisation (sec) ! real(kind=WP) :: idemix_tau_v = 86400.0 ! old - real(kind=WP) :: idemix2_tau_v = 172800.0 ! from Pollman et al. (2017), use 2days, 2*86400sec + real(kind=WP) :: idemix2_tau_v = 172800.0 ! from Pollman et al. (2017), use 2days, 2*86400sec ! time scale for horizontal symmetrisation, only necessary for lateral diffusion (sec), ! use 15days, 15*86400sec - real(kind=WP) :: idemix2_tau_h = 1296000.0 + real(kind=WP) :: idemix2_tau_h = 1296000.0 ! constant of order one derived from the shape of the spectrum in m space (dimensionless) - real(kind=WP) :: idemix2_gamma = 1.570 + real(kind=WP) :: idemix2_gamma = 1.570 ! spectral bandwidth in modes (dimensionless), or mode number scale, it describes over ! over how many equivalent modes the energy is spread ! real(kind=WP) :: idemix_jstar = 10.0 ! old - real(kind=WP) :: idemix2_jstar = 5.0 ! from Pollman et al. (2017) + real(kind=WP) :: idemix2_jstar = 5.0 ! from Pollman et al. (2017) ! dissipation parameter (dimensionless) ! real(kind=WP) :: idemix_mu0 = 1.33333333 ! old - real(kind=WP) :: idemix2_mu0 = 0.33333333 ! from Pollman et al. (2017), use 2days + real(kind=WP) :: idemix2_mu0 = 0.33333333 ! from Pollman et al. (2017), use 2days + ! use superbee-spectral advection scheme and Adams-Bashfort timestepping +! logical :: idemix2_enable_superbee_adv = .true. + logical :: idemix2_enable_AB_timestep = .true. + integer :: idemix2_AB_epsilon = 0.1_WP + ! number of spectral bins used for the M2 tidal and near-inertial wave (niw) components + ! e.g 50+2 in loop used as do fbin=2,51 ... 1 and 52 serve as spectral boudary condition + ! The first and last bins are used for boundary conditions in the spectral space. + ! They ensure smooth transitions and prevent numerical instabilities at the edges of the spectral domain. + ! Numerical Stability: The advection scheme (e.g., Superbee) requires ghost cells or boundary values. + ! Skipping the first and last bins avoids out-of-bounds errors when calculating gradients. + integer :: idemix2_nfbin=52 + + ! enable adding of idemix full horizontal tendency from + ! div(grad(Eiw*v0)*v0*tauh) diffusion term + logical :: idemix2_enable_hor_diffusion = .false. + + ! enable idemix1 functionality of homogenous diffusion into all directions + logical :: idemix2_enable_hor_diff_iter = .false. + integer :: idemix2_hor_diff_niter = 5 ! from Pollman et al. (2017) + + ! define shelf is defined as distance from coast (default 300km) + real(kind=WP) :: idemix2_shelf_dist = 300.0e3 + + !___________________________________________________________________________ ! enable M2 tidal component as significant source of internal wave energy in IDEMIX2, ! lower frequency modes ! Frequency: Semi-diurnal (twice daily, ~12.42 hour period) ! Source : Barotropic tidal flow over rough topography ! Energy : Higher energy, lower frequency ! Impact : Dominant in regions with strong tidal currents - logical :: idemix2_enable_M2 = .true. + logical :: idemix2_enable_M2 = .true. + ! filelocation for idemix2 M2 forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) + character(MAX_PATH):: idemix2_M2forc_file = './idemix2_IT_forc_M2modes1+2_aniso.nc' + character(MAX_PATH):: idemix2_M2forc_vname= 'Flux_to2' + character(MAX_PATH):: idemix2_M2forc_zname= 'phi' + + !___________________________________________________________________________ ! enable Near-Inertial Wave (NIW) component of the IDEMIX module. NIWs are generated by ! wind stress and have frequencies close to the local inertial frequency. ! Frequency: Near the local inertial frequency (f, typically 1-4 cycles per day at mid-latitudes) ! Source : Wind forcing, especially during storms ! Energy : Lower energy, higher frequency than M2 ! Impact : Important in the upper ocean, especially after storms - logical :: idemix2_enable_niw = .false. + logical :: idemix2_enable_niw = .false. ! amount of surface for2cing that is used - real(kind=WP) :: idemix2_fniw_usage = 0.2 - - ! use superbee-spectral advection scheme and Adams-Bashfort timestepping - logical :: idemix2_enable_superbee_adv = .true. - logical :: idemix2_enable_AB_timestep = .true. - - ! number of spectral bins used for the M2 tidal and near-inertial wave (niw) components - ! e.g 50+2 in loop used as do fbin=2,51 ... 1 and 52 serve as spectral boudary condition - ! The first and last bins are used for boundary conditions in the spectral space. - ! They ensure smooth transitions and prevent numerical instabilities at the edges of the spectral domain. - ! Numerical Stability: The advection scheme (e.g., Superbee) requires ghost cells or boundary values. - ! Skipping the first and last bins avoids out-of-bounds errors when calculating gradients. - integer :: idemix2_nfbin=52 - - ! enable idemix1 functionality of homogenous diffusion into all directions - logical :: idemix2_enable_hor_diffusion = .false. - integer :: idemix2_hor_diffusion_niter = 5 ! from Pollman et al. (2017) - - ! filelocation for idemix2 M2 forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) - character(MAX_PATH):: idemix2_M2forc_file = './idemix2_IT_forc_M2modes1+2_aniso.nc' - character(MAX_PATH):: idemix2_M2forc_vname= 'Flux_to2.nc' + real(kind=WP) :: idemix2_fniw_usage = 0.2 ! filelocation for idemix2 NIW forcing (near inertial waves) character(MAX_PATH):: idemix2_niwforc_file = './dummy.nc' character(MAX_PATH):: idemix2_niwforc_vname= 'dummy' + !___________________________________________________________________________ ! filelocation for idemix2 bottom forcing + logical :: idemix2_enable_bot = .true. + character(MAX_PATH):: idemix2_botforc_file = './tidal_energy_gx1v6_20090205_rgrid.nc' character(MAX_PATH):: idemix2_botforc_vname= 'wave_dissipation' ! total global Energy input that should be conserved if 0.0 no conservation is applied real(kind=WP) :: idemix2_botforc_Etot = 0.0_WP ! units W + !___________________________________________________________________________ + ! enable lee wave source of internal wave energy in IDEMIX2, + ! Lee Wave Generation: Generated when mean flow encounters topography Energy + ! transfers from mean flow to internal waves + logical :: idemix2_enable_leew = .true. + + ! filelocation for idemix2 M2 forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) + character(MAX_PATH):: idemix2_leewforc_file = './idemix2_lee_forc_Eden.nc' + character(MAX_PATH):: idemix2_leewforc_vname= 'C_lee' + + !___________________________________________________________________________ ! filelocation for idemix2 Root Mean Square Topographic Height forcing. Measures the roughness or ! variability of seafloor topography. Units: Meters (m), Role: Represents the standard deviation ! of seafloor height variations. Used to calculate energy transfer from tides/NIW to internal waves. @@ -120,65 +153,66 @@ module g_cvmix_idemix2 character(MAX_PATH):: idemix2_hlamforc_file = './idemix2_forcing_t-scattering_1deg.nc' character(MAX_PATH):: idemix2_hlamforc_vname= 'LAMBDA_G10' - ! define shelf is defined as distance from coast (default 300km) - real(kind=WP) :: idemix2_shelf_dist = 300.0e3 - namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, & - idemix2_enable_M2, idemix2_enable_niw, idemix2_fniw_usage, & - idemix2_enable_superbee_adv, idemix2_enable_AB_timestep, idemix2_nfbin, & - idemix2_enable_hor_diffusion, idemix2_hor_diffusion_niter, & + idemix2_enable_AB_timestep, idemix2_nfbin, & ! idemix2_enable_superbee_adv + idemix2_enable_hor_diffusion, idemix2_enable_hor_diff_iter, idemix2_hor_diff_niter, & idemix2_shelf_dist, & idemix2_botforc_Etot, & - idemix2_M2forc_file , idemix2_M2forc_vname , & - idemix2_niwforc_file , idemix2_niwforc_vname , & - idemix2_botforc_file , idemix2_botforc_vname , & + idemix2_enable_M2 , idemix2_M2forc_file , idemix2_M2forc_vname , idemix2_M2forc_zname, & + idemix2_enable_niw , idemix2_niwforc_file , idemix2_niwforc_vname , idemix2_fniw_usage, & + idemix2_enable_leew, idemix2_leewforc_file, idemix2_leewforc_vname, & + idemix2_enable_bot , idemix2_botforc_file , idemix2_botforc_vname , & idemix2_hrmsforc_file, idemix2_hrmsforc_vname, & idemix2_hlamforc_file, idemix2_hlamforc_vname !___________________________________________________________________________ ! CVMIX-IDEMIX variables + real(kind=WP), allocatable, dimension(:) :: iwe2_phit, iwe2_phiu, iwe2_dphit, iwe2_dphiu - ! M2 and niw frequency in 1/s - real(kind=WP) :: iwe2_omega_M2 - real(kind=WP), allocatable, dimension(:) :: iwe2_omega_niw, iwe2_grady_coriol - - real(kind=WP) :: iwe2_dphit, iwe2_dphiu - real(kind=WP), allocatable, dimension(:) :: iwe2_phit, iwe2_phiu, aux - - real(kind=WP), allocatable, dimension(:,:) :: iwe2, iwe2_n, iwe2_tm1, iwe2_tm2 - real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2, iwe2_M2_tm1, iwe2_M2_tm2 - real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw, iwe2_niw_tm1, iwe2_niw_tm2 - - real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_u, iwe2_M2_v, iwe2_M2_w - real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_u, iwe2_niw_v, iwe2_niw_w - - real(kind=WP), allocatable, dimension(:) :: iwe2_cn, iwe2_cg_M2, iwe2_cg_niw - real(kind=WP), allocatable, dimension(:,:) :: iwe2_c0, iwe2_v0 - - real(kind=WP), allocatable, dimension(:,:) :: iwe2_alpha_c, iwe2_alpha_c_n - real(kind=WP), allocatable, dimension(:) :: iwe2_alpha_M2_c - - real(kind=WP), allocatable, dimension(:) :: iwe2_topo_hrms, iwe2_topo_hlam, iwe2_topo_dist, iwe2_topo_shelf - real(kind=WP), allocatable, dimension(:) :: iwe2_M2_tau, iwe2_niw_tau + ! M2 related global variables + real(kind=WP) :: iwe2_omega_M2 + real(kind=WP), allocatable, dimension(:,:,:):: iwe2_M2_uv, iwe2_E_M2, iwe2_Ediv_M2 + real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_w, iwe2_fM2, iwe2_E_struct_M2 + real(kind=WP), allocatable, dimension(:) :: w_M2_e, iwe2_alpha_M2_c, iwe2_M2_tau + + ! niw related global variables + real(kind=WP), allocatable, dimension(:) :: iwe2_omega_niw + real(kind=WP), allocatable, dimension(:,:,:):: iwe2_niw_uv, iwe2_E_niw, iwe2_Ediv_niw + real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_w, iwe2_fniw, iwe2_E_struct_niw + real(kind=WP), allocatable, dimension(:) :: w_niw_e, iwe2_niw_tau - real(kind=WP), allocatable, dimension(:) :: iwe2_fbot, iwe2_fsrf - real(kind=WP), allocatable, dimension(:,:) :: iwe2_fM2, iwe2_fniw + ! general idemix variable + real(kind=WP), allocatable, dimension(:) :: iwe2_cn + real(kind=WP), allocatable, dimension(:,:) :: iwe2_c0, iwe2_v0, iwe2_alpha_c - real(kind=WP), allocatable, dimension(:,:) :: iwe2_Av, iwe2_Kv + ! forcing realted variables + real(kind=WP), allocatable, dimension(:) :: iwe2_topo_hrms, iwe2_topo_hlam, iwe2_topo_dist, iwe2_topo_shelf + real(kind=WP), allocatable, dimension(:) :: iwe2_fbot_e, iwe2_fleew, iwe2_fsrf + real(kind=WP), allocatable, dimension(:,:) :: iwe2_fbot - real(kind=WP), allocatable, dimension(:,:) :: iwe2_Ttot, iwe2_Tdif, iwe2_Thdi, iwe2_Tdis, iwe2_Tdis_n, iwe2_Tsur, iwe2_Tbot + ! Eiw - internal wave energy related variables + real(kind=WP), allocatable, dimension(:,:,:):: iwe2_E_iw + real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_iw_diss, iwe2_E_iw_dt, iwe2_E_iw_fbot, & + iwe2_E_iw_vdif, iwe2_E_iw_hdif + real(kind=WP), allocatable, dimension(:) :: iwe2_E_iw_fsrf, iwe_E_iw_vint -! real(kind=WP), allocatable, dimension(:,:) :: cvmix_dummy_1, cvmix_dummy_2, cvmix_dummy_3 + real(kind=WP), allocatable, dimension(:,:) :: iwe2_Av - real(kind=WP), allocatable, dimension(:,:) :: vol_wcelli + ! support variables + real(kind=WP), allocatable, dimension(:,:) :: vol_wcelli + integer , allocatable, dimension(:,:) :: edge_up_dn_tri + real(kind=WP), allocatable, dimension(:) :: iwe2_grady_coriol, aux + real(kind=WP), allocatable, dimension(:,:,:):: iwe2_gradxy_e, iwe2_gradxy_n + real(kind=WP), allocatable, dimension(:,: ):: iwe2_flx_uv, iwe2_flx_w, iwe2_div_hv + integer :: taum1=1, tau=2, taup1=3, otaum1 ! load variables from CVMix list - type(cvmix_data_type) :: CVMix_vars - - ! nils/ - integer :: tstep_count + type(cvmix_data_type) :: CVMix_vars contains + + + ! ! ! @@ -187,12 +221,13 @@ module g_cvmix_idemix2 ! routine from cvmix library subroutine init_cvmix_idemix2(partit, mesh) implicit none - type(t_mesh), intent(in), target :: mesh + type(t_mesh), intent(inout), target :: mesh type(t_partit), intent(inout), target :: partit character(len=cvmix_strlen) :: nmlfile logical :: file_exist=.False. - integer :: node_size, elem_size, elem, nfbin, fbin_i, elnodes(3) + integer :: node_size, elem_size, elem, node, nfbin, & + fbin_i, elnodes(3), nzmax real(kind=WP) :: loc_Etot=0.0_WP, glb_Etot=0.0_WP real(kind=WP) :: t0, t1 #include "../associate_part_def.h" @@ -212,139 +247,165 @@ subroutine init_cvmix_idemix2(partit, mesh) elem_size=myDim_elem2D+eDim_elem2D nfbin =idemix2_nfbin - ! allocate dummy variable - allocate(aux(elem_size)) - aux(:) = 0.0_WP + ! 3d vertical group velocities (m/s) for the continuous internal wave spectrum + ! 3d horizontal group velocities (m/s) for the continuous internal wave spectrum + allocate(iwe2_c0(nl,node_size), iwe2_v0(nl,node_size)) + iwe2_c0(:,:) = 0.0_WP + iwe2_v0(:,:) = 0.0_WP - ! lat gradient in coriolis (is only computed @init) - allocate(iwe2_grady_coriol(myDim_elem2D)) - iwe2_grady_coriol(:)= 0.0_WP + ! baroclionic gravity wave speed + allocate(iwe2_cn(node_size)) + iwe2_cn(:) = 0.0_WP - allocate(iwe2_omega_niw(myDim_elem2D)) - iwe2_omega_niw(:) = 0.0_WP + ! Eiw 3d enery dissipation coefficient + allocate(iwe2_alpha_c(nl,node_size)) + iwe2_alpha_c(:,:) = 0.0_WP - ! allocate 1d Spectral space coordinates - allocate(iwe2_phit(nfbin), iwe2_phiu(nfbin)) - iwe2_phit(:) = 0.0_WP - iwe2_phiu(:) = 0.0_WP - - ! Internal wave energy at time levels - allocate(iwe2(nl,elem_size), iwe2_tm1(nl,elem_size), iwe2_tm2(nl,elem_size), iwe2_n(nl,node_size)) - iwe2(:,:) = 0.0_WP ! E_iw(t) - iwe2_n(:,:) = 0.0_WP ! E_iw(t) - iwe2_tm1(:,:) = 0.0_WP ! E_iw(t-1) - iwe2_tm2(:,:) = 0.0_WP ! E_iw(t-2) - - ! M2 wave energy at time levels - allocate(iwe2_M2(nl,elem_size), iwe2_M2_tm1(nl,elem_size), iwe2_M2_tm2(nl,elem_size)) - iwe2_M2(:,:) = 0.0_WP ! E_M2(t) - iwe2_M2_tm1(:,:) = 0.0_WP ! E_M2(t-1) - iwe2_M2_tm2(:,:) = 0.0_WP ! E_M2(t-2) - - ! niw wave energy at time levels - allocate(iwe2_niw(nl,elem_size), iwe2_niw_tm1(nl,elem_size), iwe2_niw_tm2(nl,elem_size)) - iwe2_niw(:,:) = 0.0_WP ! E_niw(t) - iwe2_niw_tm1(:,:) = 0.0_WP ! E_niw(t-1) - iwe2_niw_tm2(:,:) = 0.0_WP ! E_niw(t-2) + ! initialise Eiw - internal wave energy variables + ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) + allocate(iwe2_E_iw( 3, nl, node_size)) + allocate(iwe2_E_iw_diss(nl, node_size), iwe2_E_iw_dt(nl, node_size), iwe2_E_iw_fbot(nl, node_size)) + allocate(iwe2_E_iw_vdif(nl, node_size), iwe2_E_iw_hdif(nl, node_size)) + allocate(iwe2_E_iw_fsrf(node_size)) + iwe2_E_iw( :,:,:)= 0.0_WP - ! internal wave related vertical viscosity and diffusivity - allocate(iwe2_Av(nl,elem_size)) - allocate(iwe2_Kv(nl,elem_size)) - iwe2_Av(:,:) = 0.0_WP - iwe2_Kv(:,:) = 0.0_WP - - allocate(vol_wcelli(nl,node_size)) - vol_wcelli(:,:) = 0.0_WP - - ! M2 group velocity components - allocate(iwe2_M2_u(nfbin,elem_size), iwe2_M2_v(nfbin,elem_size), iwe2_M2_w(nfbin,elem_size)) - iwe2_M2_u(:,:) = 0.0_WP - iwe2_M2_v(:,:) = 0.0_WP - iwe2_M2_w(:,:) = 0.0_WP - - ! NIW group velocity components (i,j,np) - allocate(iwe2_niw_u(nfbin,elem_size), iwe2_niw_v(nfbin,elem_size), iwe2_niw_w(nfbin,elem_size)) - iwe2_niw_u(:,:) = 0.0_WP - iwe2_niw_v(:,:) = 0.0_WP - iwe2_niw_w(:,:) = 0.0_WP - - ! Vertical group velocity c0, Horizontal gfxaroup velocity v0 - allocate(iwe2_c0(nl,elem_size), iwe2_v0(nl,elem_size)) - iwe2_c0(:,:) = 0.0_WP - iwe2_v0(:,:) = 0.0_WP - - allocate(iwe2_cg_M2(elem_size), iwe2_cg_niw(elem_size)) - iwe2_cg_M2(:) = 0.0_WP - iwe2_cg_niw(:) = 0.0_WP + ! Eiw production terms: + iwe2_E_iw_dt( :,:)= 0.0_WP ! total Eiw production + iwe2_E_iw_diss( :,:)= 0.0_WP ! Eiw production from disspation + iwe2_E_iw_fbot( :,:)= 0.0_WP ! Eiw production from bottom forcing + iwe2_E_iw_hdif( :,:)= 0.0_WP ! Eiw production from horizontal diffusion + iwe2_E_iw_vdif( :,:)= 0.0_WP ! Eiw production from vertical diffusion + iwe2_E_iw_fsrf( :)= 0.0_WP ! Eiw production from surface forcing - allocate(iwe2_cn(node_size)) - iwe2_cn(:) = 0.0_WP + ! initialise M2 variables + if (idemix2_enable_M2) then + ! M2 energy dissipation + allocate(iwe2_alpha_M2_c(node_size)) + iwe2_alpha_M2_c(:) = 0.0_WP + + ! M2 dissipation timescale + allocate(iwe2_M2_tau(myDim_nod2D)) + iwe2_M2_tau(:) = 0.0_WP + + ! M2 cross spectral propagation at elements + allocate(w_M2_e(nfbin)) + w_M2_e(:) = 0.0_WP + + ! M2 zonal/merid group velocity, and cross spectral propagation + ! at vertices + allocate(iwe2_M2_uv(2, nfbin,elem_size)) + allocate(iwe2_M2_w( nfbin,node_size)) + iwe2_M2_uv(:,:,:) = 0.0_WP + iwe2_M2_w(:,:) = 0.0_WP + + ! M2 forcing + allocate(iwe2_fM2(nfbin, myDim_nod2D)) + iwe2_fM2(:,:) = 0.0_WP + + ! M2 wave energy, and divergence of M2 wave energy + ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) + allocate(iwe2_E_M2( 3, nfbin, node_size), iwe2_Ediv_M2(3, nfbin, node_size)) + iwe2_E_M2( :,:,:) = 0.0_WP + iwe2_Ediv_M2( :,:,:) = 0.0_WP + + ! structure function for M2 energy + allocate(iwe2_E_struct_M2(nl-1, node_size)) + iwe2_E_struct_M2(:,:) = 0.0_WP + end if - ! Dissipation coefficient - allocate(iwe2_alpha_c(nl,elem_size), iwe2_alpha_c_n(nl,node_size), iwe2_alpha_M2_c(elem_size)) - iwe2_alpha_c(:,:) = 0.0_WP - iwe2_alpha_M2_c(:) = 0.0_WP - iwe2_alpha_c_n(:,:) = 0.0_WP + ! initialise niw variables + if (idemix2_enable_niw) then + ! niw frequency + allocate(iwe2_omega_niw(node_size)) + iwe2_omega_niw(:) = 0.0_WP + + ! niw dissipation timescale + allocate(iwe2_niw_tau(myDim_nod2D)) + iwe2_niw_tau(:) = 0.0_WP + + ! niw cross spectral propagation at elements + allocate(w_niw_e(nfbin)) + w_niw_e(:) = 0.0_WP + + ! niw zonal/merid group velocity, and cross spectral propagation + ! at vertices + allocate(iwe2_niw_uv(2, nfbin,elem_size)) + allocate(iwe2_niw_w( nfbin,node_size)) + iwe2_niw_uv(:,:,:) = 0.0_WP + iwe2_niw_w(:,:) = 0.0_WP + + ! niw forcing + allocate(iwe2_fniw(nfbin, myDim_nod2D)) + iwe2_fniw(:,:) = 0.0_WP + + ! niw wave energy, and divergence of niw wave energy + ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) + allocate(iwe2_E_niw( 3, nfbin, node_size), iwe2_Ediv_niw(3, nfbin, node_size)) + iwe2_E_niw( :,:,:) = 0.0_WP + iwe2_Ediv_niw( :,:,:) = 0.0_WP + + ! structure function for niw energy + allocate(iwe2_E_struct_niw(nl, node_size)) + iwe2_E_struct_niw(:,:) = 0.0_WP + + end if + ! allocate 1d Spectral space coordinates + allocate(iwe2_phit(nfbin), iwe2_phiu(nfbin), iwe2_dphit(nfbin), iwe2_dphiu(nfbin)) + iwe2_phit(:) = 0.0_WP + iwe2_phiu(:) = 0.0_WP + iwe2_dphit(:) = 0.0_WP + iwe2_dphiu(:) = 0.0_WP + + ! internal wave related vertical viscosity and diffusivity + allocate(iwe2_Av(nl,elem_size)) + iwe2_Av(:,:) = 0.0_WP + ! forcing fields, M2 tidal forcing (spectral) and NIW forcing (spectral) - allocate(iwe2_fbot(myDim_elem2D), iwe2_fsrf(myDim_elem2D)) - allocate(iwe2_fM2(nfbin, myDim_elem2D), iwe2_fniw(nfbin, myDim_elem2D)) - iwe2_fbot(:) = 0.0_WP - iwe2_fsrf(:) = 0.0_WP - iwe2_fM2(:,:) = 0.0_WP - iwe2_fniw(:,:) = 0.0_WP + allocate(iwe2_fbot_e(myDim_elem2D), iwe2_fbot(nl, node_size), & + iwe2_fleew(myDim_elem2D), iwe2_fsrf(myDim_nod2D)) + iwe2_fbot_e(:) = 0.0_WP + iwe2_fbot(:,:) = 0.0_WP + iwe2_fleew(:) = 0.0_WP + iwe2_fsrf(:) = 0.0_WP ! Topographic height and Topographic wavelength - allocate(iwe2_topo_hrms(myDim_elem2D), iwe2_topo_hlam(myDim_elem2D), iwe2_topo_shelf(myDim_elem2D), iwe2_topo_dist(myDim_elem2D)) - iwe2_topo_hrms(:) = 0.0_WP - iwe2_topo_hlam(:) = 0.0_WP - iwe2_topo_shelf(:) = 0.0_WP - iwe2_topo_dist(:) = 0.0_WP - - ! M2 and NIW dissipation timescale - allocate(iwe2_M2_tau(myDim_elem2D),iwe2_niw_tau(myDim_elem2D)) - iwe2_M2_tau(:) = 0.0_WP - iwe2_niw_tau(:) = 0.0_WP - -! ! diagnostic -! allocate(iwe2_Ttot(nl,elem_size)) -! allocate(iwe2_Tdif(nl,elem_size)) -! allocate(iwe2_Thdi(nl,elem_size)) -! allocate(iwe2_Tdis(nl,elem_size), iwe2_Tdis_n(nl,node_size)) -! allocate(iwe2_Tsur(nl,elem_size)) -! allocate(iwe2_Tbot(nl,elem_size)) -! iwe2_Ttot(:,:) = 0.0_WP -! iwe2_Tdif(:,:) = 0.0_WP -! iwe2_Thdi(:,:) = 0.0_WP -! iwe2_Tdis(:,:) = 0.0_WP -! iwe2_Tsur(:,:) = 0.0_WP -! iwe2_Tbot(:,:) = 0.0_WP -! iwe2_Tdis_n(:,:) = 0.0_WP - -! allocate(cvmix_dummy_1(nl,elem_size)) -! allocate(cvmix_dummy_2(nl,elem_size)) -! allocate(cvmix_dummy_3(nl,elem_size)) -! cvmix_dummy_1(:,:) = 0.0_WP -! cvmix_dummy_2(:,:) = 0.0_WP -! cvmix_dummy_3(:,:) = 0.0_WP - - ! nils (for debugging) - tstep_count = 0 + allocate(iwe2_topo_hrms(myDim_nod2D), iwe2_topo_hlam(myDim_nod2D), iwe2_topo_shelf(myDim_nod2D), iwe2_topo_dist(myDim_elem2D)) + iwe2_topo_hrms(:) = 0.0_WP + iwe2_topo_hlam(:) = 0.0_WP + iwe2_topo_shelf(:) = 0.0_WP + iwe2_topo_dist(:) = 0.0_WP + + ! support gradient variables + allocate(iwe2_grady_coriol(myDim_elem2D)) + allocate(iwe2_gradxy_e(2, nfbin, elem_size), iwe2_gradxy_n(2, nfbin, myDim_nod2D)) + iwe2_grady_coriol(:) = 0.0_WP + iwe2_gradxy_e(:,:,:) = 0.0_WP + iwe2_gradxy_n(:,:,:) = 0.0_WP + + ! support horizontal edge flux and vertical flux and accumulated divergence variables + allocate(iwe2_flx_uv(nfbin, partit%myDim_edge2D), iwe2_flx_w(nfbin, node_size), iwe2_div_hv(nfbin, node_size)) + iwe2_flx_uv(:,:) = 0.0 + iwe2_flx_w(:,:) = 0.0 + iwe2_div_hv(:,:) = 0.0 + + ! support inverse volume of wcell + allocate(vol_wcelli(nl, node_size)) + vol_wcelli(:,:) = 0.0_WP !_______________________________________________________________________ ! width of spectral frequency bins - iwe2_dphit = 2.0_WP*pi/(nfbin-2) - iwe2_dphiu = iwe2_dphit + iwe2_dphit(:) = 2.0_WP*pi/(nfbin-2) + iwe2_dphiu(:) = iwe2_dphit(:) ! iwe2_phiu(k) represents the center of the k-th spectral bin ! iwe2_phit(k) represents the edge of the k-th spectral bin - iwe2_phit(1) = -iwe2_dphit - iwe2_phiu(1 )= iwe2_phit(1)+iwe2_dphit/2.0_WP + iwe2_phit(1) = -iwe2_dphit(1) + iwe2_phiu(1 )= iwe2_phit(1)+iwe2_dphit(1)/2.0_WP do fbin_i=2,nfbin - iwe2_phit(fbin_i) = iwe2_phit(fbin_i-1) + iwe2_dphit - iwe2_phiu(fbin_i) = iwe2_phiu(fbin_i-1) + iwe2_dphiu + iwe2_phit(fbin_i) = iwe2_phit(fbin_i-1) + iwe2_dphit(fbin_i) + iwe2_phiu(fbin_i) = iwe2_phiu(fbin_i-1) + iwe2_dphiu(fbin_i) end do - !_______________________________________________________________________ ! read cvmix namelist file nmlfile ='namelist.cvmix' ! name of ocean namelist file @@ -359,45 +420,49 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) ' could not find namelist.cvmix, will use default values !' end if - !_______________________________________________________________________ if (mype==0) then write(*,*) " IDEMIX2 parameters:" - write(*,*) " ├> idemix2_tau_v = ", idemix2_tau_v - write(*,*) " ├> idemix2_tau_h = ", idemix2_tau_h - write(*,*) " ├> idemix2_gamma = ", idemix2_gamma - write(*,*) " ├> idemix2_jstar = ", idemix2_jstar - write(*,*) " ├> idemix2_mu0 = ", idemix2_mu0 - write(*,*) " │ " - write(*,*) " ├> idemix2_superbee_adv = ", idemix2_enable_superbee_adv - write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB_timestep - write(*,*) " ├> idemix2_nfbin = ", idemix2_nfbin - write(*,*) " │ " - write(*,*) " ├> idemix2_enable_M2 = ", idemix2_enable_M2 - write(*,*) " │ └> idemix2_M2forc_file = ", trim(idemix2_M2forc_file) - write(*,*) " │ └> idemix2_M2forc_vname = ", trim(idemix2_M2forc_vname) - write(*,*) " │ " - write(*,*) " ├> idemix2_enable_niw = ", idemix2_enable_niw - write(*,*) " │ ├> idemix2_fniw_usage = ", idemix2_fniw_usage - write(*,*) " │ └> idemix2_niwforc_file = ", trim(idemix2_niwforc_file) - write(*,*) " │ └> idemix2_niwforc_vname= ", trim(idemix2_niwforc_vname) - write(*,*) " │ " - write(*,*) " ├> idemix2_botforc_file = ", trim(idemix2_botforc_file) - write(*,*) " │ ├> idemix2_botforc_vname = ", trim(idemix2_botforc_vname) - write(*,*) " │ └> idemix2_botforc_Etot = ", idemix2_botforc_Etot - write(*,*) " │ " - write(*,*) " ├> idemix2_hrmsforc_file = ", trim(idemix2_hrmsforc_file) - write(*,*) " │ └> idemix2_hrmsforc_vname = ", trim(idemix2_hrmsforc_vname) - write(*,*) " │ " - write(*,*) " ├> idemix2_hlamforc_file = ", trim(idemix2_hlamforc_file) - write(*,*) " │ └> idemix2_hlamforc_vname = ", trim(idemix2_hlamforc_vname) - write(*,*) " │ " + write(*,*) " ├> idemix2_tau_v = ", idemix2_tau_v + write(*,*) " ├> idemix2_tau_h = ", idemix2_tau_h + write(*,*) " ├> idemix2_gamma = ", idemix2_gamma + write(*,*) " ├> idemix2_jstar = ", idemix2_jstar + write(*,*) " ├> idemix2_mu0 = ", idemix2_mu0 + write(*,*) " │ " +! write(*,*) " ├> idemix2_superbee_adv = ", idemix2_enable_superbee_adv + write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB_timestep + write(*,*) " ├> idemix2_nfbin = ", idemix2_nfbin + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_M2 = ", idemix2_enable_M2 + write(*,*) " │ └> idemix2_M2forc_file = ", trim(idemix2_M2forc_file) + write(*,*) " │ ├> idemix2_M2forc_vname = ", trim(idemix2_M2forc_vname) + write(*,*) " │ └> idemix2_M2forc_zname = ", trim(idemix2_M2forc_zname) + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_niw = ", idemix2_enable_niw + write(*,*) " │ ├> idemix2_fniw_usage = ", idemix2_fniw_usage + write(*,*) " │ └> idemix2_niwforc_file = ", trim(idemix2_niwforc_file) + write(*,*) " │ └> idemix2_niwforc_vname = ", trim(idemix2_niwforc_vname) + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_bot = ", idemix2_enable_bot + write(*,*) " │ └> idemix2_botforc_file = ", trim(idemix2_botforc_file) + write(*,*) " │ ├> idemix2_botforc_vname = ", trim(idemix2_botforc_vname) + write(*,*) " │ └> idemix2_botforc_Etot = ", idemix2_botforc_Etot + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_leew = ", idemix2_enable_leew + write(*,*) " │ └> idemix2_leewforc_file = ", trim(idemix2_leewforc_file) + write(*,*) " │ └> idemix2_leewforc_vname= ", trim(idemix2_leewforc_vname) + write(*,*) " │ " + write(*,*) " ├> idemix2_hrmsforc_file = ", trim(idemix2_hrmsforc_file) + write(*,*) " │ └> idemix2_hrmsforc_vname = ", trim(idemix2_hrmsforc_vname) + write(*,*) " │ " + write(*,*) " ├> idemix2_hlamforc_file = ", trim(idemix2_hlamforc_file) + write(*,*) " │ └> idemix2_hlamforc_vname = ", trim(idemix2_hlamforc_vname) + write(*,*) " │ " WRITE(*,*) " └> idemix2_shelf_dist = ", idemix2_shelf_dist write(*,*) write(*,*) " IDEMIX2 inputs:" end if - !_______________________________________________________________________ ! read idemix M2 forcing from cfsr data --> file if (idemix2_enable_M2) then @@ -412,13 +477,18 @@ subroutine init_cvmix_idemix2(partit, mesh) inquire(file=trim(idemix2_M2forc_file),exist=file_exist) if (file_exist) then if (mype==0) write(*,*) ' ├> read IDEMIX2 M2 wave forcing' - do fbin_i =2, nfbin-1 - call read_other_NetCDF(trim(idemix2_M2forc_file), trim(idemix2_M2forc_vname), fbin_i, aux, .true., .false., partit, mesh) - ! | - ! .false.=interpolate on element centroids instead of vertices <---+ - iwe2_fM2(fbin_i, :) = aux/density_0/iwe2_dphit - end do - deallocate(aux) + call read_other_NetCDF_3d( & + trim(idemix2_M2forc_file) , & + trim(idemix2_M2forc_vname) , & + trim(idemix2_M2forc_zname) , & + iwe2_fM2 , & + .true. , & !.true. -> on node + partit , & + mesh & + ) + do fbin_i = 1, nfbin + iwe2_fM2(fbin_i,:) = iwe2_fM2(fbin_i,:)/density_0/iwe2_dphit(fbin_i) + end do else if (mype==0) then print *, achar(27)//'[33m' @@ -430,22 +500,29 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) '____________________________________________________________________' print *, achar(27)//'[0m' write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if end if + if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) t1=MPI_Wtime() - if (mype==0) write(*,*) ' | └> elapsed time:', t1-t0 + if (mype==0) write(*,*) ' │ └> elapsed time:', t1-t0 end if ! --> if (idemix2_enable_M2) then - !_______________________________________________________________________ ! read idemix niw oe srf forcing from cfsr data --> file t0=MPI_Wtime() file_exist=.False. inquire(file=trim(idemix2_niwforc_file),exist=file_exist) if (file_exist) then - - call read_other_NetCDF(trim(idemix2_niwforc_file), trim(idemix2_niwforc_vname), 1, iwe2_fsrf, .true., .false., partit, mesh) + call read_other_NetCDF( & + trim(idemix2_niwforc_file) , & + trim(idemix2_niwforc_vname) , & + 1 , & + iwe2_fsrf , & + .true. , & + .true. , & + partit , & + mesh & + ) ! only 20% (idemix2_fniw_usage) from the surface forcing goes into internal waves ! iwe2_fsrf becomes surface forcing variable when idemix2_enable_niw=.false. ! in this case standard idemix1 behaviour @@ -453,7 +530,7 @@ subroutine init_cvmix_idemix2(partit, mesh) if (idemix2_enable_niw) then if (mype==0) write(*,*) ' ├> read IDEMIX2 niw wave forcing' do fbin_i =2, nfbin-1 - iwe2_fniw(fbin_i, :) = iwe2_fsrf/iwe2_dphit !!!ATTENTION CHECK THIS AGAIN!!! + iwe2_fniw(fbin_i, :) = iwe2_fsrf(:)/iwe2_dphit(fbin_i) !!!ATTENTION CHECK THIS AGAIN!!! end do iwe2_fsrf(:) = 0.0_WP else @@ -471,9 +548,9 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) '____________________________________________________________________' print *, achar(27)//'[0m' write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if end if + if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) ! NIWs are super-inertial (ω_niw > |f|), which is essential for their propagation as internal waves. ! The factor 1.05 ensures the frequency is 5% above the local inertial frequency. @@ -481,80 +558,111 @@ subroutine init_cvmix_idemix2(partit, mesh) ! from background flows. Physical Context: NIWs are generated by wind events and have frequencies ! close to f. They can only propagate as internal waves if ω > |f|. if (idemix2_enable_niw) then - do elem = 1, myDim_elem2D - iwe2_omega_niw(elem) = max(1d-8, abs( 1.05 * mesh%coriolis(elem) ) ) + do node = 1, myDim_nod2D + iwe2_omega_niw(node) = max(1d-8, abs( 1.05 * mesh%coriolis_node(elem) ) ) end do - call exchange_elem(iwe2_omega_niw, partit) end if t1=MPI_Wtime() - if (mype==0) write(*,*) ' | └> elapsed time:', t1-t0 + if (mype==0) write(*,*) ' │ └> elapsed time:', t1-t0 !_______________________________________________________________________ ! read idemix bottom near tidal forcing from cesm data set --> file ! from N. Brüggemann interpoalted to regular grid - t0=MPI_Wtime() - file_exist=.False. - inquire(file=trim(idemix2_botforc_file),exist=file_exist) - if (file_exist) then - if (mype==0) write(*,*) ' ├> read IDEMIX2 near tidal bottom forcing' - call read_other_NetCDF(trim(idemix2_botforc_file), trim(idemix2_botforc_vname), 1, iwe2_fbot, .true., .false., partit, mesh) - ! | - ! .false.=interpolate on element centroids instead of vertices <---+ - - ! check for total tidal energy that is infused through the bottom, see how - ! much is lossed during interpolation and compare with value of the - ! original files - loc_Etot = 0.0_WP - do elem=1, myDim_elem2D - ! REMEMBER!!!: the partition on elements is not unique there are - ! elements that belong to two CPUs. For unique elements the index - ! of the First trinagle node must be <= myDim_nod2D - if (elem2D_nodes(1,elem)<=myDim_nod2D) then - loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot(elem) - end if - end do - call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) - if (mype==0) write(*,*) " │ └> IDEMIX2 total tidal energy Etot_bot =", glb_Etot*1.0e-12, ' TW' - - ! normalize total tidal energy at bottom with respect to the total - ! tidal energy that is e.g in the original forcing files to accomodate - ! non concerving losses during interpolation. This is only done when - ! in namelist.cvmix: idemix2_botforc_Etot \= 0.0_WP - if (idemix2_botforc_Etot /= 0.0_WP) then - iwe2_fbot = iwe2_fbot * idemix2_botforc_Etot/glb_Etot + if (idemix2_enable_bot) then + t0=MPI_Wtime() + file_exist=.False. + inquire(file=trim(idemix2_botforc_file),exist=file_exist) + if (file_exist) then + if (mype==0) write(*,*) ' ├> read IDEMIX2 near tidal bottom forcing' + call read_other_NetCDF(trim(idemix2_botforc_file), trim(idemix2_botforc_vname), 1, iwe2_fbot_e, .true., .false., partit, mesh) + ! | + ! .false.=interpolate on element centroids instead of vertices <---+ + ! check for total tidal energy that is infused through the bottom, see how + ! much is lossed during interpolation and compare with value of the + ! original files loc_Etot = 0.0_WP do elem=1, myDim_elem2D ! REMEMBER!!!: the partition on elements is not unique there are ! elements that belong to two CPUs. For unique elements the index ! of the First trinagle node must be <= myDim_nod2D if (elem2D_nodes(1,elem)<=myDim_nod2D) then - loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot(elem) + loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot_e(elem) end if end do call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) - if (mype==0) write(*,*) " │ └> IDEMIX2 Etot_bot after normalizing =", glb_Etot*1.0e-12, ' TW' + if (mype==0) write(*,*) " │ └> IDEMIX2 total tidal energy Etot_bot =", glb_Etot*1.0e-12, ' TW' + + ! normalize total tidal energy at bottom with respect to the total + ! tidal energy that is e.g in the original forcing files to accomodate + ! non concerving losses during interpolation. This is only done when + ! in namelist.cvmix: idemix2_botforc_Etot \= 0.0_WP + if (idemix2_botforc_Etot /= 0.0_WP) then + iwe2_fbot_e = iwe2_fbot_e * idemix2_botforc_Etot/glb_Etot + + loc_Etot = 0.0_WP + do elem=1, myDim_elem2D + ! REMEMBER!!!: the partition on elements is not unique there are + ! elements that belong to two CPUs. For unique elements the index + ! of the First trinagle node must be <= myDim_nod2D + if (elem2D_nodes(1,elem)<=myDim_nod2D) then + loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot_e(elem) + end if + end do + call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + if (mype==0) write(*,*) " │ └> IDEMIX2 Etot_bot after normalizing =", glb_Etot*1.0e-12, ' TW' + end if + + ! divide by density_0 --> convert from W/m^2 to m^3/s^3 + iwe2_fbot_e = iwe2_fbot_e/density_0 + + else + if (mype==0) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: IDEMIX2 bottom forcing file not found! Cant apply IDEMIX' + write(*,*) ' vertical mixing parameterisation! ' + write(*,*) ' ├> file: ', trim(idemix2_botforc_file) + write(*,*) ' └> check: namelist.cvmix, idemix2_botforc_file' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + end if end if - - ! divide by density_0 --> convert from W/m^2 to m^3/s^3 - iwe2_fbot = iwe2_fbot/density_0 - - else - if (mype==0) then - print *, achar(27)//'[33m' - write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: IDEMIX2 bottom forcing file not found! Cant apply IDEMIX' - write(*,*) ' vertical mixing parameterisation! ' - write(*,*) ' ├> file: ', trim(idemix2_botforc_file) - write(*,*) ' └> check: namelist.cvmix, idemix2_botforc_file' - write(*,*) '____________________________________________________________________' - print *, achar(27)//'[0m' - write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + t1=MPI_Wtime() + if (mype==0) write(*,*) ' │ └> elapsed time:', t1-t0 + end if !--> if (idemix2_enable_bot) then + + !_______________________________________________________________________ + ! read Lee-Wave forcing + if (idemix2_enable_leew) then + t0=MPI_Wtime() + file_exist=.False. + inquire(file=trim(idemix2_leewforc_file),exist=file_exist) + if (file_exist) then + if (mype==0) write(*,*) ' ├> read IDEMIX2 lee wave forcing --> add to bottom forcing' + call read_other_NetCDF(trim(idemix2_leewforc_file), trim(idemix2_leewforc_vname), 1, iwe2_fleew, .true., .false., partit, mesh) + + iwe2_fbot_e = iwe2_fbot_e + iwe2_fleew + ! | + ! +-> no dividion by density_0, Lee wave Forcing + ! already in units of m^3/s^3 + else + if (mype==0) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: IDEMIX2 Lee-Wave forcing file not found! Cant apply IDEMIX2' + write(*,*) ' vertical mixing parameterisation! ' + write(*,*) ' ├> file: ', trim(idemix2_hrmsforc_file) + write(*,*) ' └> check: namelist.cvmix, idemix2_leewforc_file' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + end if end if - end if - t1=MPI_Wtime() - if (mype==0) write(*,*) ' │ └> elapsed time:', t1-t0 + if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + end if ! --> if (idemix2_enable_leew) then !_______________________________________________________________________ ! read idemix HRMS and HLAM forcing --> file @@ -563,11 +671,11 @@ subroutine init_cvmix_idemix2(partit, mesh) ! topo_hrms (Root Mean Square Topographic Height), Definition: Measures the roughness or variability of seafloor topography. ! Units: Meters (m), Role: Represents the standard deviation of seafloor height variations. Used to calculate ! energy transfer from tides/NIW to internal waves. - ! file_exist=.False. + file_exist=.False. inquire(file=trim(idemix2_hrmsforc_file),exist=file_exist) if (file_exist) then if (mype==0) write(*,*) ' ├> read IDEMIX2 HRMS forcing' - call read_other_NetCDF(trim(idemix2_hrmsforc_file), trim(idemix2_hrmsforc_vname), 1, iwe2_topo_hrms, .true., .false., partit, mesh) + call read_other_NetCDF(trim(idemix2_hrmsforc_file), trim(idemix2_hrmsforc_vname), 1, iwe2_topo_hrms, .true., .true., partit, mesh) else if (mype==0) then print *, achar(27)//'[33m' @@ -579,9 +687,9 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) '____________________________________________________________________' print *, achar(27)//'[0m' write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if end if + if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) ! topo_hlam (Topographic Wavelength), Definition: Characteristic horizontal length scale of topographic features. ! Units: Meters (m), Role: Represents the dominant wavelength of seafloor roughness. Used to normalize the topographic forcing. @@ -589,7 +697,7 @@ subroutine init_cvmix_idemix2(partit, mesh) inquire(file=trim(idemix2_hlamforc_file),exist=file_exist) if (file_exist) then if (mype==0) write(*,*) ' ├> read IDEMIX2 HLAM forcing' - call read_other_NetCDF(trim(idemix2_hlamforc_file), trim(idemix2_hlamforc_vname), 1, iwe2_topo_hlam, .true., .false., partit, mesh) + call read_other_NetCDF(trim(idemix2_hlamforc_file), trim(idemix2_hlamforc_vname), 1, iwe2_topo_hlam, .true., .true., partit, mesh) else if (mype==0) then print *, achar(27)//'[33m' @@ -604,6 +712,7 @@ subroutine init_cvmix_idemix2(partit, mesh) call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if end if + if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) ! In the M2 tidal and NIW energy calculations: ! --> fxc = topo_hrms(i,j)**2 * 2*pi / (1d-12 + topo_lam(i,j)) @@ -616,18 +725,27 @@ subroutine init_cvmix_idemix2(partit, mesh) ! waves over rough topography. t1=MPI_Wtime() - if (mype==0) write(*,*) ' | └> elapsed time:', t1-t0 + if (mype==0) write(*,*) ' │ └> elapsed time:', t1-t0 - end if ! --> if (idemix2_enable_niw) then + end if ! --> if (idemix2_enable_M2 .or. idemix2_enable_niw ) then + + !_______________________________________________________________________ + ! convert elemental bot forcing into nodal bottom forcing + do elem = 1, myDim_elem2D + nzmax = nlevels(elem) + elnodes = elem2d_nodes(:,elem) + iwe2_fbot(nzmax, elnodes(:)) = iwe2_fbot(nzmax, elnodes(:)) - iwe2_fbot_e(elem)/3.0 + end do !_______________________________________________________________________ ! compute centroid distance from nearset coastal point together with ! idemix2_shelf_dist defines what is shelf and what not - t0=MPI_Wtime() - call compute_dist2coast(iwe2_topo_dist, mesh, partit, 'elem') - t1=MPI_Wtime() - if (partit%mype==0) write(*,*) ' └> dist2coast elapsed time:', t1-t0 - + if (idemix2_enable_M2 .or. idemix2_enable_niw) then + t0=MPI_Wtime() + call compute_dist2coast(iwe2_topo_dist, mesh, partit, 'node') + t1=MPI_Wtime() + if (partit%mype==0) write(*,*) ' └> dist2coast elapsed time:', t1-t0 + end if !_______________________________________________________________________ ! compute d/dy of coriolis do elem = 1, myDim_elem2D @@ -635,9 +753,13 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_grady_coriol(elem) = sum(gradient_sca(4:6, elem)*mesh%coriolis_node(elnodes)) end do + !_______________________________________________________________________ + ! compute d/dy of coriolis + call find_up_downwind_triangles(partit, mesh, mesh%edge_up_dn_tri) + !_______________________________________________________________________ ! initialise IDEMIX parameters - call cvmix_init_idemix2(tau_v = idemix2_tau_v , & + call cvmix_idemix2_init(tau_v = idemix2_tau_v , & tau_h = idemix2_tau_h , & gamma = idemix2_gamma , & jstar = idemix2_jstar , & @@ -646,15 +768,18 @@ subroutine init_cvmix_idemix2(partit, mesh) shelf_dist = idemix2_shelf_dist , & enable_M2 = idemix2_enable_M2 , & enable_niw = idemix2_enable_niw , & - enable_superbee_adv = idemix2_enable_superbee_adv , & +! enable_superbee_adv = idemix2_enable_superbee_adv , & enable_AB_timestep = idemix2_enable_AB_timestep , & enable_hor_diffusion= idemix2_enable_hor_diffusion, & - hor_diffusion_niter = idemix2_hor_diffusion_niter & + enable_hor_diff_iter= idemix2_enable_hor_diff_iter, & + hor_diff_niter = idemix2_hor_diff_niter & ) if (partit%mype==0) write(*,*) end subroutine init_cvmix_idemix2 + + ! ! ! @@ -664,27 +789,36 @@ subroutine calc_cvmix_idemix2(partit, mesh) implicit none type(t_mesh), intent(in), target :: mesh type(t_partit), intent(inout), target :: partit - integer :: node, elem, edge, node_size, elem_size, k - integer :: nz, nln, nl1, nl2, nl12, nu1, nu2, nu12, uln, niter - integer :: elnodes1(3), elnodes2(3), el(2), ednodes(2) - real(kind=WP) :: dz_trr(mesh%nl), dz_trr2(mesh%nl), bvfreq2(mesh%nl), vflux, dz_el, aux, cflfac - real(kind=WP) :: grad_v0Eiw(2), lat_e_deg, deltaX1, deltaY1, deltaX2, deltaY2 - real(kind=WP) :: tsum1, tsum2, tsum3, tsum4, tvol - real(kind=WP) :: cn, cn_e, cn_gradx_e, cn_grady_e + integer :: node, elem, edge, node_size, elem_size, k, fbini, nfbin + integer :: nz, nln, nl1, nl2, nl12, nu1, nu2, nu12, uln, iter + integer :: elnodes(3), el(2), ednodes(2) + real(kind=WP) :: lat_n_deg, lat_e_deg + real(kind=WP) :: cn, cn_e, cn_gradx_e, cn_grady_e, omega_niw_e + logical :: topo_shelf=.False. logical :: debug=.false. -#include "../associate_part_def.h"omega_M2 +#include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" #include "../associate_mesh_ass.h" - ! nils - !tstep_count = tstep_count + 1 node_size = myDim_nod2D elem_size = myDim_elem2D + nfbin = idemix2_nfbin + !_______________________________________________________________________ + ! do tau timestepping indices shift + otaum1= taum1 + taum1 = tau + tau = taup1 + taup1 = otaum1; + if (mype==0) write(*,*) " --> taum1, tau, taup1: ", taum1, tau, taup1 !_______________________________________________________________________ - ! compute baroclinic gravity wave speed do node=1, node_size + + lat_n_deg = geo_coord_nod2D(2,node) * 180.0/pi + + !___________________________________________________________________ + ! compute baroclinic gravity wave speed nln = mesh%nl uln = 1 do nz=1, nod_in_elem2D_num(node) @@ -693,48 +827,197 @@ subroutine calc_cvmix_idemix2(partit, mesh) end do cn=0.0_WP do nz=uln, nln-1 - cn=cn+hnode_new(nz,node)*(sqrt(max(bvfreq(nz,node), 0._WP))+sqrt(max(bvfreq(nz+1,node), 0._WP)))/2._WP + cn=cn+hnode(nz,node)*sqrt(max(bvfreq(nz,node), 0._WP) + max(bvfreq(nz+1,node), 0._WP))/2._WP end do - iwe2_cn(node)=cn/pi + cn = cn/pi + iwe2_cn(node)=cn + + ! + ! + !___________________________________________________________________ + ! 1st. compute idemix2 parameter over the vertical water column and + ! local horizontal parameters on elements !!!: + ! IN VARIABLES: + ! -------------- + ! nlev ... number of mid-depth levels + ! coriolis ... coriolis parameter + ! Nsqr ... squared buoyancy frequency + ! cn ... baroclionic gravity wave speed + ! + ! OUT VARIABLES: + ! -------------- + ! alpha_c ... 3d enery dissipation coefficient + ! v0 ... 3d horizontal group velocities (m/s) for the continuous + ! internal wave spectrum + ! c0 ... 3d vertical group velocities (m/s) for the continuous + ! internal wave spectrum + call cvmix_idemix2_compute_param( & + nlev = nln-uln+1 , & !IN + coriolis = mesh%coriolis_node( node) , & !IN + Nsqr = bvfreq( uln:nln , node) , & !IN + cn = cn , & !IN + alpha_c = iwe2_alpha_c(uln:nln , node) , & !OUT + c0 = iwe2_c0( uln:nln , node) , & !OUT + v0 = iwe2_v0( uln:nln , node) & !OUT + ) + + ! + ! + !___________________________________________________________________ + ! 3rd. compute dissipation time scales and rates + ! IN VARIABLES: + ! -------------- + ! dtime ... time step + ! lat ... elem lat coordinates + ! coriolis ... coriolis parameter + ! omega_M2 ... M2 frequency (fixed) + ! omega_niw ... NIW frequency (lat dependent) + ! cn ... baroclionic gravity wave speed + ! zbottom ... bottom depth at elements + ! topo_hrms ... root mean square topographic height + ! topo_hlam ... characteristic horiz. length scale of topographic features + ! topo_shelf... .true. if point is considered on shelf + ! + ! OUT VARIABLES: + ! -------------- + ! tau_M2 ... M2 Tidal Dissipation Timescale + ! tau_niw ... NIW Dissipation Timescale + ! alpha_M2_cont... M2 Continuous Dissipation Rate (Background M2 tidal + ! dissipation rate + if (idemix2_enable_M2 .or. idemix2_enable_niw) then + if (iwe2_topo_dist(node) <= idemix2_shelf_dist) then + topo_shelf = .True. + else + topo_shelf = .False. + end if + if (idemix2_enable_M2) then + call cvmix_idemix2_compute_compart_interact_tscale(& + dtime = dt , & !IN + lat = lat_n_deg , & !IN + coriolis = mesh%coriolis_node( node) , & !IN + cn = cn , & !IN + zbottom = zbar_n_bot( node) , & !IN + topo_hrms = iwe2_topo_hrms( node) , & !IN + topo_hlam = iwe2_topo_hlam( node) , & !IN + topo_shelf = topo_shelf , & !IN + omega_compart= iwe2_omega_M2 , & !IN + tau_compart = iwe2_M2_tau( node) & !OUT + ) + call cvmix_idemix2_compute_M2_dissipation( & + lat = lat_n_deg , & !IN + cn = cn , & !IN + zbottom = zbar_n_bot( node) , & !IN + alpha_M2_c = iwe2_alpha_M2_c( node) & !OUT + ) + end if + if (idemix2_enable_niw) then + call cvmix_idemix2_compute_compart_interact_tscale(& + dtime = dt , & !IN + lat = lat_n_deg , & !IN + coriolis = mesh%coriolis_node( node) , & !IN + cn = cn , & !IN + zbottom = zbar_n_bot( node) , & !IN + topo_hrms = iwe2_topo_hrms( node) , & !IN + topo_hlam = iwe2_topo_hlam( node) , & !IN + topo_shelf = topo_shelf , & !IN + omega_compart= iwe2_omega_niw( node) , & !IN + tau_compart = iwe2_niw_tau( node) & !OUT + ) + end if + end if + ! + ! + !___________________________________________________________________ + ! 4th. compute structure function for M2 and NIW energy + ! IN VARIABLES: + ! -------------- + ! nlev ... number of full depth levels + ! dzw ... layyer thickness, distance between full depth levels + ! coriolis ... coriolis parameter + ! omega_M2 ... M2 frequency (fixed) + ! omega_niw ... NIW frequency (lat dependent) + ! cn ... baroclionic gravity wave speed + ! Nsqr ... squared buoyancy frequency + ! + ! OUT VARIABLES: + ! -------------- + ! E_struct_M2 ... structure function for M2 energy + ! E_struct_niw... structure function for NIW energy + if ((idemix2_enable_M2) .and. (idemix2_enable_niw)) then + call cvmix_idemix2_compute_vert_struct_fct( & + nlev = nln-uln+1 , & !IN + dzw = hnode( uln:nln-1, node) , & !IN + coriolis = mesh%coriolis_node( node) , & !IN + omega_M2 = iwe2_omega_M2 , & !IN + omega_niw = iwe2_omega_niw( node) , & !IN + cn = cn , & !IN + Nsqr = bvfreq( uln:nln, node) , & !IN + E_struct_M2 = iwe2_E_struct_M2( uln:nln, node) , & !OUT + E_struct_niw= iwe2_E_struct_niw(uln:nln, node) & !OUT + ) + else if (idemix2_enable_M2) then + call cvmix_idemix2_compute_vert_struct_fct( & + nlev = nln-uln+1 , & !IN + dzw = hnode( uln:nln-1, node) , & !IN + coriolis = mesh%coriolis_node( node) , & !IN + omega_M2 = iwe2_omega_M2 , & !IN + omega_niw = iwe2_omega_niw( node) , & !IN + cn = cn , & !IN + Nsqr = bvfreq( uln:nln, node) , & !IN + E_struct_M2 = iwe2_E_struct_M2( uln:nln, node) & !OUT + ) + else if (idemix2_enable_niw) then + call cvmix_idemix2_compute_vert_struct_fct( & + nlev = nln-uln+1 , & !IN + dzw = hnode( uln:nln-1, node) , & !IN + coriolis = mesh%coriolis_node( node) , & !IN + omega_M2 = iwe2_omega_M2 , & !IN + omega_niw = iwe2_omega_niw( node) , & !IN + cn = cn , & !IN + Nsqr = bvfreq( uln:nln, node) , & !IN + E_struct_niw= iwe2_E_struct_niw(uln:nln, node) & !OUT + ) + end if end do - call exchange_elem(iwe2_cn, partit) + call exchange_nod(iwe2_cn , partit) + call exchange_nod(iwe2_alpha_c, partit) + call exchange_nod(iwe2_c0 , partit) + call exchange_nod(iwe2_v0 , partit) !_______________________________________________________________________ + ! 5th. compute idemix2 group velocites for M2 an NIW do elem = 1,elem_size - nln = nlevels(elem)-1 - uln = ulevels(elem) - elnodes1 = elem2d_nodes(:,elem) - - lat_e_deg = sum(geo_coord_nod2D(2,elnodes1))/3.0 * 180.0/pi - - !___________________________________________________________________ - ! calculate for TKE square of Brünt-Väisälä frequency, be aware that - ! bvfreq contains already the squared brünt Väisälä frequency ... - bvfreq2 = 0.0_WP - do nz= uln, nln+1 - bvfreq2(nz) = sum(bvfreq(nz,elnodes1))/3.0_WP - end do - - !___________________________________________________________________ - ! dz_trr distance between tracer points, surface and bottom dz_trr is half - ! the layerthickness ... - dz_trr = 0.0_WP - dz_trr(uln+1:nln)= helem(uln:nln-1,elem)*0.5_WP + helem(uln+1:nln,elem)*0.5_WP - dz_trr(uln) = helem(uln,elem)*0.5_WP - dz_trr(nln+1) = helem(nln,elem)*0.5_WP + nln = nlevels(elem)-1 + uln = ulevels(elem) + elnodes = elem2d_nodes(:,elem) + lat_e_deg = sum(geo_coord_nod2D(2,elnodes))/3.0 * 180.0/pi + if (idemix2_enable_M2) w_M2_e(:) = 0.0_WP + if (idemix2_enable_niw) w_niw_e(:) = 0.0_WP !___________________________________________________________________ ! compute baroclionic gravity wave speed on elements - cn_e = sum(iwe2_cn(elnodes1))/3.0 + cn_e = sum(iwe2_cn(elnodes))/3.0 ! compute gradient of baroclionic gkdot_x_M2 = sqrt(fxa)/omega_M2*cn_gradxravity wave speed on elements - cn_gradx_e = sum(gradient_sca(1:3,elem)*iwe2_cn(elnodes1)) - cn_grady_e = sum(gradient_sca(4:6,elem)*iwe2_cn(elnodes1)) + cn_gradx_e = sum(gradient_sca(1:3,elem)*iwe2_cn(elnodes)) + cn_grady_e = sum(gradient_sca(4:6,elem)*iwe2_cn(elnodes)) + + ! average to elem + if (idemix2_enable_niw) omega_niw_e = sum(iwe2_omega_niw(elnodes))/3.0 + !___________________________________________________________________ - ! 1st. compute idemix2 parameter over the vertical water column and - ! local horizontal parameters on elements !!!: + ! check if point is near shelf + if (iwe2_topo_dist(elem) <= idemix2_shelf_dist) then + topo_shelf = .True. + else + topo_shelf = .False. + end if + + ! + ! + !___________________________________________________________________ ! IN VARIABLES: ! -------------- ! nlev ... number of mid-depth levels @@ -764,77 +1047,1243 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! cg_niw ... 2d group velocity of near-inertial waves (NIW) ! u_M2 ... zonal component of M2 internal tide group velocity ! v_M2 ... meridional component of M2 internal tide group velocity - ! w_M2 ... vertical component of M2 internal tide group velocity + ! w_M2 ... cross spectral propagation of M2 internal tide group velocity ! u_niw ... zonal component of NIW internal group velocity ! v_niw ... meridional component of NIW internal group velocity - ! w_niw ... vertical component of NIW internal group velocity - call cvmix_compute_groupvel_idemix2( & - nlev = nln-uln+1 , & !IN - nfbin = idemix2_nfbin , & !IN - dtime = dt , & !IN - coriolis = mesh%coriolis( elem) , & !IN - grady_coriol= iwe2_grady_coriol( elem) , & !IN - coslat = mesh%elem_cos( elem) , & !IN - Nsqr = bvfreq2( uln:nln ) , & !IN - omega_M2 = iwe2_omega_M2 , & !IN - omega_niw = iwe2_omega_niw( elem) , & !IN - cn = cn_e , & !IN - cn_gradx = cn_gradx_e , & !IN - cn_grady = cn_grady_e , & !IN - phit = iwe2_phit , & !IN - phiu = iwe2_phiu , & !IN - alpha_c = iwe2_alpha_c(uln:nln, elem) , & !OUT - c0 = iwe2_c0( uln:nln, elem) , & !OUT - v0 = iwe2_v0( uln:nln, elem) , & !OUT - cg_M2 = iwe2_cg_M2( elem) , & !OUT - cg_niw = iwe2_cg_niw( elem) , & !OUT - u_M2 = iwe2_M2_u( :, elem) , & !OUT - v_M2 = iwe2_M2_v( :, elem) , & !OUT - w_M2 = iwe2_M2_w( :, elem) , & !OUT - u_niw = iwe2_niw_u( :, elem) , & !OUT - v_niw = iwe2_niw_v( :, elem) , & !OUT - w_niw = iwe2_niw_w( :, elem) & !OUT + ! w_niw ... cross spectral propagation of NIW internal group velocity + if (idemix2_enable_M2) then + call cvmix_idemix2_compute_compart_groupvel( & + nfbin = idemix2_nfbin , & !IN + coriolis = mesh%coriolis( elem) , & !IN + grady_coriol = iwe2_grady_coriol( elem) , & !IN + coslat = mesh%elem_cos( elem) , & !IN + cn = cn_e , & !IN + cn_gradx = cn_gradx_e , & !IN + cn_grady = cn_grady_e , & !IN + phit = iwe2_phit , & !IN + phiu = iwe2_phiu , & !IN + omega_compart= iwe2_omega_M2 , & !IN + u_compart = iwe2_M2_uv(1, :, elem) , & !OUT + v_compart = iwe2_M2_uv(2, :, elem) , & !OUT + w_compart = w_M2_e( : ) & !OUT + ) + ! --> here w_M2_e and w_niw_e are still on elements but for the proper + ! finite volume advection implementation we need them on nodes ! + do k=1,3 + iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + w_M2_e(:)*elem_area(elem)/3.0_WP + end do + end if + if (idemix2_enable_niw) then + call cvmix_idemix2_compute_compart_groupvel( & + nfbin = idemix2_nfbin , & !IN + coriolis = mesh%coriolis( elem) , & !IN + grady_coriol = iwe2_grady_coriol( elem) , & !IN + coslat = mesh%elem_cos( elem) , & !IN + cn = cn_e , & !IN + cn_gradx = cn_gradx_e , & !IN + cn_grady = cn_grady_e , & !IN + phit = iwe2_phit , & !IN + phiu = iwe2_phiu , & !IN + omega_compart= omega_niw_e , & !IN + u_compart = iwe2_niw_uv(1, :, elem) , & !OUT + v_compart = iwe2_niw_uv(2, :, elem) , & !OUT + w_compart = w_niw_e( : ) & !OUT + ) + do k=1,3 + iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*elem_area(elem)/3.0_WP + end do + end if + ! --> at the end we still need to normalize iwe2_M2_w and iwe2_niw_w + ! with the scalararea! + end do ! --> do elem = 1,elem_size + + ! finalize elem2node averaging of iwe2_M2_w and iwe2_niw_w + ! cross spectral exachange has to be related to nodes, since general advection + ! is related to nodes independent of the volume + if (idemix2_enable_M2) then + call exchange_elem(iwe2_M2_uv, partit) + do node=1, node_size + iwe2_M2_w( :, node) = iwe2_M2_w(:, node)/area(1, node) + end do + end if + if (idemix2_enable_niw) then + call exchange_elem(iwe2_niw_uv, partit) + do node=1, node_size + iwe2_niw_w(:, node) = iwe2_niw_w(:, node)/area(1,node) + end do !--> do node=1, node_size + end if + + + !_______________________________________________________________________ + ! 6th. horizontal spectral integrate energy compartment E_M2^(n+1) and + ! E_niw^(n+1) equation. + ! dE/dt = -div(vec_u * E) - tau*E + Forc + ! E^(n+1) = E^n + dt*( -div(vec_u^n*E^n) - tau*E^n + Forc^n) + if (idemix2_enable_M2) then + call hsintegrate_Ecompart( & + taum1, tau, taup1 , & + iwe2_E_M2 , & + iwe2_Ediv_M2 , & + iwe2_M2_uv , & + iwe2_M2_w , & + iwe2_fM2 , & + iwe2_M2_tau , & + iwe2_dphit , & + iwe2_gradxy_e , & + iwe2_gradxy_n , & + iwe2_flx_uv , & + iwe2_flx_w , & + mesh%edge_up_dn_tri , & + partit , & + mesh & + ) + end if + if (idemix2_enable_niw) then + call hsintegrate_Ecompart( & + taum1, tau, taup1 , & + iwe2_E_niw , & + iwe2_Ediv_niw , & + iwe2_niw_uv , & + iwe2_niw_w , & + iwe2_fniw , & + iwe2_niw_tau , & + iwe2_dphit , & + iwe2_gradxy_e , & + iwe2_gradxy_n , & + iwe2_flx_uv , & + iwe2_flx_w , & + edge_up_dn_tri , & + partit , & + mesh & + ) + end if + + !_______________________________________________________________________ + ! 7th. Integrate IDEMIX equation vertical, solve vertical diffusion and + ! dissipation part implicitly + ! Eiw^(t+1) = Eiw^(t) + dt*[ d/dz( c_0 * tau_v * d/dz(c_0*E_iw))^(t+1) + ! - alpha_c*Eiw^(t+1) + ! + Forc^(t) ] + do node = 1, myDim_nod2D + uln = ulevels_nod2D(node) + nln = nlevels_nod2D(node) + call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & + nlev = nln-uln+1 , & + dzw = hnode( uln:nln-1, node) , & + dt = dt , & + c0 = iwe2_c0( uln:nln , node) , & + alpha_c = iwe2_alpha_c( uln:nln , node) , & + fsrf = iwe2_fsrf( node) , & + fbot = iwe2_fbot( uln:nln , node) , & + Eiw_old = iwe2_E_iw(tau , uln:nln , node) , & + Eiw_new = iwe2_E_iw(taup1, uln:nln , node) , & + Eiw_dt = iwe2_E_iw_dt( uln:nln , node) , & + Eiw_vdif = iwe2_E_iw_vdif( uln:nln , node) , & + Eiw_diss = iwe2_E_iw_diss( uln:nln , node) , & + Eiw_srf = iwe2_E_iw_fsrf( node) , & + Eiw_bot = iwe2_E_iw_fbot( uln:nln , node) & ) + end do + + !_______________________________________________________________________ + ! 8th. add lateral diffusion term (see. Olbers D., Eden C., 2013, A Global Model + ! for the Diapycnal Diffusivity Induced Internal Gravity Waves...) + ! Eiw^(t+1) = Eiw^(t+1) + div_h( v_0 * tau_h * grad_h(v_0*E_iw^(t)) ) + if (idemix2_enable_hor_diffusion .or. idemix2_enable_hor_diff_iter) then + iwe2_E_iw_hdif = 0.0_WP + end if + if (idemix2_enable_hor_diffusion) then + call compute_hdiff_Eiw( & + iwe2_E_iw(tau , :, :) , & + iwe2_E_iw(taup1, :, :) , & + iwe2_E_iw_dt( :, :) , & + iwe2_E_iw_hdif( :, :) , & + iwe2_v0 , & + 1 , & + partit , & + mesh & + ) + end if + + !_______________________________________________________________________ + ! 9th. add tendency due to lateral diffusion with iterative method in case of + ! high resolution + if (idemix2_enable_hor_diff_iter) then + do iter=1, idemix2_hor_diff_niter + call compute_hdiff_Eiw( & + iwe2_E_iw(taup1, :, :) , & + iwe2_E_iw(taup1, :, :) , & + iwe2_E_iw_dt( :, :) , & + iwe2_E_iw_hdif( :, :) , & + iwe2_v0 , & + idemix2_hor_diff_niter , & + partit , & + mesh & + ) + end do + end if + + !_______________________________________________________________________ + ! 10th. compute wave-wave interaction + if (idemix2_enable_M2 .or. idemix2_enable_niw) then + do node = 1, myDim_nod2D + uln = ulevels_nod2D(node) + nln = nlevels_nod2D(node) + !_______________________________________________________________ + if (idemix2_enable_M2 .and. idemix2_enable_niw) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 , & + nfbin = idemix2_nfbin , & + dzw = hnode( uln:nln-1, node) , & + dphi = iwe2_dphit , & + dt = dt , & + E_iw_old = iwe2_E_iw( tau , uln:nln, node) , & + E_iw_new = iwe2_E_iw( taup1, uln:nln, node) , & + E_M2_old = iwe2_E_M2( tau , :, node) , & + E_M2_new = iwe2_E_M2( taup1, :, node) , & + E_M2_struct = iwe2_E_struct_M2( :, node) , & + alpha_M2_c = iwe2_alpha_M2_c( node) , & + tau_M2 = iwe2_M2_tau( node) , & + E_niw_old = iwe2_E_niw(tau , :, node) , & + E_niw_new = iwe2_E_niw(taup1, :, node) , & + E_niw_struct = iwe2_E_struct_niw(:, node) , & + tau_niw = iwe2_niw_tau( node) & + ) + elseif (idemix2_enable_M2) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 , & + nfbin = idemix2_nfbin , & + dzw = hnode( uln:nln-1, node) , & + dphi = iwe2_dphit , & + dt = dt , & + E_iw_old = iwe2_E_iw( tau , uln:nln, node) , & + E_iw_new = iwe2_E_iw( taup1, uln:nln, node) , & + E_M2_old = iwe2_E_M2( tau , :, node) , & + E_M2_new = iwe2_E_M2( taup1, :, node) , & + E_M2_struct = iwe2_E_struct_M2( :, node) , & + alpha_M2_c = iwe2_alpha_M2_c( node) , & + tau_M2 = iwe2_M2_tau( node) & + ) + elseif (idemix2_enable_niw) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 , & + nfbin = idemix2_nfbin , & + dzw = hnode( uln:nln-1, node) , & + dphi = iwe2_dphit , & + dt = dt , & + E_iw_old = iwe2_E_iw( tau , uln:nln, node) , & + E_iw_new = iwe2_E_iw( taup1, uln:nln, node) , & + E_niw_old = iwe2_E_niw(tau , :, node) , & + E_niw_new = iwe2_E_niw(taup1, :, node) , & + E_niw_struct = iwe2_E_struct_niw(:, node) , & + tau_niw = iwe2_niw_tau( node) & + ) + end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then + end do ! --> for node = 1, myDim_nod2D + end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then + + !_______________________________________________________________________ + ! 11th. write IDEMIX2 diffusivities and viscositie to FESOM only when IDEMIX2 is + ! used alone --> mostly for debuging --> otherwise TKE Av and Kv are use + if(mix_scheme_nmb==7) then + + !___________________________________________________________________ + ! write out diffusivity --> convert from elem to vertices + do node=1, myDim_nod2D + uln = ulevels_nod2D(node) + nln = nlevels_nod2D(node) + !_______________________________________________________________ + ! convert Eiw disspation into Kv and Av on vertices + call cvmix_idemix2_compute_Eiw_diss2KvAv( & + nlev = nln-uln+1 , & + Eiw_diss= iwe2_E_iw_diss(uln:nln, node) , & + Nsqr = bvfreq( uln:nln, node) , & + KappaH = Kv( uln:nln, node) , & + KappaM = iwe2_Av( uln:nln, node) & + ) + end do !___________________________________________________________________ - ! 2st. compute dissipation time scales and rates - ! IN VARIABLES: - ! -------------- - ! dtime ... time step - ! lat ... elem lat coordinates - ! coriolis ... coriolis parameter - ! omega_M2 ... M2 frequency (fixed) - ! omega_niw ... NIW frequency (lat dependent) - ! cn ... baroclionic gravity wave speed - ! zbottom ... bottom depth at elements - ! topo_hrms ... root mean square topographic height - ! topo_hlam ... characteristic horiz. length scale of topographic features - ! topo_shelf... point is considered shelf - ! - ! OUT VARIABLES: - ! -------------- - ! tau_M2 ... M2 Tidal Dissipation Timescale - ! tau_niw ... NIW Dissipation Timescale - ! alpha_M2_cont... M2 Continuous Dissipation Rate (Background M2 tidal - ! dissipation rate - call cvmix_compute_interact_tscale_idemix2( & - dtime = dt , & !IN - lat = lat_e_deg , & !IN - coriolis = mesh%coriolis( elem) , & !IN - omega_M2 = iwe2_omega_M2 , & !IN - omega_niw = iwe2_omega_niw( elem) , & !IN - cn = cn_e , & !IN - zbottom = zbar_e_bot( elem) , & !IN - topo_hrms = iwe2_topo_hrms( elem) , & !IN - topo_hlam = iwe2_topo_hlam( elem) , & !IN - topo_shelf = iwe2_topo_shelf( elem) , & !IN - tau_M2 = iwe2_M2_tau( elem) , & !OUT - tau_niw = iwe2_niw_tau( elem) , & !OUT - alpha_M2_c = iwe2_alpha_M2_c( elem) & !OUT - ) + ! more idemix2 viscosity from vertices to elements + do elem=1,myDim_elem2D + uln = ulevels(elem) + nln = nlevels(elem) + elnodes = elem2d_nodes(:,elem) + do nz=uln, nln + Av(nz, elem) = sum(iwe2_Av(nz, elnodes))/3.0_WP + end do + end do + call exchange_elem(Av, partit) + call exchange_nod(Kv , partit) + end if + + end subroutine calc_cvmix_idemix2 + + + + ! + ! + !___________________________________________________________________________ + ! horizontal superbee advection of spectral bins + subroutine adv_Ecompart_hor_spctrl_superbee( & + vel , & + ttf , & + ttf_grad_n , & + dphi , & + flux , & + partit , & + mesh , & + edge_up_dn_tri , & + flag_2ndord_time , & + flag_posdef & + ) + + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_partit) , intent(inout), target :: partit + type(t_mesh) , intent(in) , target :: mesh + real(kind=WP) , intent(in) :: ttf( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(in) :: ttf_grad_n(2, idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(in) :: vel(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) + real(kind=WP) , intent(in) :: dphi( idemix2_nfbin) + real(kind=WP) , intent(inout) :: flux( idemix2_nfbin, partit%myDim_edge2D) + integer , intent(in) :: edge_up_dn_tri(2 , partit%myDim_edge2D) + logical , intent(in) :: flag_2ndord_time + logical , intent(in) :: flag_posdef + !___LOCAL VARIABLES_____________________________________________________ + real(kind=WP) :: dx1, dy1, dx2, dy2, dxdy12(2), edlen, n_x, n_y + real(kind=WP) :: u1, u2, v1, v2, Ue, CFL, fac_2ndord_time + real(kind=WP) :: R, ttfp2, ttfm1, ttf0, ttfp1, dttf0p1, Tmean1, Tmean2, Cr, vflux, vfabs + integer :: el(2), el2, ednodes(2), edge, fbini, nfbin +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + !_______________________________________________________________________ + nfbin=idemix2_nfbin + + !_______________________________________________________________________ + ! this advection does !!! NOT !!! go over the vertical dimension it goes + ! over the domain of the spectral bins +!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(edge, ednodes, el, el2, fbini, & +!$OMP dx1, dy1, dx2, dy2, dxdy12, vflux, vfabs, & +!$OMP ttf0, ttfp1, dttf02, ttfp2, ttfm1, R, Cr, Tmean1, Tmean2 +!$OMP DO + do edge=1, myDim_edge2D !___________________________________________________________________ - end do ! --> do elem = 1,elem_size + ! local indice of nodes that span up edge ed + ednodes= edges(:,edge) - end subroutine calc_cvmix_idemix2 + ! local index of element that contribute to edge + el = edge_tri(:,edge) + + ! edge_cross_dxdy(1:2,ed)... dx,dy distance from center of edge to + ! element centroid el(1) --> needed to calc flux perpedicular to edge from elem el(1) + dx1 = edge_cross_dxdy(1,edge) + dy1 = edge_cross_dxdy(2,edge) + + ! length of edge dx dy + dxdy12 = edge_dxdy(:,edge)*r_earth + + !___________________________________________________________________ + ! same parameter but for other element el(2) that contributes to edge ed + ! if el(2)==0 than edge is boundary edge + dx2 = 0.0_WP + dy2 = 0.0_WP + el2 = el(1) ! --> just a dummy index here is vel(el2) are multiplied with 0.0_WP + if(el(2)>0) then + el2 = el(2) ! --> dummy replaced with valid el(2), dx2 and dy2 + dx2 = edge_cross_dxdy(3,edge) + dy2 = edge_cross_dxdy(4,edge) + dxdy12(1)= dxdy12(1) * (elem_cos(el(1)) + elem_cos(el2)) * 0.5_WP + + ! compute mean edge-segment normal vector + ! (dx1,dy1) + ! ^ + ! │ + ! ├──> (dy1,-dx1) + ! │ + ! ●━━━━━━━━━━━┿━━━━━━━━━━►● + ! │ + ! (dy2,-dx2) <──┼──> (-dy2,dx2) + ! │ + ! v + ! (dx2,dy2) + ! + n_x = ( dy1 + (-dy2))/2 + n_y = ((-dx1) + dx2 )/2 + + else + dxdy12(1)= dxdy12(1) * elem_cos(el(1)) + ! compute edge-segment normal vector + n_x = dy1 + n_y = -dx1 + end if + edlen = sqrt(dxdy12(1)**2 + dxdy12(2)**2) + + !___________________________________________________________________ + !loop over spectral bins +!$OMP simd + do fbini = 2, nfbin-1 + !_______________________________________________________________ + ! compute volume flux across the segments from el(1) + u1 = vel(1, fbini, el(1)) + v1 = vel(2, fbini, el(1)) + u2 = vel(1, fbini, el2 ) + v2 = vel(2, fbini, el2 ) + vflux = ((-v1*dx1 + u1*dy1) + ( v2*dx2 - u2*dy2)) * dphi(fbini) + + ! compute approximated edge centered and along edge projected + ! mean velocity --> need to add component to make second order + ! in time + Ue = sqrt((0.5_WP*( u1 + u2 )*n_x)**2 + (0.5_WP*( v1 + v2 )*n_y)**2) + CFL = Ue*dt/edlen + + !_______________________________________________________________ + ! compute tracer difference allong edge + ttf0 = ttf(fbini, ednodes(1)) + ttfp1 = ttf(fbini, ednodes(2)) + dttf0p1 = ttfp1-ttf0 + + !_______________________________________________________________ + ! tracer Slope Ratio Calculation for upwind augmented point + ! + ! o + ! ○._ .´ `. .-○ + ! | `._ .´ ^ dx1,dy1 .-´ | + ! | `._ .´ ├─> `. .-´ | + ! | □ `●━━━━━━┿━━━━━►●´----□---|-->●ttf_p2 + ! | .-´│`. <─┤ .´│`._ | + ! | .-´ dx2,dy2 v .´ │ `._ | + ! ○.-´ │ `. .´ │ `._○ + ! │ o │ + ! ├------------>┤ + ! │ dxdy12 │ + ! │ │ + ! v v + ! ttf_1 ttf_grad_n_2 + ! + ttfp2 = ttf0 & + + 2.0_WP * dxdy12(1)*ttf_grad_n(1, fbini, ednodes(2)) & + + 2.0_WP * dxdy12(2)*ttf_grad_n(2, fbini, ednodes(2)) + + ! considering here we want to advect energy we can ensure the + ! variable to be positiv definit + ttfp2 = merge(max(0.0_WP,ttfp2), ttfp2, flag_posdef) + + ! compute tracer slope + R = (ttfp1-ttfp2)/(-dttf0p1+small) + + ! apply superbee limiter + Cr = slimiter_superbee(R) + + ! construct edge centered tracer value + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dx ]_Limited * dx/2 + ! --> this is seconds order in space, but first order in time + ! + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dx ]_Limited * (dx/2 - u_ed*n_ed*dt/2) + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dx ]_Limited * dx/2 *(1 - CFL_h) + ! --> becomes second order in space and time (Direct space-time scheme) + ! --> u_ed = (vel(el(1)) + vel(el(2)))/2 + ! --> n_ed = (n_1 + n_2)/2 + ! --> CFL_h = u_ed*n_ed*dt/dx + Tmean2 = ttfp1 + 0.5_WP * Cr * (-dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) + + !_______________________________________________________________ + ! tracer Slope Ratio Calculation for downwind augmented point + ! + ! o + ! ○._ .´ `. .-○ + ! | `._ .´ ^ dx1,dy1 .-´ | + ! | `._ .´ ├─> `. .-´ | + ! ttf_m1●<--|---□----`●━━━━━━┿━━━━━►●´ □ | + ! | .-´│`. <─┤ .´│`._ | + ! | .-´ dx2,dy2 v .´ │ `._ | + ! ○.-´ │ `. .´ │ `._○ + ! │ o │ + ! ├------------>┤ + ! │ dxdy12 │ + ! │ │ + ! v v + ! ttf_grad_n_1 ttf_2 + ! + ttfm1 = ttfp1 & + - 2.0_WP * dxdy12(1)*ttf_grad_n(1, fbini, ednodes(1)) & + - 2.0_WP * dxdy12(2)*ttf_grad_n(2, fbini, ednodes(1)) + + ! considering here we want to advect energy we can ensure the + ! variable to be positiv definit + ttfm1 = merge(max(0.0_WP,ttfm1), ttfm1, flag_posdef) + + ! compute tracer slope + R = (ttf0-ttfm1)/(dttf0p1+small) + + ! apply superbee limiter + Cr = slimiter_superbee(R) + + ! construct edge centered tracer value + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dx ]_Limited * dx/2 + ! --> this is seconds order in space, but first order in time + ! + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dx ]_Limited * (dx/2 - u_ed*n_ed*dt/2) + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dx ]_Limited * dx/2 *(1 - CFL_h) + ! --> becomes second order in space and time (Direct space-time scheme) + ! --> u_ed = (vel(el(1)) + vel(el(2)))/2 + ! --> n_ed = (n_1 + n_2)/2 + ! --> CFL_h = u_ed*n_ed*dt/dx + Tmean1 = ttf0 + 0.5_WP * Cr * (dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) + + !_______________________________________________________________ + vfabs = abs(vflux) + flux(fbini, edge)=-0.5_WP*( & + (vflux+vfabs)*Tmean1+ & + (vflux-vfabs)*Tmean2 & + ) ! - flux(fbini, edge) + + end do ! --> for fbini = 1, nfbin + end do !--> do edge=1, myDim_edge2D +!$OMP END DO +!$OMP END PARALLEL DO + end subroutine adv_Ecompart_hor_spctrl_superbee + + + + ! + ! + !___________________________________________________________________________ + ! cross spectral superbee advection across spectral bins + subroutine adv_Ecompart_crss_spctrl_superbee( & + W , & + ttf , & + dphi , & + flux , & + partit , & + mesh , & + flag_2ndord_time , & + flag_posdef & + ) + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_partit),intent(inout), target :: partit + type(t_mesh), intent(in) , target :: mesh + real(kind=WP), intent(in) :: W ( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: ttf( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: dphi(idemix2_nfbin) + real(kind=WP), intent(inout) :: flux(idemix2_nfbin, partit%myDim_nod2D) + logical , intent(in) :: flag_2ndord_time + logical , intent(in) :: flag_posdef + !___LOCAL VARIABLES_____________________________________________________ + integer :: node, fbini, nfbin, idxp2, idxm1 + real(kind=WP) :: R, ttf0, ttfp1, dttf0p1, Tmean1, Tmean2, Cr, vflux, vfabs + real(kind=WP) :: cfl +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + !_______________________________________________________________________ + nfbin=idemix2_nfbin + + !_______________________________________________________________________ +#ifndef ENABLE_OPENACC +!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, fbini, idxp2, idxm1, tff0, tffp1, & +!$OMP dttf0p1, R, Cr, Tmean2, Tmean1, vfabs) +!$OMP DO +#else +!$ACC PARALLEL LOOP GANG DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) +#endif + !_______________________________________________________________________ + ! this advection does !!! NOT !!! go over the vertical dimension it goes + ! over the domain of the spectral bins + do node = 1, myDim_nod2D + + !___________________________________________________________________ + !loop over spectral bins +!$ACC LOOP VECTOR + do fbini = 1, nfbin-1 + !_______________________________________________________________ + ! do periodic boundary condition accros spectral domain + idxp2 = fbini+2 ; if (idxp2>nfbin) idxp2=3 + idxm1 = fbini-1 ; if (idxm1<1 ) idxm1=nfbin-2 + + cfl = abs(W(fbini, node)) * dt / dphi(fbini) + !_______________________________________________________________ + ! compute tracer difference + ttf0 = ttf(fbini , node) + ttfp1 = ttf(fbini+1, node) + dttf0p1 = ttfp1 - ttf0 + + !_______________________________________________________________ + ! tracer Slope Ratio Calculation for upwind point + ! compute tracer slope + R = ttfp1-ttf(idxp2,node)/(-dttf0p1+small) + + ! apply superbee limiter + Cr = slimiter_superbee(R) + + ! construct edge centered tracer value + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * dz/2 + ! --> this is seconds order in space, but first order in time + ! + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) + ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) + ! --> CFL = W*dt/dx + Tmean2 = ttfp1 + 0.5_WP*Cr*(-dttf0p1) * (1-merge(cfl, 0.0_WP, flag_2ndord_time)) + Tmean2 = merge(max(0.0_WP, Tmean2), Tmean2, flag_posdef) + + !_______________________________________________________________ + ! tracer Slope Ratio Calculation for downwind point + ! compute tracer slope + R = ttf0-ttf(idxm1,node)/(dttf0p1+small) + + ! apply superbee limiter + Cr = slimiter_superbee(R) + + ! construct edge centered tracer value + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * dz/2 + ! --> this is seconds order in space, but first order in time + ! + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) + ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) + ! --> CFL = W*dt/dx + Tmean1 = ttf0 + 0.5_WP*Cr*(dttf0p1) * (1-cfl*merge(cfl, 0.0_WP, flag_2ndord_time)) + Tmean1 = merge(max(0.0_WP, Tmean1), Tmean1, flag_posdef) + !_______________________________________________________________ + ! cross spectral exchange rate + !! vflux = W(fbini, node*dphi(fbini) + vflux = W(fbini, node) + vfabs = abs(vflux) + flux(fbini, node)=-0.5_WP*( & + (vflux+vfabs)*Tmean1+ & + (vflux-vfabs)*Tmean2 & + ) !- flux(fbini, node) + + end do !--> do fbini = 1, nfbin +!$ACC END LOOP + end do ! --> do node = 1, myDim_nod2D +#ifndef ENABLE_OPENACC +!$OMP END DO +!$OMP END PARALLEL +#else + !$ACC END PARALLEL LOOP +#endif + end subroutine adv_Ecompart_crss_spctrl_superbee + + + + ! + ! + !___________________________________________________________________________ + ! superbee slope limiter + pure elemental real(kind=WP) function slimiter_superbee(R) result(Cr) + real(kind=WP), intent(in) :: R + Cr = max(0._WP, min( min(2._WP*R, 0.5_WP+R/2._WP), 2._WP )) + end function slimiter_superbee + + + + ! + ! + !___________________________________________________________________________ + ! build tracer divergence from fluxes + ! + ! dE/dt = -div(vec_u * E) + Forc | *int(dV) + ! E^(n+1)*V^(n+1) - E^n*V^n = dt*( -int_circ( vec_u^n*vec_n*E^n*dA) + Forc*V^n) + ! | + ! |--> V^(n+1) = V^(n) + ! v + ! E^(n+1) = E^(n) + dt/V^n * ( - Flx_hv + Forc*V^n) + ! |--> Flx_hv = Flx_h + Flx_v + subroutine adv_Ecompart_flx2tra_spctrl( & + flx_h , & + flx_v , & + div_hv , & + dphit , & + partit , & + mesh & + ) + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_partit), intent(inout), target :: partit + type(t_mesh) , intent(in ), target :: mesh + real(kind=WP) , intent(in) :: flx_h( idemix2_nfbin, partit%myDim_edge2D) + real(kind=WP) , intent(in) :: flx_v( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout) :: div_hv(idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) + !___LOCAL VARIABLES_____________________________________________________ + integer :: node, edge, fbini, nfbin, ednodes(2) + real(kind=WP) :: inv_dphi(idemix2_nfbin), inv_fac1, inv_fac2 +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + ! + ! + !_______________________________________________________________________ +#ifndef ENABLE_OPENACC + !$OMP PARALLEL DO COLLAPSE(2) +#else + !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) +#endif + do node=1, myDim_nod2D + do fbini=1, nfbin + div_hv(fbini, node)=0.0_WP + end do + end do +#ifndef ENABLE_OPENACC + !$OMP END PARALLEL DO +#else + !$ACC END PARALLEL LOOP +#endif + do fbini=1, nfbin + inv_dphi(fbini) = 1 / dphit(fbini) + end do + ! + ! + !_______________________________________________________________________ + ! Vertical part +#ifndef ENABLE_OPENACC + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, edge, ednodes, fbini, nfbin) + !$OMP DO +#else + !$ACC PARALLEL LOOP GANG DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) +#endif + do node=1, myDim_nod2d + inv_fac1 = 1/areasvol(1,node) + !$ACC LOOP VECTOR + do fbini=1,nfbin-1 +! div_hv(fbini,node)=div_hv(fbini,node) + (flx_v(fbini,node)-flx_v(fbini+1,node))*inv_fac1*inv_dphi(fbini) + div_hv(fbini,node)=div_hv(fbini,node) + (flx_v(fbini,node)-flx_v(fbini+1,node))*inv_dphi(fbini) + end do + !$ACC END LOOP + end do +#ifndef ENABLE_OPENACC + !$OMP END DO +#else + !$ACC END PARALLEL LOOP +#endif + ! + ! + !_______________________________________________________________________ + ! Horizontal part +#ifndef ENABLE_OPENACC + !$OMP DO +#else +# if !defined(DISABLE_OPENACC_ATOMICS) + !$ACC PARALLEL LOOP GANG PRIVATE(enodes, el) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) +# else + !$ACC UPDATE SELF(dttf_h, flux_h) +# endif +#endif + do edge=1, myDim_edge2D + ednodes = edges(:,edge) + inv_fac1 = 1.0_WP/areasvol(1,ednodes(1)) + inv_fac2 = 1.0_WP/areasvol(1,ednodes(2)) +#ifndef ENABLE_OPENACC +# if defined(_OPENMP) && !defined(__openmp_reproducible) + call omp_set_lock(partit%plock(ednodes(1))) +# else + !$OMP ORDERED +# endif +#else +# if !defined(DISABLE_OPENACC_ATOMICS) + !$ACC LOOP VECTOR +# endif +#endif + ! + !___________________________________________________________________ + ! horizontal flux contribution to ednode_1 + do fbini=2, nfbin-1 +#if !defined(DISABLE_OPENACC_ATOMICS) + !$ACC ATOMIC UPDATE +#endif + div_hv(fbini,ednodes(1))=div_hv(fbini,ednodes(1))+flx_h(fbini,edge)*inv_fac1*inv_dphi(fbini) + ! + !___________________________________________________________________ + ! horizontal flux contribution to ednode_2 +#ifndef ENABLE_OPENACC +# if defined(_OPENMP) && !defined(__openmp_reproducible) + ! if there is now __openmp or __openmp_reproducible assemble horizontal + ! divergence in one loop + end do + call omp_unset_lock(partit%plock(ednodes(1))) + call omp_set_lock (partit%plock(ednodes(2))) + + ! + !___________________________________________________________________ + ! horizontal flux contribution to ednode_1 + do fbini=2, nfbin-1 +# endif +#else +# if !defined(DISABLE_OPENACC_ATOMICS) + !$ACC ATOMIC UPDATE +# endif +#endif + div_hv(fbini,ednodes(2))=div_hv(fbini,ednodes(2))-flx_h(fbini,edge)*inv_fac2*inv_dphi(fbini) + end do +#ifndef ENABLE_OPENACC +# if defined(_OPENMP) && !defined(__openmp_reproducible) + call omp_unset_lock(partit%plock(ednodes(2))) +# else + !$OMP END ORDERED +# endif +#else +# if !defined(DISABLE_OPENACC_ATOMICS) + !$ACC END LOOP +# endif +#endif + end do +#ifndef ENABLE_OPENACC + !$OMP END DO + !$OMP END PARALLEL +#else +# if !defined(DISABLE_OPENACC_ATOMICS) + !$ACC END PARALLEL LOOP +# else + !$ACC UPDATE DEVICE(dttf_h) +# endif +#endif + end subroutine adv_Ecompart_flx2tra_spctrl + + + + ! + ! + !___________________________________________________________________________ + ! integrate equation for wave energy compartments + subroutine hsintegrate_Ecompart( & + tim1, ti, tip1 , & + E , & + Ediv , & + vel , & + w , & + forc , & + tau , & + dphit , & + gradxy_e , & + gradxy_n , & + flx_uv , & + flx_w , & + edge_up_dn_tri , & + partit , & + mesh & + ) + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_partit) , intent(inout), target :: partit + type(t_mesh) , intent(in ), target :: mesh + integer , intent(in ) :: ti, tim1, tip1 + real(kind=WP) , intent(inout) :: E( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: Ediv( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: vel( 2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) + real(kind=WP) , intent(in ) :: w( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: forc( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: tau( partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: gradxy_e(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) + real(kind=WP) , intent(inout) :: gradxy_n(2, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) + real(kind=WP) , intent(inout) :: flx_uv( idemix2_nfbin, partit%myDim_edge2D) + real(kind=WP) , intent(inout) :: flx_w( idemix2_nfbin, partit%myDim_nod2D) + integer , intent(in ) :: edge_up_dn_tri(2 , partit%myDim_edge2D) + !___LOCAL VARIABLES_____________________________________________________ + integer :: node, fbini, nfbin +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + ! compute gradient of iwe2_E_M2 on nodes is need for + call tracer_gradient_elements(E(ti,:,:), gradxy_e, partit, mesh, .False.) + call exchange_elem(gradxy_e, partit) + call interp_e2n(gradxy_e, gradxy_n, mesh, partit, .False.) + + ! compute horizontal superbee advected tracer flux + call adv_Ecompart_hor_spctrl_superbee( & + vel , & + E(ti,:,:) , & + gradxy_n , & + dphit , & + flx_uv , & + partit , & + mesh , & + edge_up_dn_tri , & + .True. , & ! do 2nd order in space & time + .True. & ! enforce positive definit + ) + + ! compute cross spectral superbee advected tracer flux + call adv_Ecompart_crss_spctrl_superbee( & + w , & + E(ti,:,:) , & + dphit , & + flx_w , & + partit , & + mesh , & + .True. , & ! do 2nd order in space & time + .True. & ! enforce positive definit + ) + + ! compute flux divergence + call adv_Ecompart_flx2tra_spctrl( & + flx_uv , & + flx_w , & + Ediv(ti,:,:) , & + dphit , & + partit , & + mesh & + ) + + ! integrate E_M2^(n+1) = ... + do node= 1, myDim_nod2d + do fbini=2,nfbin-1 + E(tip1, fbini, node) = E(ti, fbini, node) & + + dt * ( forc( fbini, node) & + - tau(node)*E( ti , fbini, node) & + + (1.5+idemix2_AB_epsilon)*Ediv(ti , fbini, node) & + - (0.5+idemix2_AB_epsilon)*Ediv(tim1, fbini, node)) + end do + end do + + end subroutine hsintegrate_Ecompart + + + + ! + ! + !___________________________________________________________________________ + ! compute inverse volume of w scalar cell + ! ~~~~~~~~~o zbar_1~~~~~~~~~~ + ! | + ! x Z_1 -------->^ + ! | | + ! o zbar_2, w_2 | h_wcell * areasvol = Vol_wcell --> Vol_wcelli = 1/Vol_wcell + ! | | + ! x Z_2 -------->v + ! | + ! o zbar_3 + ! : + ! : + ! : + ! ---------o zbar_n---------- + ! /////////////////////////// + subroutine compute_vol_wcell(vol_wcelli, mesh, partit) + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_partit) , intent(inout), target :: partit + type(t_mesh) , intent(in ), target :: mesh + real(kind=WP) , intent(inout) :: vol_wcelli(:,:) + !___LOCAL VARIABLES_____________________________________________________ + integer :: node, nz, nln, uln + real(kind=WP) :: dz_trr(mesh%nl) +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + do node = 1, myDim_nod2D + eDim_nod2D + ! number of above bottom levels at node + nln = nlevels_nod2D(node)-1 + uln = ulevels_nod2D(node) + + ! thickness of mid-level to mid-level interface at node + dz_trr = 0.0_WP + dz_trr(uln+1:nln) = Z_3d_n(uln:nln-1,node)-Z_3d_n(uln+1:nln,node) + dz_trr(uln) = hnode(uln,node)/2.0_WP + dz_trr(nln+1) = hnode(nln,node)/2.0_WP + + ! surface cell + vol_wcelli(uln,node) = 1/areasvol(uln,node)/dz_trr(uln) + do nz=uln+1,nln + ! inverse volumne centered around full depth levels + vol_wcelli(nz,node)= 1/areasvol(nz-1,node)/dz_trr(nz) + end do + ! bottom cell + vol_wcelli(nln+1,node) = 1/areasvol(nln,node)/dz_trr(nln+1) + + end do !-->do node = 1,node_size + end subroutine compute_vol_wcell + + + + ! + ! + !___________________________________________________________________________ + ! --> add contribution from horizontal wave propagation + ! Since IDEMIX is used in a global model configuration the vertical + ! internal wave mixing (call cvmix_coeffs_idemix) have to be extended by + ! a lateral diffusion term (see. Olbers D., Eden C., 2013, A Global Model + ! for the Diapycnal Diffusivity Induced Internal Gravity Waves...) + ! + ! diffusion term = div_h( v_0 * idemix_tau_h * grad_h(v_0*E_iw) ) + ! + ! use Gaussian integral satz ... int(div vec_A)dV = ringint(A*vec_n)dA + ! div vec_A = 1/V * sum_i=1...nface( A_i*vec_n_i)*A_i + subroutine compute_hdiff_Eiw( & + Eiw_old , & + Eiw , & + Eiw_dt , & + Eiw_hdif , & + v0 , & + n_hor_iter , & + partit , & + mesh & + ) + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_partit) , intent(inout), target :: partit + type(t_mesh) , intent(in ), target :: mesh + real(kind=WP) , intent(in ) :: Eiw_old(:,:) + real(kind=WP) , intent(inout) :: Eiw(:,:) + real(kind=WP) , intent(inout) :: Eiw_dt(:,:) + real(kind=WP) , intent(inout) :: Eiw_hdif(:,:) + real(kind=WP) , intent(in ) :: v0(:,:) + integer , intent(in ) :: n_hor_iter + !___LOCAL VARIABLES_____________________________________________________ + integer :: edge, ednodes(2), edel(2), & + elnodes1(3), elnodes2(3), & + node, nz, & + nl1, nl2, nl12, & + nu1, nu2, nu12 + real(kind=WP) :: dz_trr1(mesh%nl), dz_trr2(mesh%nl), & + grad_v0Eiw(2) + real(kind=WP) :: dx1, dx2, dy1, dy2, vflux +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + !_______________________________________________________________________ + ! calculate horizontal diffusion term div( grad(Eiw*v0) * tau_h*v0) + do edge=1,myDim_edge2D + !___________________________________________________________________ + ! deltaX1,deltaY1 ... cross edge dx and dy for the two elements + ! that contribute to the edge + ! o + ! / \ + ! / \ + ... triangle centroids + ! / + \ x ... edge mid points + ! / ^ \ + ! / |----\--------------->edge_cross_dxdy(1:2,edge) + ! ednodes(1)o-----x-----o ednodes(2) + ! \ |----/--------------->edge_cross_dxdy(3:4,edge) + ! \ v / + ! \ + / + ! \ / + ! \ / + ! o + ! + dx1 = edge_cross_dxdy(1,edge) + dy1 = edge_cross_dxdy(2,edge) + ! ednode ... vertices that form the edgeiwe_Thdi + ednodes = edges(:,edge) + ! el ... elements that contribute to edge + edel = edge_tri(:,edge) + ! elnodes1 ... nodes that contribute to element el(1) + elnodes1 = elem2d_nodes(:,edel(1)) + ! nl1 ... number of layers at element el(1) + nl1 = nlevels(edel(1)) + ! nu1 ... upper index of ocean default = 1 but can consider cavity !=1 + nu1 = ulevels(edel(1)) + + ! thickness of mid-level to mid-level interface of element el(1) + dz_trr1 = 0.0_WP + dz_trr1(nu1) = helem(nu1 ,edel(1))/2.0_WP + do nz = nu1+1, nl1-1 + dz_trr1(nz) = helem(nz-1 ,edel(1))/2.0_WP + helem(nz,edel(1))/2.0_WP + end do + dz_trr1(nl1) = helem(nl1-1,edel(1))/2.0_WP + + !___________________________________________________________________ + ! the same as above but for el(2)--> if el(2)==0 than this edge + ! is a boundary edge and el(2) does not exist + nl2=0 + nu2=0 + if (edel(2)>0) then + dx2 = edge_cross_dxdy(3,edge) + dy2 = edge_cross_dxdy(4,edge) + elnodes2 = elem2d_nodes(:,edel(2)) + nl2 = nlevels(edel(2)) + nu2 = ulevels(edel(2)) + + ! thickness of mid-level to mid-level interface of element el(2) + dz_trr2 = 0.0_WP + dz_trr2(nu2) = helem(nu2 ,edel(2))/2.0_WP + do nz = nu2+1, nl2-1 + dz_trr2(nz) = helem(nz-1 ,edel(2))/2.0_WP + helem(nz,edel(2))/2.0_WP + end do + dz_trr2(nl2) = helem(nl2-1,edel(2))/2.0_WP + endif + + !___________________________________________________________________ + ! common depth levels between elements edel(1) and edel(2) + nl12=min(nl1,nl2) + nu12=max(nu1,nu2) + + !___________________________________________________________________ + ! (A) goes only into this loop when the edge has only facing element + ! el(1) --> so the edge is a boundary edge --> this is for ocean + ! surface in case of cavity + do nz=nu1,nu12-1 + !_______________________________________________________________ + ! --> calc: grad_h(v_0*E_iw) + ! calculate flux from el(1) with respect to edge mid + ! point + grad_v0Eiw(1) = sum(gradient_sca(1:3,edel(1))*v0(nz,elnodes1)*Eiw_old(nz,elnodes1)) + grad_v0Eiw(2) = sum(gradient_sca(4:6,edel(1))*v0(nz,elnodes1)*Eiw_old(nz,elnodes1)) + + ! calculate flux --> grad_v0Eiw is now located on elements + vflux = (grad_v0Eiw(1)*dy1-grad_v0Eiw(2)*dx1)*dz_trr1(nz) + + !_______________________________________________________________ + ! --> calc: v_0*idemix_tau_h* grad_h(v_0*E_iw) + ! multiply vflux with iwe_v0 interpolate to the edge- + ! mid point + vflux = vflux * (v0(nz,ednodes(1))+v0(nz,ednodes(2)))*0.5_WP + + !_______________________________________________________________ + ! --> calc: div(v_0*idemix_tau_h* grad_h(v_0*E_iw)) + ! sum fluxes over the surface --> gaussian integral satz + ! --> keep in mind vol_wcelli is the inverse volume !!! + Eiw(nz,ednodes(1)) = Eiw(nz,ednodes(1)) + dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(1))*vflux + Eiw(nz,ednodes(2)) = Eiw(nz,ednodes(2)) - dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(2))*vflux + end do !-->do nz=nu1,nu12-1 + + !___________________________________________________________________ + ! (B) goes only into this loop when the edge has only facing elemenmt + ! el(2) --> so the edge is a boundary edge --> this is for ocean + ! surface in case of cavity + if (nu2 > 0) then + do nz=nu2,nu12-1 + !___________________________________________________________ + ! --> calc: grad_h(v_0*E_iw) + ! first calculate flux from el(1) with respect to edge mid + ! point + grad_v0Eiw(1) = sum(gradient_sca(1:3,edel(2))*v0(nz,elnodes2)*Eiw_old(nz,elnodes2)) + grad_v0Eiw(2) = sum(gradient_sca(4:6,edel(2))*v0(nz,elnodes2)*Eiw_old(nz,elnodes2)) + + ! calculate flux + vflux = -(grad_v0Eiw(1)*dy2-grad_v0Eiw(2)*dx2)*dz_trr2(nz) + ! |--> minus sign comes from the fact that the the + ! normal vectors (dx1,dy1) and (dx2,dy2) face + ! in opposite direction (Right-Hand-Rule) + + !___________________________________________________________ + ! --> calc: v_0*idemix_tau_h* grad_h(v_0*E_iw) + ! multiply vflux with iwe_v0 interpolate to the edge- + ! mid point + vflux = vflux * (v0(nz,ednodes(1))+v0(nz,ednodes(2)))*0.5_WP + + !___________________________________________________________ + ! --> calc: div(v_0*idemix_tau_h* grad_h(v_0*E_iw)) + ! sum fluxes over the surface --> gaussian integral satz + Eiw(nz,ednodes(1)) = Eiw(nz,ednodes(1)) + dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(1))*vflux + Eiw(nz,ednodes(2)) = Eiw(nz,ednodes(2)) - dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(2))*vflux + + end do !-->do nz=nu2,nu12-1 + end if + + !___________________________________________________________________ + ! (C) goes only into this loop when the edge has two facing elements + ! --> so the edge is not a boundary edge + do nz=nu12,nl12 + !_______________________________________________________________ + ! --> calc: grad_h(v_0*E_iw) + ! calculate grad(iwe*iwe_v0) for el(1) + grad_v0Eiw(1) = sum(gradient_sca(1:3,edel(1))*v0(nz,elnodes1)*Eiw_old(nz,elnodes1)) + grad_v0Eiw(2) = sum(gradient_sca(4:6,edel(1))*v0(nz,elnodes1)*Eiw_old(nz,elnodes1)) + + ! calculate flux --> grad_v0Eiw is now located on elements + vflux = (grad_v0Eiw(1)*dy1-grad_v0Eiw(2)*dx1)*dz_trr1(nz) + + ! calculate grad(iwe*iwe_v0) for el(2) and average for el(1) + ! and el(2) + grad_v0Eiw(1) = sum(gradient_sca(1:3,edel(2))*v0(nz,elnodes2)*Eiw_old(nz,elnodes2)) + grad_v0Eiw(2) = sum(gradient_sca(4:6,edel(2))*v0(nz,elnodes2)*Eiw_old(nz,elnodes2)) + + ! calculate flux + vflux = vflux + -(grad_v0Eiw(1)*dy2-grad_v0Eiw(2)*dx2)*dz_trr2(nz) + + !_______________________________________________________________ + ! --> calc: v_0*idemix_tau_h* grad_h(v_0*E_iw) + ! multiply vflux with iwe_v0 interpolate to the edge- + ! mid point + vflux = vflux * (v0(nz,ednodes(1))+v0(nz,ednodes(2)))*0.5_WP + + !_______________________________________________________________ + ! --> calc: div(v_0*idemix_tau_h* grad_h(v_0*E_iw)) + ! sum fluxes over the surface --> gaussian integral satz + Eiw(nz,ednodes(1)) = Eiw(nz,ednodes(1)) + dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(1))*vflux + Eiw(nz,ednodes(2)) = Eiw(nz,ednodes(2)) - dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(2))*vflux + end do !-->do nz=1,n2 + + !___________________________________________________________________ + ! (D) goes only into this loop when the edge has only facing element + ! el(1) --> so the edge is a boundary edge + do nz=nl12+1,nl1 + !_______________________________________________________________ + ! --> calc: grad_h(v_0*E_iw) + ! calculate flux from el(1) with respect to edge mid + ! point + grad_v0Eiw(1) = sum(gradient_sca(1:3,edel(1))*v0(nz,elnodes1)*Eiw_old(nz,elnodes1)) + grad_v0Eiw(2) = sum(gradient_sca(4:6,edel(1))*v0(nz,elnodes1)*Eiw_old(nz,elnodes1)) + + ! calculate flux + vflux = (grad_v0Eiw(1)*dy1-grad_v0Eiw(2)*dx1)*dz_trr1(nz) + + !_______________________________________________________________ + ! --> calc: v_0*idemix_tau_h* grad_h(v_0*E_iw) + ! multiply vflux with iwe_v0 interpolate to the edge- + ! mid point + vflux = vflux * (v0(nz,ednodes(1))+v0(nz,ednodes(2)))*0.5_WP + + !_______________________________________________________________ + ! --> calc: div(v_0*idemix_tau_h* grad_h(v_0*E_iw)) + ! sum fluxes over the surface --> gaussian integral satz + Eiw(nz,ednodes(1)) = Eiw(nz,ednodes(1)) + dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(1))*vflux + Eiw(nz,ednodes(2)) = Eiw(nz,ednodes(2)) - dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(2))*vflux + end do !-->do nz=nl12+1,nl1 + + !___________________________________________________________________ + ! (E) goes only into this loop when the edge has only facing elemenmt + ! el(2) --> so the edge is a boundary edge + do nz=nl12+1,nl2 + !_______________________________________________________________ + ! --> calc: grad_h(v_0*E_iw) + ! first calculate flux from el(1) with respect to edge mid + ! point + grad_v0Eiw(1) = sum(gradient_sca(1:3,edel(2))*v0(nz,elnodes2)*Eiw_old(nz,elnodes2)) + grad_v0Eiw(2) = sum(gradient_sca(4:6,edel(2))*v0(nz,elnodes2)*Eiw_old(nz,elnodes2)) + + ! calculate flux + vflux = -(grad_v0Eiw(1)*dy2-grad_v0Eiw(2)*dx2)*dz_trr2(nz) + + !_______________________________________________________________ + ! --> calc: v_0*idemix_tau_h* grad_h(v_0*E_iw) + ! multiply vflux with iwe_v0 interpolate to the edge- + ! mid point + vflux = vflux * (v0(nz,ednodes(1))+v0(nz,ednodes(2)))*0.5_WP + + !_______________________________________________________________ + ! --> calc: div(v_0*idemix_tau_h* grad_h(v_0*E_iw)) + ! sum fluxes over the surface --> gaussian integral satz + Eiw(nz,ednodes(1)) = Eiw(nz,ednodes(1)) + dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(1))*vflux + Eiw(nz,ednodes(2)) = Eiw(nz,ednodes(2)) - dt*idemix2_tau_h/n_hor_iter*vol_wcelli(nz,ednodes(2))*vflux + + end do !-->do nz=nl12+1,nl1 + end do !-->do edge=1,myDim_edge2D + + !_______________________________________________________________________ + ! add to total change in Eiw + do node = 1, myDim_nod2D + nu1 = ulevels_nod2D(node) + nl1 = nlevels_nod2D(node) + do nz = nu1, nl1 + Eiw_hdif(nz, node) = Eiw_hdif(nz, node) + (Eiw(nz, node)-Eiw_old(nz, node))/dt + Eiw_dt(nz, node) = Eiw_dt(nz, node) + (Eiw(nz, node)-Eiw_old(nz, node))/dt + end do + end do + end subroutine compute_hdiff_Eiw + + end module g_cvmix_idemix2 \ No newline at end of file From c268005a561bcf0da78f1781daaa80e54b332844 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:48:38 +0100 Subject: [PATCH 15/63] add interpolation routine for 3d data --- src/gen_modules_read_NetCDF.F90 | 769 ++++++++++++++++++++++++-------- 1 file changed, 575 insertions(+), 194 deletions(-) diff --git a/src/gen_modules_read_NetCDF.F90 b/src/gen_modules_read_NetCDF.F90 index 9263cf86f..a467084c4 100755 --- a/src/gen_modules_read_NetCDF.F90 +++ b/src/gen_modules_read_NetCDF.F90 @@ -4,218 +4,257 @@ module g_read_other_NetCDF contains subroutine read_other_NetCDF(file, vari, itime, model_2Darray, check_dummy, do_onvert, partit, mesh) - ! Read 2D data and interpolate to the model grid. - ! Currently used to read runoff and SSS. - ! First, missing values are filled in on the raw regular grid; - ! Second, interp_2d_field does the interpolation. - ! The check_dummy part should be modified in new applications! - ! if check_dummy=.true., missing value is replaced with a meaningful value nearby - ! if check_dummy=.false., missing value is replaced with 0.0 + ! Read 2D data and interpolate to the model grid. + ! Currently used to read runoff and SSS. + ! First, missing values are filled in on the raw regular grid; + ! Second, interp_2d_field does the interpolation. + ! The check_dummy part should be modified in new applications! + ! if check_dummy=.true., missing value is replaced with a meaningful value nearby + ! if check_dummy=.false., missing value is replaced with 0.0 - use, intrinsic :: ISO_FORTRAN_ENV, only: real64 - use g_config - use o_param - USE MOD_MESH - USE MOD_PARTIT - USE MOD_PARSUP - use netcdf - implicit none + use, intrinsic :: ISO_FORTRAN_ENV, only: real64 + use g_config + use o_param + USE MOD_MESH + USE MOD_PARTIT + USE MOD_PARSUP + use g_interp + use netcdf + implicit none - type(t_mesh), intent(in), target :: mesh - type(t_partit), intent(inout), target :: partit - integer :: i, j, ii, jj, k, n, num, flag, cnt - integer :: itime, latlen, lonlen - integer :: status, ncid, varid - integer :: lonid, latid - integer :: istart(3), icount(3), elnodes(3) - real(real64) :: x, y, miss, aux, xmin, elnodes_x(3) - real(real64), allocatable :: lon(:), lat(:) - real(real64), allocatable :: ncdata(:,:), ncdata_temp(:,:) - real(real64), allocatable :: temp_x(:), temp_y(:) - real(real64) :: model_2Darray(partit%myDim_nod2d+partit%eDim_nod2D) - character(*) :: vari - character(*) :: file - logical :: check_dummy, do_onvert - integer :: ierror ! return error code + !___Input/Output____________________________________________________________ + character(*) , intent(in) :: file + character(*) , intent(in) :: vari + integer , intent(in) :: itime + real(kind=WP) , intent(inout) :: model_2Darray(:) + logical , intent(in) :: check_dummy + logical , intent(in) :: do_onvert + type(t_mesh) , intent(in) , target :: mesh + type(t_partit), intent(inout), target :: partit + !___Local___________________________________________________________________ + integer :: i, j, ii, jj, k, n, num, flag, cnt + integer :: latlen, lonlen + integer :: status, ncid, varid + integer :: lonid, latid + integer :: istart(3), icount(3), elnodes(3) + real(kind=WP) :: x, y, miss, aux, xmin, elnodes_x(3) + real(kind=WP), allocatable :: lon(:), lat(:) + real(kind=WP), allocatable :: ncdata(:,:), ncdata_temp(:,:) + real(kind=WP), allocatable :: temp_x(:), temp_y(:) + logical :: found_error=.False. + integer :: ierror ! return error code #include "associate_part_def.h" #include "associate_mesh_def.h" #include "associate_part_ass.h" #include "associate_mesh_ass.h" - - if (mype==0) then - ! open file - status=nf90_open(file, nf90_nowrite, ncid) - if (status /= nf90_noerr) then - print *, achar(27)//'[33m' - write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: File not found: ' - write(*,*) ' ├> file:', file - write(*,*) ' ├> status:', status - write(*,*) ' ├> ', nf90_strerror(status) - write(*,*) ' └> check: namelist.*' - write(*,*) '____________________________________________________________________' - print *, achar(27)//'[0m' - write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + !___________________________________________________________________________ + ! open netcdf file, check existence + if (mype==0) then + ! open file + status=nf90_open(file, nf90_nowrite, ncid) + if (status /= nf90_noerr) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: File not found: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ', nf90_strerror(status) + write(*,*) ' └> check: namelist.*' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if end if - end if - - call MPI_BCast(status, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) - if (status.ne.nf90_noerr)then - print*,'ERROR: CANNOT READ 2D netCDF FILE CORRECTLY !!!!!' - print*,'Error in opening netcdf file '//file - call par_ex(partit%MPI_COMM_FESOM, partit%mype) - stop - endif + + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) - if (mype==0) then - ! lat - status=nf90_inq_dimid(ncid, 'lat', latid) - if (status == NF90_EBADDIM) then - print *, achar(27)//'[33m' - write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: Dimension lat not found in file: ' - write(*,*) ' ├> file:', file - write(*,*) ' ├> status:', status - write(*,*) ' ├> ',nf90_strerror(status) - write(*,*) ' └> check: Dim and CoordVariable name must be lat' - write(*,*) '____________________________________________________________________' - print *, achar(27)//'[0m' - write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + !___________________________________________________________________________ + ! read dimensions from netcdf file, checkfor the naming of dimensions + if (mype==0) then + ! lat + status=nf90_inq_dimid(ncid, 'lat', latid) + if (status == NF90_EBADDIM) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Dimension lat not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lat' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + status=nf90_inquire_dimension(ncid, latid, len=latlen) + + ! lon + status=nf90_inq_dimid(ncid, 'lon', lonid) + if (status == NF90_EBADDIM) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Dimension lon not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lon' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + status=nf90_inquire_dimension(ncid, lonid, len=lonlen) end if - status=nf90_inquire_dimension(ncid, latid, len=latlen) + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) - ! lon - status=nf90_inq_dimid(ncid, 'lon', lonid) - if (status == NF90_EBADDIM) then - print *, achar(27)//'[33m' - write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: Dimension lon not found in file: ' - write(*,*) ' ├> file:', file - write(*,*) ' ├> status:', status - write(*,*) ' ├> ',nf90_strerror(status) - write(*,*) ' └> check: Dim and CoordVariable name must be lon' - write(*,*) '____________________________________________________________________' - print *, achar(27)//'[0m' - write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) - end if - status=nf90_inquire_dimension(ncid, lonid, len=lonlen) - end if - call MPI_BCast(latlen, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) - call MPI_BCast(lonlen, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) + ! broadcast len of lon/lat to all processes + call MPI_BCast(latlen, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) + call MPI_BCast(lonlen, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) - ! lat - allocate(lat(latlen)) - if (mype==0) then - status=nf90_inq_varid(ncid, 'lat', varid) - if (status == NF90_ENOTVAR) then - print *, achar(27)//'[33m' - write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: Variable lat not found in file: ' - write(*,*) ' ├> file:', file - write(*,*) ' ├> status:', status - write(*,*) ' ├> ',nf90_strerror(status) - write(*,*) ' └> check: Dim and CoordVariable name must be lat' - write(*,*) '____________________________________________________________________' - print *, achar(27)//'[0m' - write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + !___________________________________________________________________________ + ! read latitude regular coordinates from netcdf file --> lat + allocate(lat(latlen)) + if (mype==0) then + status=nf90_inq_varid(ncid, 'lat', varid) + if (status == NF90_ENOTVAR) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Variable lat not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lat' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + status=nf90_get_var(ncid, varid, lat, start=(/1/), count=(/latlen/)) end if - status=nf90_get_var(ncid, varid, lat, start=(/1/), count=(/latlen/)) - end if - call MPI_BCast(lat, latlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + + ! broadcast latitude array to all processes + call MPI_BCast(lat, latlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) - ! lon - allocate(lon(lonlen)) - if (mype==0) then - status=nf90_inq_varid(ncid, 'lon', varid) - if (status == NF90_ENOTVAR) then - print *, achar(27)//'[33m' - write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: Variable lon not found in file: ' - write(*,*) ' ├> file:', file - write(*,*) ' ├> status:', status - write(*,*) ' ├> ',nf90_strerror(status) - write(*,*) ' └> check: Dim and CoordVariable name must be lon' - write(*,*) '____________________________________________________________________' - print *, achar(27)//'[0m' - write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + !___________________________________________________________________________ + ! read longitude regular coordinates from netcdf file --> lat + allocate(lon(lonlen)) + if (mype==0) then + status=nf90_inq_varid(ncid, 'lon', varid) + if (status == NF90_ENOTVAR) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Variable lon not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lon' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + status=nf90_get_var(ncid, varid, lon, start=(/1/), count=(/lonlen/)) end if - status=nf90_get_var(ncid, varid, lon, start=(/1/), count=(/lonlen/)) - end if - call MPI_BCast(lon, lonlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + + ! broadcast longitude array to all processes + call MPI_BCast(lon, lonlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) - ! make sure range 0. - 360. - do n=1,lonlen - if (lon(n)<0.0_WP) then - lon(n)=lon(n)+360._WP - end if - end do + ! make sure range 0. - 360. + do n=1,lonlen + if (lon(n)<0.0_WP) then + lon(n)=lon(n)+360._WP + end if + end do - allocate(ncdata(lonlen,latlen), ncdata_temp(lonlen,latlen)) - ncdata = 0.0_WP - - if (mype==0) then - ! data - status=nf90_inq_varid(ncid, vari, varid) - if (status == NF90_ENOTVAR) then - print *, achar(27)//'[33m' - write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: Variable ',vari,' not found in file: ' - write(*,*) ' ├> file:', file - write(*,*) ' ├> status:', status - write(*,*) ' ├> ',nf90_strerror(status) - write(*,*) ' └> check: namelist.* ' - write(*,*) '____________________________________________________________________' - print *, achar(27)//'[0m' - write(*,*) - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) - end if - istart= (/1,1,itime/) - icount= (/lonlen,latlen,1/) - status=nf90_get_var(ncid, varid, ncdata, start=istart, count=icount) - - ! missing value - status= nf90_get_att(ncid, varid, 'missing_value', miss) - ! close file - status=nf90_close(ncid) - end if - call MPI_BCast(ncdata, lonlen*latlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) - call MPI_BCast(miss, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) - !write(*,*)'miss', miss - !write(*,*)'raw',minval(ncdata),maxval(ncdata) - ncdata_temp=ncdata - do i=1,lonlen - do j=1,latlen - if (ncdata(i,j)==miss .or. ncdata(i,j)==-99.0_WP) then !! - if (check_dummy) then - aux=0.0_WP - cnt=0 - do k=1,30 - do ii=max(1,i-k),min(lonlen,i+k) - do jj=max(1,j-k),min(latlen,j+k) - if (ncdata_temp(ii,jj)/=miss .and. ncdata_temp(ii,jj)/=-99.0_WP) then !! - aux=aux+ncdata_temp(ii,jj) - cnt=cnt+1 - end if - end do !ii - end do !jj - if (cnt>0) then - ncdata(i,j)=aux/cnt - exit - end if - end do !k - else - ncdata(i,j)=0.0_WP - end if + !___________________________________________________________________________ + ! read the 2d data --> check if variable name does exist + allocate(ncdata(lonlen,latlen), ncdata_temp(lonlen,latlen)) + ncdata = 0.0_WP + if (mype==0) then + ! data + status=nf90_inq_varid(ncid, vari, varid) + if (status == NF90_ENOTVAR) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Variable ',vari,' not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: namelist.* ' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if - end do - end do + istart= (/1,1,itime/) + icount= (/lonlen,latlen,1/) + status=nf90_get_var(ncid, varid, ncdata, start=istart, count=icount) + + ! missing value + status= nf90_get_att(ncid, varid, 'missing_value', miss) + + ! close file + status=nf90_close(ncid) + end if + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + + ! broadcast 2d data array to all processes + call MPI_BCast(ncdata, lonlen*latlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) + call MPI_BCast(miss , 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) + + ncdata_temp=ncdata + do i=1,lonlen + do j=1,latlen + ! check for missing value + if (ncdata(i,j)==miss .or. ncdata(i,j)==-99.0_WP) then + ! check_dummy=.true., missing value is replaced with a + ! meaningful value nearby make sure that near coastal + ! interpoaltion is valid + if (check_dummy) then + aux=0.0_WP + cnt=0 + ! look for up to 30 grid boxes nearby + do k=1,30 + do ii=max(1,i-k),min(lonlen,i+k) + do jj=max(1,j-k),min(latlen,j+k) + if (ncdata_temp(ii,jj)/=miss .and. ncdata_temp(ii,jj)/=-99.0_WP) then !! + aux=aux+ncdata_temp(ii,jj) + cnt=cnt+1 + end if + end do !ii + end do !jj + if (cnt>0) then + ncdata(i,j)=aux/cnt + exit + end if + end do ! --> do k=1,30 + else + ncdata(i,j)=0.0_WP + end if ! --> if (check_dummy) then + end if ! --> if (ncdata(i,j)==miss .or. ncdata(i,j)==-99.0_WP) then + end do ! --> do j=1,latlen + end do ! --> do i=1,lonlen !write(*,*) 'post',minval(ncdata), maxval(ncdata) !___________________________________________________________________________ @@ -257,10 +296,350 @@ subroutine read_other_NetCDF(file, vari, itime, model_2Darray, check_dummy, do_o ! do interpolation flag=0 call interp_2d_field(lonlen, latlen, lon, lat, ncdata, num, temp_x, temp_y, & - model_2Darray, flag, partit) + model_2Darray(1:num), flag, partit) deallocate(temp_y, temp_x, ncdata_temp, ncdata, lon, lat) end subroutine read_other_NetCDF +! +! +!_______________________________________________________________________________ +subroutine read_other_NetCDF_3d(file, vname, zvname, model_3Darray, do_onvert, partit, mesh) + ! Read data over three dimensions e2g. time or phit (mist be dimension without + ! topography or lsmask information) and interpolate to the model grid. + ! First, missing values are filled in on the raw regular grid; + ! Second, interp_2d_field does the interpolation. + ! The check_dummy part should be modified in new applications! + ! if check_dummy=.true., missing value is replaced with a meaningful value nearby + ! if check_dummy=.false., missing value is replaced with 0.0 + + use, intrinsic :: ISO_FORTRAN_ENV, only: real64 + use g_config + use o_param + USE MOD_MESH + USE MOD_PARTIT + USE MOD_PARSUP + use g_interp + use netcdf + implicit none + + !___Input/Output____________________________________________________________ + character(*) , intent(in) :: file + character(*) , intent(in) :: vname + character(*) , intent(in) :: zvname + real(kind=WP) , intent(inout) :: model_3Darray(:,:) + logical , intent(in) :: do_onvert + type(t_mesh) , intent(in) , target :: mesh + type(t_partit), intent(inout), target :: partit + !___Local___________________________________________________________________ + integer :: i, j, ii, jj, k, n, num, flag, cnt + integer :: latlen, lonlen, zlen, nz + integer :: status, ncid, varid + integer :: lonid, latid, zid + integer :: istart(3), icount(3), elnodes(3) + real(kind=WP) :: x, y, missvalue, aux, xmin, elnodes_x(3) + real(kind=WP), allocatable :: lon(:), lat(:) !, z(:) + real(kind=WP), allocatable :: ncdata(:,:,:) + real(kind=WP), allocatable :: temp_x(:), temp_y(:) + logical :: found_error=.False. + integer :: ierror ! return error code + +#include "associate_part_def.h" +#include "associate_mesh_def.h" +#include "associate_part_ass.h" +#include "associate_mesh_ass.h" + + !___________________________________________________________________________ + ! open netcdf file, check existence + if (mype==0) then + ! open file + status=nf90_open(file, nf90_nowrite, ncid) + if (status /= nf90_noerr) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: File not found: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ', nf90_strerror(status) + write(*,*) ' └> check: namelist.*' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + end if + + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + + !___________________________________________________________________________ + ! read dimensions from netcdf file, checkfor the naming of dimensions + if (mype==0) then + ! lat + status=nf90_inq_dimid(ncid, 'lat', latid) + if (status == NF90_EBADDIM) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Dimension lat not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lat' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + status=nf90_inquire_dimension(ncid, latid, len=latlen) + + ! lon + status=nf90_inq_dimid(ncid, 'lon', lonid) + if (status == NF90_EBADDIM) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Dimension lon not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lon' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + status=nf90_inquire_dimension(ncid, lonid, len=lonlen) + + ! read 3rd z dimension in file, could be time, or phit (idemix2) ... + status=nf90_inq_dimid(ncid, zvname, zid) + if (status == NF90_EBADDIM) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Dimension ',zvname, ' not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lon' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + status=nf90_inquire_dimension(ncid, zid, len=zlen) + end if + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + + ! broadcast len of lon/lat to all processes + call MPI_BCast(latlen, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) + call MPI_BCast(lonlen, 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) + call MPI_BCast(zlen , 1, MPI_INTEGER, 0, MPI_COMM_FESOM, ierror) + + !___________________________________________________________________________ + ! read latitude regular coordinates from netcdf file --> lat + allocate(lat(latlen)) + if (mype==0) then + status=nf90_inq_varid(ncid, 'lat', varid) + if (status == NF90_ENOTVAR) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Variable lat not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lat' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + status=nf90_get_var(ncid, varid, lat, start=(/1/), count=(/latlen/)) + end if + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + + ! broadcast latitude array to all processes + call MPI_BCast(lat, latlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) + + !___________________________________________________________________________ + ! read longitude regular coordinates from netcdf file --> lat + allocate(lon(lonlen)) + if (mype==0) then + status=nf90_inq_varid(ncid, 'lon', varid) + if (status == NF90_ENOTVAR) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Variable lon not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: Dim and CoordVariable name must be lon' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + status=nf90_get_var(ncid, varid, lon, start=(/1/), count=(/lonlen/)) + end if + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + + ! broadcast longitude array to all processes + call MPI_BCast(lon, lonlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) + + ! make sure range 0. - 360. + do n=1,lonlen + if (lon(n)<0.0_WP) then + lon(n)=lon(n)+360._WP + end if + end do + +! !___________________________________________________________________________ +! ! read z coordiantes +! allocate(z(zlen)) +! if (mype==0) then +! status=nf90_inq_varid(ncid, zvname, varid) +! if (status == NF90_ENOTVAR) then +! print *, achar(27)//'[33m' +! write(*,*) '____________________________________________________________________' +! write(*,*) ' ERROR: Variable ', zvname ,' not found in file: ' +! write(*,*) ' ├> file:', file +! write(*,*) ' ├> status:', status +! write(*,*) ' ├> ',nf90_strerror(status) +! write(*,*) ' └> check: Dim and CoordVariable name must' +! write(*,*) '____________________________________________________________________' +! print *, achar(27)//'[0m' +! write(*,*) +! found_error = .True. +! end if +! status=nf90_get_var(ncid, varid, z, start=(/1/), count=(/zlen/)) +! end if +! ! broadcast found_error variable to all other processes --> create kill signal +! ! for all processes +! call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) +! if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) +! +! ! broadcast longitude array to all processes +! call MPI_BCast(z, zlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) + + !___________________________________________________________________________ + ! read the 3d data --> check if variable name does exist + allocate(ncdata(lonlen, latlen, zlen)) + ncdata = 0.0_WP + if (mype==0) then + ! data + status=nf90_inq_varid(ncid, vname, varid) + if (status == NF90_ENOTVAR) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: Variable ', vname, ' not found in file: ' + write(*,*) ' ├> file:', file + write(*,*) ' ├> status:', status + write(*,*) ' ├> ',nf90_strerror(status) + write(*,*) ' └> check: namelist.* ' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + istart= (/ 1, 1, 1/) + icount= (/lonlen, latlen, zlen/) + status=nf90_get_var(ncid, varid, ncdata, start=istart, count=icount) + + ! missing value + status= nf90_get_att(ncid, varid, 'missing_value', missvalue) + + ! close file + status=nf90_close(ncid) + end if + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + + ! broadcast 2d data array to all processes + call MPI_BCast(ncdata , lonlen*latlen*zlen, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) + call MPI_BCast(missvalue, 1, MPI_DOUBLE_PRECISION, 0, MPI_COMM_FESOM, ierror) + + !___________________________________________________________________________ + ! size of input array should be 3d (nz, myDim_elem2D) or (nz, myDim_nod2D) + found_error = .False. + nz = size(model_3Darray,1) + if (nz /= zlen) then + if (mype==0) then + print *, achar(27)//'[33m' + write(*,*) '____________________________________________________________________' + write(*,*) ' ERROR: length of zdimension in file does not agree with len of zdim in model' + write(*,*) '____________________________________________________________________' + print *, achar(27)//'[0m' + write(*,*) + found_error = .True. + end if + end if + ! broadcast found_error variable to all other processes --> create kill signal + ! for all processes + call MPI_BCast(found_error, 1, MPI_LOGICAL, 0, MPI_COMM_FESOM, ierror) + if (found_error) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + + ! create interpolation coordinates + ! do data interpolation on vertices + if (do_onvert) then + num=myDim_nod2d+eDim_nod2d + allocate(temp_x(num), temp_y(num)) + do n=1, num + temp_x(n)=geo_coord_nod2d(1,n)/rad + temp_y(n)=geo_coord_nod2d(2,n)/rad + ! change lon range to [0 360] + if(temp_x(n)<0._WP) temp_x(n)=temp_x(n) + 360.0_WP + end do + + ! do data interpolation on element centroids + else + num = myDim_elem2D + allocate(temp_x(num), temp_y(num)) + do n=1, num + ! compute points of element centroids in geo frame use them here for interpolation + elnodes = elem2D_nodes(:,n) + elnodes_x= geo_coord_nod2D(1, elnodes) + xmin = minval(elnodes_x) + do k=1,3 + if(elnodes_x(k)-xmin>=cyclic_length/2.0_WP) elnodes_x(k)=elnodes_x(k)-cyclic_length + if(elnodes_x(k)-xmin<-cyclic_length/2.0_WP) elnodes_x(k)=elnodes_x(k)+cyclic_length + end do + ! compute in units [deg], in geo frame + temp_x(n)=sum(elnodes_x)/3.0_WP/rad + temp_y(n)=sum(geo_coord_nod2D(2,elnodes))/3.0_WP/rad + + ! change lon range to [0 360] + if(temp_x(n)<0._WP) temp_x(n)=temp_x(n) + 360.0_WP + end do + end if + + !___________________________________________________________________________ + ! do interpolation + do k=1,zlen + call interp_2d_field_v2(lonlen, latlen, & + lon, lat, ncdata(:,:,k), missvalue, & + num, temp_x, temp_y, model_3Darray(k,1:num), & + partit) + end do + deallocate(temp_y, temp_x, ncdata, lon, lat) + +end subroutine read_other_NetCDF_3d + + + + + + + + ! !------------------------------------------------------------------------------------ ! @@ -278,6 +657,7 @@ subroutine read_surf_hydrography_NetCDF(file, vari, itime, model_2Darray, partit USE MOD_PARSUP use g_rotate_grid use, intrinsic :: ISO_FORTRAN_ENV, only: real64 + use g_interp use netcdf implicit none @@ -401,6 +781,7 @@ subroutine read_2ddata_on_grid_NetCDF(file, vari, itime, model_2Darray, partit, USE MOD_PARTIT USE MOD_PARSUP use g_rotate_grid + use g_interp use netcdf implicit none From 4774ab957396711522ae35f24127a2f3947de3b7 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:54:01 +0100 Subject: [PATCH 16/63] improve some stuff --- config/namelist.cvmix | 43 +++++++++++++++++++++++--------------- src/MOD_MESH.F90 | 4 +++- src/oce_ale.F90 | 8 +++++-- src/write_step_info.F90 | 46 ++++++++++++++++++++--------------------- 4 files changed, 58 insertions(+), 43 deletions(-) diff --git a/config/namelist.cvmix b/config/namelist.cvmix index 2dd797dba..8f3bad0f4 100644 --- a/config/namelist.cvmix +++ b/config/namelist.cvmix @@ -80,7 +80,7 @@ idemix_botforc_vname = 'stormt_M2_plus_nycand_CnoM2' ! variable name in bottom ! internal tide generation and propagation in the consistent internal wave mixing ! closure IDEMIX ! ============================================================================ -¶m_idemix +¶m_idemix2 ! --- Time Scales --- idemix2_tau_v = 172800.0 ! vertical symmetrization time scale [s] (2 days) idemix2_tau_h = 1296000.0 ! horizontal symmetrization time scale [s] (15 days) @@ -90,41 +90,50 @@ idemix2_gamma = 1.570 ! spectral shape constant [dimensionless] ( idemix2_jstar = 5.0 ! spectral bandwidth in vertical modes [dimensionless] idemix2_mu0 = 0.33333333 ! dissipation parameter [dimensionless] -! --- M2 and Near Inertial Wave components -idemix2_enable_M2 = .true. -idemix2_enable_niw = .false. -idemix2_fniw_usage = 0.2 ! fraction of surface forcing used [dimensionless] - ! --- superbee-spectral advection scheme and Adams-Bashfort timestepping --- -idemix2_superbee_adv = .true. -idemix2_AB_timestep = .true. +! idemix2_enable_superbee_adv= .false. +idemix2_enable_AB_timestep = .false. ! --- Number of used spectral frequency bins idemix2_nfbin = 52 ! ensures idemix1 functionality idemix2_enable_hor_diffusion = .false. -idemix2_n_hor_iwe_prop_iter = 5 ! from Pollman et al. (2017) +idemix2_enable_hor_diff_iter = .false. ! from Pollman et al. (2017) +idemix2_hor_diff_niter = 5 + +! --- shelf definition as distance from coast in meters +idemix2_shelf_dist = 300.e3 ! --- M2 Forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) --- -idemix2_M2forc_file = './idemix2_IT_forc_M2modes1+2_aniso.nc' -idemix_M2forc_vname = 'Flux_to2.nc' ! variable name in surface forcing file +idemix2_enable_M2 = .false. +idemix2_M2forc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_IT_forc_M2modes1-2_aniso.nc' +idemix2_M2forc_vname = 'Flux_to2' ! variable name in surface forcing file +idemix2_M2forc_zname = 'phi' ! zdim variable name in surface forcing file ! --- NIW Forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) --- -idemix2_niwforc_file = './dummy.nc' -idemix_niwforc_vname = 'dummy' +idemix2_enable_niw = .false. +idemix2_fniw_usage = 0.2 ! fraction of surface forcing used [dimensionless] +idemix2_niwforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX/fourier_smooth_2005_cfsr_inert_rgrid.nc' +idemix2_niwforc_vname = 'var706' ! --- Bottom Forcing (Tidal Internal Waves) --- +idemix2_enable_bot = .true. idemix2_botforc_file = '/albedo/pool/FESOM/fesom2.0/forcing/idemix/forcing_idemix_final_bin/FIN_STORMTIDE2_M2_plus_NYCANDER_CnoM2_bin_0.40deg.nc' ! path to bottom forcing file, idemix2_botforc_vname = 'stormt_M2_plus_nycand_CnoM2' ! variable name in bottom forcing file +! --- Lee-Wave Forcing --- +idemix2_enable_leew = .false. +idemix2_leewforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_lee_forc_Eden.nc' +idemix2_leewforc_vname= 'C_lee' + ! --- Root Mean Square Topographic Height forcing --- -idemix2_hrmsforc_file = 'idemix2_forcing_t-scattering_Goff2023_1deg.nc' -idemix2_hrmsforc_vname = 'HRMS' +idemix2_hrmsforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_hrms_Goff2023.nc' +idemix2_hrmsforc_vname= 'HRMS' ! --- Characteristic horizontal length scale of topographic feature --- -idemix2_hlamforc_file = 'idemix2_forcing_t-scattering_1deg.nc' -idemix2_hlamforc_vname = 'LAMBDA_G10' +idemix2_hlamforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_lambda_Goff2010.nc' +idemix2_hlamforc_vname= 'LAMBDA' / ! ============================================================================ diff --git a/src/MOD_MESH.F90 b/src/MOD_MESH.F90 index 04cff77f9..a074bca10 100644 --- a/src/MOD_MESH.F90 +++ b/src/MOD_MESH.F90 @@ -37,6 +37,7 @@ MODULE MOD_MESH real(kind=WP), allocatable, dimension(:) :: elem_area real(kind=WP), allocatable, dimension(:,:) :: edge_dxdy real(kind=WP), allocatable, dimension(:,:) :: edge_cross_dxdy +integer , allocatable, dimension(:,:) :: edge_up_dn_tri real(kind=WP), allocatable, dimension(:) :: elem_cos real(kind=WP), allocatable, dimension(:) :: metric_factor integer, allocatable, dimension(:,:) :: elem_neighbors @@ -198,6 +199,7 @@ subroutine write_t_mesh(mesh, unit, iostat, iomsg) call write_bin_array(mesh%elem_edges, unit, iostat, iomsg) call write_bin_array(mesh%elem_area, unit, iostat, iomsg) call write_bin_array(mesh%edge_dxdy, unit, iostat, iomsg) + call write_bin_array(mesh%edge_up_dn_tri,unit, iostat, iomsg) call write_bin_array(mesh%edge_cross_dxdy, unit, iostat, iomsg) call write_bin_array(mesh%elem_cos, unit, iostat, iomsg) @@ -295,7 +297,7 @@ subroutine read_t_mesh(mesh, unit, iostat, iomsg) call read_bin_array(mesh%elem_edges, unit, iostat, iomsg) call read_bin_array(mesh%elem_area, unit, iostat, iomsg) call read_bin_array(mesh%edge_dxdy, unit, iostat, iomsg) - + call read_bin_array(mesh%edge_up_dn_tri,unit, iostat, iomsg) call read_bin_array(mesh%edge_cross_dxdy, unit, iostat, iomsg) call read_bin_array(mesh%elem_cos, unit, iostat, iomsg) call read_bin_array(mesh%metric_factor, unit, iostat, iomsg) diff --git a/src/oce_ale.F90 b/src/oce_ale.F90 index 7bf6244fb..2a87025e1 100644 --- a/src/oce_ale.F90 +++ b/src/oce_ale.F90 @@ -3432,9 +3432,13 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! to be called prior to tke ! for debugging #if defined (__cvmix) - if (mod(mix_scheme_nmb,10)==6) then + if (mod(mix_scheme_nmb,10)==6) then if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call calc_cvmix_idemix'//achar(27)//'[0m' call calc_cvmix_idemix(partit, mesh) + elseif (mod(mix_scheme_nmb,10)==7) then + if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call calc_cvmix_idemix2'//achar(27)//'[0m' + ! if (flag_debug .and. mype==0) print *, achar(27)//'[31m'//' --> call calc_cvmix_idemix2'//achar(27)//'[0m' + call calc_cvmix_idemix2(partit, mesh) end if #endif @@ -3500,7 +3504,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) #if defined (FESOM_PROFILING) call fesom_profiler_end("oce_mix_pres") call fesom_profiler_start("oce_dyn_momentum") -#endif +#endif !___________________________________________________________________________ ! add contribution from momentum advection, coriolis and pressure gradient | diff --git a/src/write_step_info.F90 b/src/write_step_info.F90 index 9ad384bf5..b7efcc5e8 100644 --- a/src/write_step_info.F90 +++ b/src/write_step_info.F90 @@ -175,9 +175,9 @@ subroutine write_step_info(istep, outfreq, ice, dynamics, tracers, partit, mesh) loc=omp_min_max_sum1(hbar-hbar_old, 1, myDim_nod2D, 'min', partit) end if call MPI_AllREDUCE(loc , min_deta , 1, MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_FESOM, MPIerr) - loc=omp_min_max_sum1(hnode(1,:), 1, myDim_nod2D, 'min', partit) + loc=omp_min_max_sum1(hnode(1,1:myDim_nod2d), 1, myDim_nod2D, 'min', partit) call MPI_AllREDUCE(loc , min_hnode , 1, MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_FESOM, MPIerr) - loc=omp_min_max_sum1(hnode(2,:), 1, myDim_nod2D, 'min', partit) + loc=omp_min_max_sum1(hnode(2,1:myDim_nod2d), 1, myDim_nod2D, 'min', partit) call MPI_AllREDUCE(loc , min_hnode2 , 1, MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_FESOM, MPIerr) !_______________________________________________________________________ @@ -248,28 +248,28 @@ subroutine write_step_info(istep, outfreq, ice, dynamics, tracers, partit, mesh) write(*,*) ' int(dhbar)-int(wflux)*dt =', int_dhbar-int_wflux*dt*(-1.0) write(*,*) write(*,*) ' ___global min/max/mean --> mstep=',mstep,'____________' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' eta= ', min_eta ,' | ',max_eta ,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' deta= ', min_deta ,' | ',max_deta ,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' hbar= ', min_hbar ,' | ',max_hbar ,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, ES10.3)") ' wflux= ', min_wflux,' | ',max_wflux,' | ',int_wflux - write(*,"(A, ES10.3, A, ES10.3, A, ES10.3)") ' hflux= ', min_hflux,' | ',max_hflux,' | ',int_hflux - write(*,"(A, ES10.3, A, ES10.3, A, ES10.3)") ' temp= ', min_temp ,' | ',max_temp ,' | ',int_temp - write(*,"(A, ES10.3, A, ES10.3, A, ES10.3)") ' salt= ', min_salt ,' | ',max_salt ,' | ',int_salt - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' wvel(1,:)= ', min_wvel ,' | ',max_wvel ,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' wvel(2,:)= ', min_wvel2,' | ',max_wvel2,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' uvel(1,:)= ', min_uvel ,' | ',max_uvel ,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' uvel(2,:)= ', min_uvel2,' | ',max_uvel2,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' vvel(1,:)= ', min_vvel ,' | ',max_vvel ,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' vvel(2,:)= ', min_vvel2,' | ',max_vvel2,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' hnode(1,:)= ', min_hnode,' | ',max_hnode,' | ','N.A.' - write(*,"(A, ES10.3, A, ES10.3, A, A )") ' hnode(2,:)= ', min_hnode2,' | ',max_hnode2,' | ','N.A.' - write(*,"(A, A , A, ES10.3, A, A )") ' cfl_z= ',' N.A. ',' | ',max_cfl_z ,' | ','N.A.' - write(*,"(A, A , A, ES10.3, A, A )") ' pgf_x= ',' N.A. ',' | ',max_pgfx ,' | ','N.A.' - write(*,"(A, A , A, ES10.3, A, A )") ' pgf_y= ',' N.A. ',' | ',max_pgfy ,' | ','N.A.' - write(*,"(A, A , A, ES10.3, A, A )") ' Av= ',' N.A. ',' | ',max_av ,' | ','N.A.' - write(*,"(A, A , A, ES10.3, A, A )") ' Kv= ',' N.A. ',' | ',max_kv ,' | ','N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") ' eta= ', min_eta , ' | ', max_eta , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") ' deta= ', min_deta , ' | ', max_deta , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") ' hbar= ', min_hbar , ' | ', max_hbar , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, ES10.3)") ' wflux= ', min_wflux , ' | ', max_wflux , ' | ', int_wflux + write(*,"(A15, ES10.3, A3, ES10.3, A3, ES10.3)") ' hflux= ', min_hflux , ' | ', max_hflux , ' | ', int_hflux + write(*,"(A15, ES10.3, A3, ES10.3, A3, ES10.3)") ' temp= ', min_temp , ' | ', max_temp , ' | ', int_temp + write(*,"(A15, ES10.3, A3, ES10.3, A3, ES10.3)") ' salt= ', min_salt , ' | ', max_salt , ' | ', int_salt + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") ' wvel(1,:)= ', min_wvel , ' | ', max_wvel , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") ' wvel(2,:)= ', min_wvel2 , ' | ', max_wvel2 , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") ' uvel(1,:)= ', min_uvel , ' | ', max_uvel , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") ' uvel(2,:)= ', min_uvel2 , ' | ', max_uvel2 , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") ' vvel(1,:)= ', min_vvel , ' | ', max_vvel , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") ' vvel(2,:)= ', min_vvel2 , ' | ', max_vvel2 , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") 'hnode(1,:)= ', min_hnode , ' | ', max_hnode , ' | ', 'N.A.' + write(*,"(A15, ES10.3, A3, ES10.3, A3, A10 )") 'hnode(2,:)= ', min_hnode2, ' | ', max_hnode2, ' | ', 'N.A.' + write(*,"(A15, A10 , A3, ES10.3, A3, A10 )") ' cfl_z= ', ' N.A.' , ' | ', max_cfl_z , ' | ', 'N.A.' + write(*,"(A15, A10 , A3, ES10.3, A3, A10 )") ' pgf_x= ', ' N.A.' , ' | ', max_pgfx , ' | ', 'N.A.' + write(*,"(A15, A10 , A3, ES10.3, A3, A10 )") ' pgf_y= ', ' N.A.' , ' | ', max_pgfy , ' | ', 'N.A.' + write(*,"(A15, A10 , A3, ES10.3, A3, A10 )") ' Av= ', ' N.A.' , ' | ', max_av , ' | ', 'N.A.' + write(*,"(A15, A10 , A3, ES10.3, A3, A10 )") ' Kv= ', ' N.A.' , ' | ', max_kv , ' | ', 'N.A.' if (use_ice) then - write(*,"(A, A , A, ES10.3, A, A)") ' m_ice= ',' N.A. ',' | ',max_m_ice ,' | ','N.A.' + write(*,"(A15, A10 , A3, ES10.3, A3, A10)") ' m_ice= ', ' N.A.' , ' | ', max_m_ice , ' | ', 'N.A.' end if end if endif ! --> if (mod(istep,logfile_outfreq)==0) then From 6a478e976f992f704953616a585f3d311a6f9cfc Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 11 Mar 2026 11:55:08 +0100 Subject: [PATCH 17/63] improve some comments --- src/cvmix_driver/cvmix_idemix2.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 13ba5b68b..c006ad2b8 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -760,7 +760,7 @@ subroutine compute_vdiff_vdiss_Eiw( & ! ! dEiw/dt = d/dz(c0*tau_v * d/dz(c0*Eiw)) - alpha_c*Eiw + forcing ! |___________________________| | - ! diffusion of E_iw dissipation + ! vertical diffusion of E_iw dissipation ! ! ~~~~~~~o zlev=1~~~~~~~ ! | From c87c58816a0f908a91d19f42b3f56be312a87057 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 20 Mar 2026 16:02:02 +0100 Subject: [PATCH 18/63] add halo exchange for spectral data --- src/MOD_PARTIT.F90 | 11 + src/associate_part_ass.h | 16 +- src/associate_part_def.h | 7 + src/gen_halo_exchange.F90 | 557 +++++++++++++++++++++++++++++++++++++- 4 files changed, 589 insertions(+), 2 deletions(-) diff --git a/src/MOD_PARTIT.F90 b/src/MOD_PARTIT.F90 index 2e8330a4b..d68f449ff 100644 --- a/src/MOD_PARTIT.F90 +++ b/src/MOD_PARTIT.F90 @@ -86,6 +86,17 @@ module MOD_PARTIT integer, allocatable :: s_mpitype_nod2D_i(:), r_mpitype_nod2D_i(:) integer, allocatable :: s_mpitype_nod3D(:,:,:), r_mpitype_nod3D(:,:,:) + ! Spectral bin (fbin) fields for IDEMIX2 halo exchange + ! The first dimension is the number of spectral bins (nfbin) instead of vertical levels. + ! Nodal fields: (peer, nfbin:nfbin, n_val) with n_val=1..3 + ! Element fields: (peer, nfbin:nfbin, n_val) with n_val=1..4, small halo and full halo + integer :: nfbin_mpi = 0 ! number of spectral bins for MPI types (0 = not initialized) + integer, allocatable :: s_mpitype_nod3D_fbin(:,:,:), r_mpitype_nod3D_fbin(:,:,:) + integer, allocatable :: s_mpitype_elem2D_fbin(:,:), r_mpitype_elem2D_fbin(:,:) + integer, allocatable :: s_mpitype_elem2D_full_fbin(:,:), r_mpitype_elem2D_full_fbin(:,:) + integer, allocatable :: s_mpitype_elem3D_fbin(:,:,:), r_mpitype_elem3D_fbin(:,:,:) + integer, allocatable :: s_mpitype_elem3D_full_fbin(:,:,:), r_mpitype_elem3D_full_fbin(:,:,:) + integer :: MPIERR !!! remPtr_* are constructed during the runtime and shall not be dumped!!! diff --git a/src/associate_part_ass.h b/src/associate_part_ass.h index 615095acc..39a25bd35 100644 --- a/src/associate_part_ass.h +++ b/src/associate_part_ass.h @@ -69,4 +69,18 @@ if (allocated(partit%s_mpitype_nod2D)) then s_mpitype_nod3D(1:com_nod2D%sPEnum, lb:ub, 1:3) => partit%s_mpitype_nod3D(:,:,:) r_mpitype_nod3D(1:com_nod2D%rPEnum, lb:ub, 1:3) => partit%r_mpitype_nod3D(:,:,:) -end if \ No newline at end of file +end if + +nfbin_mpi => partit%nfbin_mpi +if (allocated(partit%s_mpitype_nod3D_fbin)) then + s_mpitype_nod3D_fbin( 1:com_nod2D%sPEnum , 1:nfbin_mpi, 1:3) => partit%s_mpitype_nod3D_fbin( :,:,:) + r_mpitype_nod3D_fbin( 1:com_nod2D%rPEnum , 1:nfbin_mpi, 1:3) => partit%r_mpitype_nod3D_fbin( :,:,:) + s_mpitype_elem2D_fbin( 1:com_elem2D%sPEnum , 1:nfbin_mpi ) => partit%s_mpitype_elem2D_fbin( :,:) + r_mpitype_elem2D_fbin( 1:com_elem2D%rPEnum , 1:nfbin_mpi ) => partit%r_mpitype_elem2D_fbin( :,:) + s_mpitype_elem2D_full_fbin(1:com_elem2D_full%sPEnum, 1:nfbin_mpi ) => partit%s_mpitype_elem2D_full_fbin( :,:) + r_mpitype_elem2D_full_fbin(1:com_elem2D_full%rPEnum, 1:nfbin_mpi ) => partit%r_mpitype_elem2D_full_fbin( :,:) + s_mpitype_elem3D_fbin( 1:com_elem2D%sPEnum , 1:nfbin_mpi, 1:4) => partit%s_mpitype_elem3D_fbin( :,:,:) + r_mpitype_elem3D_fbin( 1:com_elem2D%rPEnum , 1:nfbin_mpi, 1:4) => partit%r_mpitype_elem3D_fbin( :,:,:) + s_mpitype_elem3D_full_fbin(1:com_elem2D_full%sPEnum, 1:nfbin_mpi, 1:4) => partit%s_mpitype_elem3D_full_fbin(:,:,:) + r_mpitype_elem3D_full_fbin(1:com_elem2D_full%rPEnum, 1:nfbin_mpi, 1:4) => partit%r_mpitype_elem3D_full_fbin(:,:,:) +end if \ No newline at end of file diff --git a/src/associate_part_def.h b/src/associate_part_def.h index 262780a4a..0c64ea886 100644 --- a/src/associate_part_def.h +++ b/src/associate_part_def.h @@ -16,6 +16,13 @@ integer, dimension(:), pointer :: s_mpitype_nod2D_i, r_mpitype_nod2D_i integer, dimension(:,:,:), pointer :: s_mpitype_nod3D, r_mpitype_nod3D + integer, dimension(:,:,:), pointer :: s_mpitype_nod3D_fbin , r_mpitype_nod3D_fbin + integer, dimension(:,:), pointer :: s_mpitype_elem2D_fbin , r_mpitype_elem2D_fbin + integer, dimension(:,:), pointer :: s_mpitype_elem2D_full_fbin, r_mpitype_elem2D_full_fbin + integer, dimension(:,:,:), pointer :: s_mpitype_elem3D_fbin , r_mpitype_elem3D_fbin + integer, dimension(:,:,:), pointer :: s_mpitype_elem3D_full_fbin, r_mpitype_elem3D_full_fbin + integer, pointer :: nfbin_mpi + integer, pointer :: MPIERR integer, pointer :: MPIERR_IB ! copy for icebergs LA: 2023-05-22 integer, pointer :: npes diff --git a/src/gen_halo_exchange.F90 b/src/gen_halo_exchange.F90 index 92b9aba02..adf8a84b5 100755 --- a/src/gen_halo_exchange.F90 +++ b/src/gen_halo_exchange.F90 @@ -2721,6 +2721,528 @@ subroutine gather_edg2D_i(arr2D, arr2Dglobal, partit) end subroutine gather_edg2D_i !============================================== +! ======================================================================== +! Gather routines for spectral bin (fbin) fields used by IDEMIX2. +! These handle arrays with dimensions (nfbin, horizontal) instead of (nl, horizontal). +! ======================================================================== + +!============================================================================ +! Make nodal spectral bin information available to master PE +! arr3D(nfbin, nod2D) +subroutine gather_nod2D_fbin(arr2D, arr2D_global, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +integer :: nfbin +integer :: n +real(real64) :: arr2D(:,:) +real(real64) :: arr2D_global(:,:) +real(real64), allocatable :: recvbuf(:,:) +integer :: req(partit%npes-1) +integer :: start, n2D +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes> 1) then +CALL MPI_BARRIER(MPI_COMM_FESOM,MPIerr) + +nfbin=ubound(arr2D,1) + +IF ( mype == 0 ) THEN + + if (npes>1) then + allocate(recvbuf(nfbin,ubound(arr2D_global,2))) + + do n = 1, npes-1 + n2D = (remPtr_nod2D(n+1) - remPtr_nod2D(n))*nfbin + start = remPtr_nod2D(n) + call MPI_IRECV(recvbuf(1,start), n2D, MPI_DOUBLE_PRECISION, n, 2, MPI_COMM_FESOM, req(n), MPIerr) + enddo + + arr2D_global(1:nfbin,myList_nod2D(1:myDim_nod2D)) = arr2D(1:nfbin,1:myDim_nod2D) + + call MPI_WAITALL(npes-1, req, MPI_STATUSES_IGNORE, MPIerr) + + arr2D_global(1:nfbin, remList_nod2D(1 : remPtr_nod2D(npes)-1)) & + = recvbuf(1:nfbin, 1 : remPtr_nod2D(npes)-1) + + deallocate(recvbuf) + + else + arr2D_global(:,:) = arr2D(:,:) + endif + +ELSE + + call MPI_SEND( arr2D, myDim_nod2D*nfbin, MPI_DOUBLE_PRECISION, 0, 2, MPI_COMM_FESOM, MPIerr ) + +ENDIF + +end if +end subroutine gather_nod2D_fbin + +!============================================================================ +! Make element spectral bin information available to master PE +! arr2D(nfbin, elem2D) +subroutine gather_elem2D_fbin(arr2D, arr2D_global, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +integer :: nfbin +integer :: n +real(real64) :: arr2D(:,:) +real(real64) :: arr2D_global(:,:) +real(real64), allocatable :: recvbuf(:,:) +integer :: req(partit%npes-1) +integer :: start, n2D +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes> 1) then +CALL MPI_BARRIER(MPI_COMM_FESOM,MPIerr) + +nfbin=ubound(arr2D,1) + +IF ( mype == 0 ) THEN + + if (npes>1) then + allocate(recvbuf(nfbin,ubound(arr2D_global,2))) + + do n = 1, npes-1 + n2D = (remPtr_elem2D(n+1) - remPtr_elem2D(n))*nfbin + start = remPtr_elem2D(n) + call MPI_IRECV(recvbuf(1,start), n2D, MPI_DOUBLE_PRECISION, n, 2, MPI_COMM_FESOM, req(n), MPIerr) + enddo + + arr2D_global(1:nfbin,myList_elem2D(1:myDim_elem2D)) = arr2D(1:nfbin,1:myDim_elem2D) + + call MPI_WAITALL(npes-1, req, MPI_STATUSES_IGNORE, MPIerr) + + arr2D_global(1:nfbin, remList_elem2D(1 : remPtr_elem2D(npes)-1)) & + = recvbuf(1:nfbin, 1 : remPtr_elem2D(npes)-1) + + deallocate(recvbuf) + + else + arr2D_global(:,:) = arr2D(:,:) + endif + +ELSE + + call MPI_SEND( arr2D, myDim_elem2D*nfbin, MPI_DOUBLE_PRECISION, 0, 2, MPI_COMM_FESOM, MPIerr ) + +ENDIF + +end if +end subroutine gather_elem2D_fbin + +!============================================================================ +! Make nodal spectral bin information available to master PE (real4 version) +! arr2D(nfbin, nod2D) +subroutine gather_real4_nod2D_fbin(arr2D, arr2D_global, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +integer :: nfbin +integer :: n +real(real32) :: arr2D(:,:) +real(real32) :: arr2D_global(:,:) +real(real32), allocatable :: recvbuf(:,:) +integer :: req(partit%npes-1) +integer :: start, n2D +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes> 1) then +CALL MPI_BARRIER(MPI_COMM_FESOM,MPIerr) + +nfbin=ubound(arr2D,1) + +IF ( mype == 0 ) THEN + + if (npes>1) then + allocate(recvbuf(nfbin,ubound(arr2D_global,2))) + + do n = 1, npes-1 + n2D = (remPtr_nod2D(n+1) - remPtr_nod2D(n))*nfbin + start = remPtr_nod2D(n) + call MPI_IRECV(recvbuf(1,start), n2D, MPI_REAL, n, 2, MPI_COMM_FESOM, req(n), MPIerr) + enddo + + arr2D_global(1:nfbin,myList_nod2D(1:myDim_nod2D)) = arr2D(1:nfbin,1:myDim_nod2D) + + call MPI_WAITALL(npes-1, req, MPI_STATUSES_IGNORE, MPIerr) + + arr2D_global(1:nfbin, remList_nod2D(1 : remPtr_nod2D(npes)-1)) & + = recvbuf(1:nfbin, 1 : remPtr_nod2D(npes)-1) + + deallocate(recvbuf) + + else + arr2D_global(:,:) = arr2D(:,:) + endif + +ELSE + + call MPI_SEND( arr2D, myDim_nod2D*nfbin, MPI_REAL, 0, 2, MPI_COMM_FESOM, MPIerr ) + +ENDIF + +end if +end subroutine gather_real4_nod2D_fbin + +!============================================================================ +! Make element spectral bin information available to master PE (real4 version) +! arr2D(nfbin, elem2D) +subroutine gather_real4_elem2D_fbin(arr2D, arr2D_global, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +integer :: nfbin +integer :: n +real(real32) :: arr2D(:,:) +real(real32) :: arr2D_global(:,:) +real(real32), allocatable :: recvbuf(:,:) +integer :: req(partit%npes-1) +integer :: start, n2D +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes> 1) then +CALL MPI_BARRIER(MPI_COMM_FESOM,MPIerr) + +nfbin=ubound(arr2D,1) + +IF ( mype == 0 ) THEN + + if (npes>1) then + allocate(recvbuf(nfbin,ubound(arr2D_global,2))) + + do n = 1, npes-1 + n2D = (remPtr_elem2D(n+1) - remPtr_elem2D(n))*nfbin + start = remPtr_elem2D(n) + call MPI_IRECV(recvbuf(1,start), n2D, MPI_REAL, n, 2, MPI_COMM_FESOM, req(n), MPIerr) + enddo + + arr2D_global(1:nfbin,myList_elem2D(1:myDim_elem2D)) = arr2D(1:nfbin,1:myDim_elem2D) + + call MPI_WAITALL(npes-1, req, MPI_STATUSES_IGNORE, MPIerr) + + arr2D_global(1:nfbin, remList_elem2D(1 : remPtr_elem2D(npes)-1)) & + = recvbuf(1:nfbin, 1 : remPtr_elem2D(npes)-1) + + deallocate(recvbuf) + + else + arr2D_global(:,:) = arr2D(:,:) + endif + +ELSE + + call MPI_SEND( arr2D, myDim_elem2D*nfbin, MPI_REAL, 0, 2, MPI_COMM_FESOM, MPIerr ) + +ENDIF + +end if +end subroutine gather_real4_elem2D_fbin + +!============================================== + +! ======================================================================== +! Halo exchange routines for spectral bin (fbin) fields used by IDEMIX2. +! The first array dimension is nfbin (number of spectral frequency bins) +! instead of nl (number of vertical levels). +! Naming convention: +! exchange_nod2D_fbin: nodal 2D spectral field arr(nfbin, nod2D) +! exchange_nod3D_fbin: nodal 3D spectral field arr(n_val, nfbin, nod2D) +! exchange_elem2D_fbin: elem 2D spectral field arr(nfbin, elem2D) +! exchange_elem3D_fbin: elem 3D spectral field arr(n_val, nfbin, elem2D) +! ======================================================================== + +! ======================================================================== +! 2D nodal spectral field: arr(nfbin, myDim_nod2D+eDim_nod2D) +! ======================================================================== +subroutine exchange_nod2D_fbin(nod_array, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +real(real64), intent(inout) :: nod_array(:,:) +if (partit%npes > 1) then + call exchange_nod2D_fbin_begin(nod_array, partit) + call exchange_nod_end(partit) +endif +END SUBROUTINE exchange_nod2D_fbin + +subroutine exchange_nod2D_fbin_begin(nod_array, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +real(real64), intent(inout) :: nod_array(:,:) +integer :: n, sn, rn, i +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes > 1) then + if (nfbin_mpi == 0) then + if (mype==0) print *,'ERROR: exchange_nod2D_fbin called but init_mpi_types_fbin was not called.' + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 1) + endif + + sn=com_nod2D%sPEnum + rn=com_nod2D%rPEnum + + ! Exchange all spectral bins + DO i=1,nfbin_mpi + DO n=1,rn + call MPI_IRECV(nod_array, 1, r_mpitype_nod3D_fbin(n,i,1), com_nod2D%rPE(n), & + com_nod2D%rPE(n), MPI_COMM_FESOM, com_nod2D%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(nod_array, 1, s_mpitype_nod3D_fbin(n,i,1), com_nod2D%sPE(n), & + mype, MPI_COMM_FESOM, com_nod2D%req(rn+n), MPIerr) + END DO + com_nod2D%nreq = rn+sn + call MPI_WAITALL(com_nod2D%nreq, com_nod2D%req, MPI_STATUSES_IGNORE, MPIerr) + END DO +endif +END SUBROUTINE exchange_nod2D_fbin_begin + +! ======================================================================== +! 3D nodal spectral field: arr(n_val, nfbin, myDim_nod2D+eDim_nod2D) +! ======================================================================== +subroutine exchange_nod3D_fbin(nod_array, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +real(real64), intent(inout) :: nod_array(:,:,:) +if (partit%npes > 1) then + call exchange_nod3D_fbin_begin(nod_array, partit) + call exchange_nod_end(partit) +endif +END SUBROUTINE exchange_nod3D_fbin + +subroutine exchange_nod3D_fbin_begin(nod_array, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +real(real64), intent(inout) :: nod_array(:,:,:) +integer :: n, sn, rn, n_val, i +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes > 1) then + if (nfbin_mpi == 0) then + if (mype==0) print *,'ERROR: exchange_nod3D_fbin called but init_mpi_types_fbin was not called.' + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 1) + endif + + ! nod_array(n_val, nfbin, nod2D) + n_val = ubound(nod_array,1) + if (n_val < 1 .or. n_val > 3) then + if (mype==0) print *,'exchange_nod3D_fbin: n_val must be 1..3, got', n_val + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 1) + endif + + sn=com_nod2D%sPEnum + rn=com_nod2D%rPEnum + + ! Exchange all spectral bins + DO i=1,nfbin_mpi + DO n=1,rn + call MPI_IRECV(nod_array, 1, r_mpitype_nod3D_fbin(n,i,n_val), com_nod2D%rPE(n), & + com_nod2D%rPE(n), MPI_COMM_FESOM, com_nod2D%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(nod_array, 1, s_mpitype_nod3D_fbin(n,i,n_val), com_nod2D%sPE(n), & + mype, MPI_COMM_FESOM, com_nod2D%req(rn+n), MPIerr) + END DO + com_nod2D%nreq = rn+sn + call MPI_WAITALL(com_nod2D%nreq, com_nod2D%req, MPI_STATUSES_IGNORE, MPIerr) + END DO +endif +END SUBROUTINE exchange_nod3D_fbin_begin + +! ======================================================================== +! 2D elemental spectral field: arr(nfbin, myDim_elem2D+eDim_elem2D) +! ======================================================================== +subroutine exchange_elem2D_fbin(elem_array, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +real(real64), intent(inout) :: elem_array(:,:) +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes > 1) then + call exchange_elem2D_fbin_begin(elem_array, partit) + call exchange_elem_end(partit) +endif +END SUBROUTINE exchange_elem2D_fbin + +subroutine exchange_elem2D_fbin_begin(elem_array, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +real(real64), intent(inout) :: elem_array(:,:) +integer :: n, sn, rn, i +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes > 1) then + if (nfbin_mpi == 0) then + if (mype==0) print *,'ERROR: exchange_elem2D_fbin called but init_mpi_types_fbin was not called.' + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 1) + endif + + if (ubound(elem_array,2)<=myDim_elem2D+eDim_elem2D) then + ! small halo + elem_full_flag = .false. + sn=com_elem2D%sPEnum + rn=com_elem2D%rPEnum + + ! Exchange all spectral bins + DO i=1,nfbin_mpi + DO n=1,rn + call MPI_IRECV(elem_array, 1, r_mpitype_elem2D_fbin(n,i), com_elem2D%rPE(n), & + com_elem2D%rPE(n), MPI_COMM_FESOM, com_elem2D%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(elem_array, 1, s_mpitype_elem2D_fbin(n,i), com_elem2D%sPE(n), & + mype, MPI_COMM_FESOM, com_elem2D%req(rn+n), MPIerr) + END DO + com_elem2D%nreq = rn+sn + call MPI_WAITALL(com_elem2D%nreq, com_elem2D%req, MPI_STATUSES_IGNORE, MPIerr) + END DO + else + ! full halo + elem_full_flag = .true. + sn=com_elem2D_full%sPEnum + rn=com_elem2D_full%rPEnum + + ! Exchange all spectral bins + DO i=1,nfbin_mpi + DO n=1,rn + call MPI_IRECV(elem_array, 1, r_mpitype_elem2D_full_fbin(n,i), com_elem2D_full%rPE(n), & + com_elem2D_full%rPE(n), MPI_COMM_FESOM, com_elem2D_full%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(elem_array, 1, s_mpitype_elem2D_full_fbin(n,i), com_elem2D_full%sPE(n), & + mype, MPI_COMM_FESOM, com_elem2D_full%req(rn+n), MPIerr) + END DO + com_elem2D_full%nreq = rn+sn + call MPI_WAITALL(com_elem2D_full%nreq, com_elem2D_full%req, MPI_STATUSES_IGNORE, MPIerr) + END DO + endif +endif +END SUBROUTINE exchange_elem2D_fbin_begin + +! ======================================================================== +! 3D elemental spectral field: arr(n_val, nfbin, myDim_elem2D+eDim_elem2D) +! ======================================================================== +subroutine exchange_elem3D_fbin(elem_array, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +real(real64), intent(inout) :: elem_array(:,:,:) +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes > 1) then + call exchange_elem3D_fbin_begin(elem_array, partit) + call exchange_elem_end(partit) +endif +END SUBROUTINE exchange_elem3D_fbin + +subroutine exchange_elem3D_fbin_begin(elem_array, partit) +use MOD_MESH +USE MOD_PARTIT +USE MOD_PARSUP +IMPLICIT NONE +type(t_partit), intent(inout), target :: partit +real(real64), intent(inout) :: elem_array(:,:,:) +integer :: n, sn, rn, n_val, i +#include "associate_part_def.h" +#include "associate_part_ass.h" + +if (npes > 1) then + if (nfbin_mpi == 0) then + if (mype==0) print *,'ERROR: exchange_elem3D_fbin called but init_mpi_types_fbin was not called.' + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 1) + endif + + ! elem_array(n_val, nfbin, elem2D) + n_val = ubound(elem_array,1) + if (n_val < 1 .or. n_val > 4) then + if (mype==0) print *,'exchange_elem3D_fbin: n_val must be 1..4, got', n_val + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 1) + endif + + if (ubound(elem_array,3)<=myDim_elem2D+eDim_elem2D) then + ! small halo + elem_full_flag = .false. + sn=com_elem2D%sPEnum + rn=com_elem2D%rPEnum + + ! Exchange all spectral bins + DO i=1,nfbin_mpi + DO n=1,rn + call MPI_IRECV(elem_array, 1, r_mpitype_elem3D_fbin(n,i,n_val), com_elem2D%rPE(n), & + com_elem2D%rPE(n), MPI_COMM_FESOM, com_elem2D%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(elem_array, 1, s_mpitype_elem3D_fbin(n,i,n_val), com_elem2D%sPE(n), & + mype, MPI_COMM_FESOM, com_elem2D%req(rn+n), MPIerr) + END DO + com_elem2D%nreq = rn+sn + call MPI_WAITALL(com_elem2D%nreq, com_elem2D%req, MPI_STATUSES_IGNORE, MPIerr) + END DO + else + ! full halo + elem_full_flag = .true. + sn=com_elem2D_full%sPEnum + rn=com_elem2D_full%rPEnum + + ! Exchange all spectral bins + DO i=1,nfbin_mpi + DO n=1,rn + call MPI_IRECV(elem_array, 1, r_mpitype_elem3D_full_fbin(n,i,n_val), com_elem2D_full%rPE(n), & + com_elem2D_full%rPE(n), MPI_COMM_FESOM, com_elem2D_full%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(elem_array, 1, s_mpitype_elem3D_full_fbin(n,i,n_val), com_elem2D_full%sPE(n), & + mype, MPI_COMM_FESOM, com_elem2D_full%req(rn+n), MPIerr) + END DO + com_elem2D_full%nreq = rn+sn + call MPI_WAITALL(com_elem2D_full%nreq, com_elem2D_full%req, MPI_STATUSES_IGNORE, MPIerr) + END DO + endif +endif +END SUBROUTINE exchange_elem3D_fbin_begin + +! ======================================================================== + end module g_comm @@ -2767,6 +3289,26 @@ module g_comm_auto module procedure exchange_elem2d_i_begin end interface exchange_elem_begin +interface exchange_nod_fbin + module procedure exchange_nod2D_fbin + module procedure exchange_nod3D_fbin +end interface exchange_nod_fbin + +interface exchange_nod_fbin_begin + module procedure exchange_nod2D_fbin_begin + module procedure exchange_nod3D_fbin_begin +end interface exchange_nod_fbin_begin + +interface exchange_elem_fbin + module procedure exchange_elem2D_fbin + module procedure exchange_elem3D_fbin +end interface exchange_elem_fbin + +interface exchange_elem_fbin_begin + module procedure exchange_elem2D_fbin_begin + module procedure exchange_elem3D_fbin_begin +end interface exchange_elem_fbin_begin + interface broadcast_nod module procedure broadcast_nod3D @@ -2790,6 +3332,11 @@ module g_comm_auto module procedure gather_nod2D_i end interface gather_nod +interface gather_nod_fbin + module procedure gather_nod2D_fbin + module procedure gather_real4_nod2D_fbin +end interface gather_nod_fbin + interface gather_elem module procedure gather_elem3D module procedure gather_elem2D @@ -2802,6 +3349,11 @@ module g_comm_auto module procedure gather_elem2D_i end interface gather_elem +interface gather_elem_fbin + module procedure gather_elem2D_fbin + module procedure gather_real4_elem2D_fbin +end interface gather_elem_fbin + interface gather_edge module procedure gather_edg2D module procedure gather_edg2D_i @@ -2811,5 +3363,8 @@ module g_comm_auto private ! hides items not listed on public statement public :: exchange_nod,exchange_elem,broadcast_nod,broadcast_elem, & gather_nod, gather_elem, exchange_nod_begin, exchange_nod_end, exchange_elem_begin, & - exchange_elem_end, gather_edge + exchange_elem_end, gather_edge, & + exchange_nod_fbin, exchange_elem_fbin, & + exchange_nod_fbin_begin, exchange_elem_fbin_begin, & + gather_nod_fbin, gather_elem_fbin end module g_comm_auto From 87cc4acc44e166fb9e7d4aa45ba8ba906222233c Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 20 Mar 2026 16:03:07 +0100 Subject: [PATCH 19/63] add wall clock time meassuremtns for mixing scheme --- src/fesom_module.F90 | 88 +++++++++++++++++---------------- src/oce_ale.F90 | 115 ++++++++++++++++++++++++------------------- 2 files changed, 108 insertions(+), 95 deletions(-) diff --git a/src/fesom_module.F90 b/src/fesom_module.F90 index 50e379133..ab9b7498a 100755 --- a/src/fesom_module.F90 +++ b/src/fesom_module.F90 @@ -805,7 +805,7 @@ subroutine fesom_finalize() use mpp_io #endif ! EO parameters - real(kind=real32) :: mean_rtime(15), max_rtime(15), min_rtime(15) + real(kind=real32) :: mean_rtime(16), max_rtime(16), min_rtime(16) integer :: tr_num ! Start finalization profiling @@ -876,37 +876,38 @@ subroutine fesom_finalize() endif mean_rtime(1) = rtime_oce - mean_rtime(2) = rtime_oce_mixpres - mean_rtime(3) = rtime_oce_dyn - mean_rtime(4) = rtime_oce_dynssh - mean_rtime(5) = rtime_oce_solvessh - mean_rtime(6) = rtime_oce_GMRedi - mean_rtime(7) = rtime_oce_solvetra - mean_rtime(8) = rtime_ice - mean_rtime(9) = rtime_tot - mean_rtime(10) = f%rtime_fullice - f%rtime_read_forcing - mean_rtime(11) = f%rtime_compute_diag - mean_rtime(12) = f%rtime_write_means - mean_rtime(13) = f%rtime_write_restart - mean_rtime(14) = f%rtime_read_forcing + mean_rtime(2) = rtime_oce_presdens + mean_rtime(3) = rtime_oce_mixing + mean_rtime(4) = rtime_oce_dyn + mean_rtime(5) = rtime_oce_dynssh + mean_rtime(6) = rtime_oce_solvessh + mean_rtime(7) = rtime_oce_GMRedi + mean_rtime(8) = rtime_oce_solvetra + mean_rtime(9) = rtime_ice + mean_rtime(10) = rtime_tot + mean_rtime(11) = f%rtime_fullice - f%rtime_read_forcing + mean_rtime(12) = f%rtime_compute_diag + mean_rtime(13) = f%rtime_write_means + mean_rtime(14) = f%rtime_write_restart + mean_rtime(15) = f%rtime_read_forcing #if defined (__recom) - mean_rtime(15) = f%rtime_compute_recom + mean_rtime(16) = f%rtime_compute_recom #endif - max_rtime(1:14) = mean_rtime(1:14) - min_rtime(1:14) = mean_rtime(1:14) + max_rtime(1:15) = mean_rtime(1:15) + min_rtime(1:15) = mean_rtime(1:15) #if defined (__recom) - max_rtime(15) = mean_rtime(15) - min_rtime(15) = mean_rtime(15) - call MPI_AllREDUCE(MPI_IN_PLACE, mean_rtime(15), 1, MPI_REAL, MPI_SUM, f%MPI_COMM_FESOM, f%MPIerr) - mean_rtime(15) = mean_rtime(15) / real(f%npes,real32) - call MPI_AllREDUCE(MPI_IN_PLACE, max_rtime(15), 1, MPI_REAL, MPI_MAX, f%MPI_COMM_FESOM, f%MPIerr) - call MPI_AllREDUCE(MPI_IN_PLACE, min_rtime(15), 1, MPI_REAL, MPI_MIN, f%MPI_COMM_FESOM, f%MPIerr) -#endif - - call MPI_AllREDUCE(MPI_IN_PLACE, mean_rtime, 14, MPI_REAL, MPI_SUM, f%MPI_COMM_FESOM, f%MPIerr) - mean_rtime(1:14) = mean_rtime(1:14) / real(f%npes,real32) - call MPI_AllREDUCE(MPI_IN_PLACE, max_rtime, 14, MPI_REAL, MPI_MAX, f%MPI_COMM_FESOM, f%MPIerr) - call MPI_AllREDUCE(MPI_IN_PLACE, min_rtime, 14, MPI_REAL, MPI_MIN, f%MPI_COMM_FESOM, f%MPIerr) + max_rtime(16) = mean_rtime(16) + min_rtime(16) = mean_rtime(16) + call MPI_AllREDUCE(MPI_IN_PLACE, mean_rtime(16), 1, MPI_REAL, MPI_SUM, f%MPI_COMM_FESOM, f%MPIerr) + mean_rtime(16) = mean_rtime(16) / real(f%npes,real32) + call MPI_AllREDUCE(MPI_IN_PLACE, max_rtime(16), 1, MPI_REAL, MPI_MAX, f%MPI_COMM_FESOM, f%MPIerr) + call MPI_AllREDUCE(MPI_IN_PLACE, min_rtime(16), 1, MPI_REAL, MPI_MIN, f%MPI_COMM_FESOM, f%MPIerr) +#endif + + call MPI_AllREDUCE(MPI_IN_PLACE, mean_rtime, 15, MPI_REAL, MPI_SUM, f%MPI_COMM_FESOM, f%MPIerr) + mean_rtime(1:15) = mean_rtime(1:15) / real(f%npes,real32) + call MPI_AllREDUCE(MPI_IN_PLACE, max_rtime, 15, MPI_REAL, MPI_MAX, f%MPI_COMM_FESOM, f%MPIerr) + call MPI_AllREDUCE(MPI_IN_PLACE, min_rtime, 15, MPI_REAL, MPI_MIN, f%MPI_COMM_FESOM, f%MPIerr) #if defined (__oifs) ! OpenIFS coupled version has to call oasis_terminate through par_ex @@ -930,21 +931,22 @@ subroutine fesom_finalize() print 41, '___MODEL RUNTIME per task [seconds]','_____mean_','___________min_', '___________max_' print 42, ' runtime ocean: ', mean_rtime(1), min_rtime(1), max_rtime(1) - print 42, ' > runtime oce. mix,pres. :', mean_rtime(2), min_rtime(2), max_rtime(2) - print 42, ' > runtime oce. dyn. u,v,w:', mean_rtime(3), min_rtime(3), max_rtime(3) - print 42, ' > runtime oce. dyn. ssh :', mean_rtime(4), min_rtime(4), max_rtime(4) - print 42, ' > runtime oce. solve ssh :', mean_rtime(5), min_rtime(5), max_rtime(5) - print 42, ' > runtime oce. GM/Redi :', mean_rtime(6), min_rtime(6), max_rtime(6) - print 42, ' > runtime oce. tracer :', mean_rtime(7), min_rtime(7), max_rtime(7) - print 42, ' runtime ice : ', mean_rtime(10), min_rtime(10), max_rtime(10) - print 42, ' > runtime ice step : ', mean_rtime(8), min_rtime(8), max_rtime(8) - print 42, ' runtime diag: ', mean_rtime(11), min_rtime(11), max_rtime(11) - print 42, ' runtime output: ', mean_rtime(12), min_rtime(12), max_rtime(12) - print 42, ' runtime restart: ', mean_rtime(13), min_rtime(13), max_rtime(13) - print 42, ' runtime forcing: ', mean_rtime(14), min_rtime(14), max_rtime(14) - print 42, ' runtime total (ice+oce): ', mean_rtime(9), min_rtime(9), max_rtime(9) + print 42, ' > runtime oce. pres.,dens:', mean_rtime(2), min_rtime(2), max_rtime(2) + print 42, ' > runtime oce. mixing :', mean_rtime(3), min_rtime(3), max_rtime(3) + print 42, ' > runtime oce. dyn. u,v,w:', mean_rtime(4), min_rtime(4), max_rtime(4) + print 42, ' > runtime oce. dyn. ssh :', mean_rtime(5), min_rtime(5), max_rtime(5) + print 42, ' > runtime oce. solve ssh :', mean_rtime(6), min_rtime(6), max_rtime(6) + print 42, ' > runtime oce. GM/Redi :', mean_rtime(7), min_rtime(7), max_rtime(7) + print 42, ' > runtime oce. tracer :', mean_rtime(8), min_rtime(8), max_rtime(8) + print 42, ' runtime ice : ', mean_rtime(11), min_rtime(11), max_rtime(11) + print 42, ' > runtime ice step : ', mean_rtime(9), min_rtime(9), max_rtime(9) + print 42, ' runtime diag: ', mean_rtime(12), min_rtime(12), max_rtime(12) + print 42, ' runtime output: ', mean_rtime(13), min_rtime(13), max_rtime(13) + print 42, ' runtime restart: ', mean_rtime(14), min_rtime(14), max_rtime(14) + print 42, ' runtime forcing: ', mean_rtime(15), min_rtime(15), max_rtime(15) + print 42, ' runtime total (ice+oce): ', mean_rtime(10), min_rtime(10), max_rtime(10) #if defined (__recom) - print 42, ' runtime recom: ', mean_rtime(15), min_rtime(15), max_rtime(15) + print 42, ' runtime recom: ', mean_rtime(16), min_rtime(16), max_rtime(16) #endif 43 format (a33,i15) !Format Ncores diff --git a/src/oce_ale.F90 b/src/oce_ale.F90 index 2a87025e1..1e6614a6a 100644 --- a/src/oce_ale.F90 +++ b/src/oce_ale.F90 @@ -3357,7 +3357,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) type(t_mesh) , intent(inout), target :: mesh type(t_ice) , intent(inout), target :: ice !___________________________________________________________________________ - real(kind=8) :: t0,t1, t2, t30, t3, t4, t5, t6, t7, t8, t9, t10, loc, glo + real(kind=8) :: t0, t1, t2, t30, t3, t4, t5, t6, t7, t8, t9, t10, t11, loc, glo integer :: node integer :: nz, elem, nzmin, nzmax !for KE diagnostic !___________________________________________________________________________ @@ -3368,17 +3368,16 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) #include "associate_part_ass.h" #include "associate_mesh_ass.h" eta_n => dynamics%eta_n(:) - - !___________________________________________________________________________ - t0=MPI_Wtime() !PS water_flux = 0.0_WP !PS heat_flux = 0.0_WP !PS stress_surf= 0.0_WP !PS stress_node_surf= 0.0_WP - + !___________________________________________________________________________ + t0=MPI_Wtime() #if defined (FESOM_PROFILING) - call fesom_profiler_start("oce_mix_pres") + call fesom_profiler_start("oce_pressure_density") #endif + !___________________________________________________________________________ ! calculate equation of state, density, pressure and mixed layer depths if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call pressure_bv'//achar(27)//'[0m' @@ -3413,6 +3412,13 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) !___________________________________________________________________________ call status_check(partit) + + t1 = MPI_Wtime() +#if defined (FESOM_PROFILING) + call fesom_profiler_end("oce_pressure_density") + call fesom_profiler_start("oce_mixing_scheme") +#endif + !___________________________________________________________________________ ! >>>>>> <<<<<< ! >>>>>> calculate vertical mixing coefficients for tracer (Kv) <<<<<< @@ -3500,9 +3506,10 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) end if #endif - t1=MPI_Wtime() + + t2=MPI_Wtime() #if defined (FESOM_PROFILING) - call fesom_profiler_end("oce_mix_pres") + call fesom_profiler_end("oce_mixing_scheme") call fesom_profiler_start("oce_dyn_momentum") #endif @@ -3632,7 +3639,8 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) end do end if end if - t2=MPI_Wtime() + + t3=MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_end("oce_dyn_momentum") call fesom_profiler_start("oce_ssh_solve") @@ -3660,10 +3668,10 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call relax_zonal_vel'//achar(27)//'[0m' call relax_zonal_vel(dynamics, partit, mesh) end if - t3=MPI_Wtime() + t4=MPI_Wtime() #if defined (FESOM_PROFILING) - call fesom_profiler_end("oce_ssh_solve") - call fesom_profiler_start("oce_vel_update") + call fesom_profiler_end("oce_ssh_solve") + call fesom_profiler_start("oce_vel_update") #endif ! estimate new horizontal velocity u^(n+1) @@ -3673,10 +3681,10 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) call update_vel(dynamics, partit, mesh) ! --> eta_(n) --> eta_(n+1) = eta_(n) + deta = eta_(n) + (eta_(n+1) + eta_(n)) - t4=MPI_Wtime() + t5=MPI_Wtime() #if defined (FESOM_PROFILING) - call fesom_profiler_end("oce_vel_update") - call fesom_profiler_start("oce_hbar_calc") + call fesom_profiler_end("oce_vel_update") + call fesom_profiler_start("oce_hbar_calc") #endif ! Update to hbar(n+3/2) and compute dhe to be used on the next step @@ -3701,10 +3709,10 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) !$OMP END PARALLEL DO ! --> eta_(n) ! call zero_dynamics !DS, zeros several dynamical variables; to be used for testing new implementations! - t5=MPI_Wtime() + t6=MPI_Wtime() #if defined (FESOM_PROFILING) - call fesom_profiler_end("oce_hbar_calc") - call fesom_profiler_start("oce_gm_redi") + call fesom_profiler_end("oce_hbar_calc") + call fesom_profiler_start("oce_gm_redi") #endif !___________________________________________________________________________ @@ -3717,20 +3725,21 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! Do barotropic step, get eta_{n+1} and BT transport call compute_BT_step_SE_ale(dynamics, partit, mesh) - t3=MPI_Wtime() + t4=MPI_Wtime() #if defined (FESOM_PROFILING) - call fesom_profiler_end("oce_ssh_solve") - call fesom_profiler_start("oce_vel_update") -#endif + call fesom_profiler_end("oce_ssh_solve") + call fesom_profiler_start("oce_vel_update") +#endif + ! Trim U to be consistent with BT transport call update_trim_vel_ale_vtransp(1, dynamics, partit, mesh) - t4=MPI_Wtime() - t5=t4 + t5=MPI_Wtime() + t6=t5 #if defined (FESOM_PROFILING) - call fesom_profiler_end("oce_vel_update") - call fesom_profiler_start("oce_hbar_calc") - call fesom_profiler_end("oce_hbar_calc") - call fesom_profiler_start("oce_gm_redi") + call fesom_profiler_end("oce_vel_update") + call fesom_profiler_start("oce_hbar_calc") + call fesom_profiler_end("oce_hbar_calc") + call fesom_profiler_start("oce_gm_redi") #endif end if ! --> if (.not. dynamics%use_ssh_se_subcycl) then @@ -3747,7 +3756,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) call fer_solve_Gamma(partit, mesh) call fer_gamma2vel(dynamics, partit, mesh) end if - t6=MPI_Wtime() + t7=MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_end("oce_gm_redi") call fesom_profiler_start("oce_vert_vel") @@ -3777,7 +3786,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) end if call compute_vert_vel_transpv(dynamics, partit, mesh) end if - t7=MPI_Wtime() + t8=MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_end("oce_vert_vel") call fesom_profiler_start("oce_tracer_solve") @@ -3795,7 +3804,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! solve tracer equation if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call solve_tracers_ale'//achar(27)//'[0m' call solve_tracers_ale(ice, dynamics, tracers, partit, mesh) - t8=MPI_Wtime() + t9=MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_end("oce_tracer_solve") call fesom_profiler_start("oce_thickness_update") @@ -3805,7 +3814,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! Update hnode=hnode_new, helem if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call update_thickness_ale'//achar(27)//'[0m' call update_thickness_ale(partit, mesh) - t9=MPI_Wtime() + t10=MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_end("oce_thickness_update") call fesom_profiler_start("oce_blowup_check") @@ -3833,37 +3842,39 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) ! togeather around 2.5% of model runtime if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call check_blowup'//achar(27)//'[0m' call check_blowup(n, ice, dynamics, tracers, partit, mesh) - t10=MPI_Wtime() + t11=MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_end("oce_blowup_check") #endif !___________________________________________________________________________ ! write out execution times for ocean step parts - rtime_oce = rtime_oce + (t10-t0)-(t10-t9) - rtime_oce_mixpres = rtime_oce_mixpres + (t1-t0) - rtime_oce_dyn = rtime_oce_dyn + (t2-t1)+(t7-t6)+(t4-t3) - rtime_oce_dynssh = rtime_oce_dynssh + (t3-t2)+(t5-t4) - rtime_oce_solvessh = rtime_oce_solvessh + (t3-t30) - rtime_oce_GMRedi = rtime_oce_GMRedi + (t6-t5) - rtime_oce_solvetra = rtime_oce_solvetra + (t8-t7) - rtime_tot = rtime_tot + (t10-t0)-(t10-t9) + rtime_oce = rtime_oce + (t11-t0)-(t11-t10) + rtime_oce_presdens = rtime_oce_presdens + (t1-t0) + rtime_oce_mixing = rtime_oce_mixing + (t2-t1) + rtime_oce_dyn = rtime_oce_dyn + (t3-t2)+(t8-t7)+(t5-t4) + rtime_oce_dynssh = rtime_oce_dynssh + (t4-t3)+(t6-t5) + rtime_oce_solvessh = rtime_oce_solvessh + (t4-t30) + rtime_oce_GMRedi = rtime_oce_GMRedi + (t7-t6) + rtime_oce_solvetra = rtime_oce_solvetra + (t9-t8) + rtime_tot = rtime_tot + (t11-t0)-(t11-t10) if(mod(n,logfile_outfreq)==0 .and. mype==0) then write(*,*) '___ALE OCEAN STEP EXECUTION TIMES______________________' - write(*,"(A, ES10.3)") ' Oce. Mix,Press.. :', t1-t0 - write(*,"(A, ES10.3)") ' Oce. Dynamics :', t2-t1 - write(*,"(A, ES10.3)") ' Oce. Update Vel. :', t4-t3 - write(*,"(A, ES10.3)") ' Oce. Fer-GM. :', t6-t5 + write(*,"(A, ES10.3)") ' Oce. Press, Dens.:', t1-t0 + write(*,"(A, ES10.3)") ' Oce. Mixing :', t2-t1 + write(*,"(A, ES10.3)") ' Oce. Dynamics :', t3-t2 + write(*,"(A, ES10.3)") ' Oce. Update Vel. :', t5-t4 + write(*,"(A, ES10.3)") ' Oce. Fer-GM. :', t7-t6 write(*,*) ' _______________________________' - write(*,"(A, ES10.3)") ' ALE-Solve SSH :', t3-t2 - write(*,"(A, ES10.3)") ' ALE-Calc. hbar :', t5-t4 - write(*,"(A, ES10.3)") ' ALE-Update+W :', t7-t6 - write(*,"(A, ES10.3)") ' ALE-Solve Tracer :', t8-t7 - write(*,"(A, ES10.3)") ' ALE-Update hnode :', t9-t8 + write(*,"(A, ES10.3)") ' ALE-Solve SSH :', t4-t3 + write(*,"(A, ES10.3)") ' ALE-Calc. hbar :', t6-t5 + write(*,"(A, ES10.3)") ' ALE-Update+W :', t8-t7 + write(*,"(A, ES10.3)") ' ALE-Solve Tracer :', t9-t8 + write(*,"(A, ES10.3)") ' ALE-Update hnode :', t10-t9 write(*,*) ' _______________________________' - write(*,"(A, ES10.3)") ' check for blowup :', t10-t9 + write(*,"(A, ES10.3)") ' check for blowup :', t11-t10 write(*,*) ' _______________________________' - write(*,"(A, ES10.3)") ' Oce. TOTAL :', t10-t0 + write(*,"(A, ES10.3)") ' Oce. TOTAL :', t11-t0 write(*,*) write(*,*) end if From b585a63e41f3971503972a5471a218fd9245e708 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 20 Mar 2026 16:03:53 +0100 Subject: [PATCH 20/63] add wall clock time meassuremtns for mixing scheme --- src/gen_modules_config.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/gen_modules_config.F90 b/src/gen_modules_config.F90 index ecc17effa..2974c63f7 100755 --- a/src/gen_modules_config.F90 +++ b/src/gen_modules_config.F90 @@ -170,7 +170,7 @@ module g_config logical :: r_restart real(kind=WP) :: rtime_ice=0.0, rtime_tot=0.0 real(kind=WP) :: rtime_oce=0.0, rtime_oce_dyn=0.0, rtime_oce_dynssh=0.0, rtime_oce_solvessh=0.0 - real(kind=WP) :: rtime_oce_solvetra=0.0, rtime_oce_GMRedi=0.0, rtime_oce_mixpres=0.0 + real(kind=WP) :: rtime_oce_solvetra=0.0, rtime_oce_GMRedi=0.0, rtime_oce_presdens=0.0, rtime_oce_mixing=0.0 real(kind=WP) :: dummy=1.e10 From bffbae744c663f2e668475fd307f8d3e5586d98b Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 20 Mar 2026 16:04:16 +0100 Subject: [PATCH 21/63] add halo exchange for spectral data --- src/gen_modules_partitioning.F90 | 279 +++++++++++++++++++++++++++++++ 1 file changed, 279 insertions(+) diff --git a/src/gen_modules_partitioning.F90 b/src/gen_modules_partitioning.F90 index 1c1996f8b..f079789e7 100644 --- a/src/gen_modules_partitioning.F90 +++ b/src/gen_modules_partitioning.F90 @@ -35,6 +35,14 @@ subroutine init_gatherLists(partit) implicit none type(t_partit), intent(inout), target :: partit end subroutine init_gatherLists + + subroutine init_mpi_types_fbin(nfbin, partit) + USE MOD_PARTIT + USE MOD_PARSUP + implicit none + integer, intent(in) :: nfbin + type(t_partit), intent(inout), target :: partit + end subroutine init_mpi_types_fbin end interface end module par_support_interfaces @@ -505,6 +513,277 @@ subroutine init_mpi_types(partit, mesh) deallocate(blocklen_tmp, displace_tmp) endif end subroutine init_mpi_types + + + +!=================================================================== +! Build MPI Data types for halo exchange of spectral bin (fbin) fields. +! These are used by IDEMIX2 where the first array dimension is nfbin +! (number of spectral frequency bins) instead of nl (number of vertical levels). +! Must be called after init_mpi_types and before first spectral bin exchange. +subroutine init_mpi_types_fbin(nfbin, partit) + USE MOD_PARTIT + USE MOD_PARSUP + implicit none + + integer, intent(in) :: nfbin + type(t_partit), intent(inout), target :: partit + integer :: n, n_val + integer :: i, max_nb, nb, nini, nend + integer, allocatable :: blocklen(:), displace(:) + integer, allocatable :: blocklen_tmp(:), displace_tmp(:) + +#include "associate_part_def.h" +#include "associate_part_ass.h" + + if (npes <= 1) return + + ! Store nfbin for runtime checks in exchange routines + partit%nfbin_mpi = nfbin + + !================================================================ + ! Allocate MPI datatype arrays for spectral bin exchange + !================================================================ + allocate(partit%r_mpitype_nod3D_fbin(com_nod2D%rPEnum, 1:nfbin, 3)) ! nodes, 1-3 values + allocate(partit%s_mpitype_nod3D_fbin(com_nod2D%sPEnum, 1:nfbin, 3)) + allocate(partit%r_mpitype_elem2D_fbin(com_elem2D%rPEnum, 1:nfbin)) ! elems 2D small halo + allocate(partit%s_mpitype_elem2D_fbin(com_elem2D%sPEnum, 1:nfbin)) + allocate(partit%r_mpitype_elem2D_full_fbin(com_elem2D_full%rPEnum, 1:nfbin)) ! elems 2D full halo + allocate(partit%s_mpitype_elem2D_full_fbin(com_elem2D_full%sPEnum, 1:nfbin)) + allocate(partit%r_mpitype_elem3D_fbin(com_elem2D%rPEnum, 1:nfbin, 4)) ! elems 3D small halo, 1-4 values + allocate(partit%s_mpitype_elem3D_fbin(com_elem2D%sPEnum, 1:nfbin, 4)) + allocate(partit%r_mpitype_elem3D_full_fbin(com_elem2D_full%rPEnum, 1:nfbin, 4)) ! elems 3D full halo + allocate(partit%s_mpitype_elem3D_full_fbin(com_elem2D_full%sPEnum, 1:nfbin, 4)) + + !================================================================ + ! Build MPI Data types for element fields (small halo) + !================================================================ + max_nb = max( & + maxval(com_elem2D%rptr(2:com_elem2D%rPEnum+1) - com_elem2D%rptr(1:com_elem2D%rPEnum)), & + maxval(com_elem2D%sptr(2:com_elem2D%sPEnum+1) - com_elem2D%sptr(1:com_elem2D%sPEnum)), & + maxval(com_elem2D_full%rptr(2:com_elem2D_full%rPEnum+1) - com_elem2D_full%rptr(1:com_elem2D_full%rPEnum)), & + maxval(com_elem2D_full%sptr(2:com_elem2D_full%sPEnum+1) - com_elem2D_full%sptr(1:com_elem2D_full%sPEnum))) + + allocate(displace(max_nb), blocklen(max_nb)) + allocate(displace_tmp(max_nb), blocklen_tmp(max_nb)) + + ! --- Receive types for elements (small halo) --- + do n=1,com_elem2D%rPEnum + nb = 1 + nini = com_elem2D%rptr(n) + nend = com_elem2D%rptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_elem2D%rlist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_elem2D%rlist(i) /= com_elem2D%rlist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_elem2D%rlist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! 2D fbin types: one for each spectral bin + DO i=1,nfbin + blocklen_tmp(1:nb) = blocklen(1:nb) + displace_tmp(1:nb) = displace(1:nb)*nfbin + (i-1) + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%r_mpitype_elem2D_fbin(n,i), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_elem2D_fbin(n,i), partit%MPIerr) + ENDDO + ! 3D fbin types: one for each spectral bin and n_val + DO i=1,nfbin + DO n_val=1,4 + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val + displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%r_mpitype_elem3D_fbin(n,i,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_elem3D_fbin(n,i,n_val), partit%MPIerr) + ENDDO + ENDDO + enddo + + ! --- Send types for elements (small halo) --- + do n=1,com_elem2D%sPEnum + nb = 1 + nini = com_elem2D%sptr(n) + nend = com_elem2D%sptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_elem2D%slist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_elem2D%slist(i) /= com_elem2D%slist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_elem2D%slist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! 2D fbin types: one for each spectral bin + DO i=1,nfbin + blocklen_tmp(1:nb) = blocklen(1:nb) + displace_tmp(1:nb) = displace(1:nb)*nfbin + (i-1) + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%s_mpitype_elem2D_fbin(n,i), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_elem2D_fbin(n,i), partit%MPIerr) + ENDDO + ! 3D fbin types: one for each spectral bin and n_val + DO i=1,nfbin + DO n_val=1,4 + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val + displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%s_mpitype_elem3D_fbin(n,i,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_elem3D_fbin(n,i,n_val), partit%MPIerr) + ENDDO + ENDDO + enddo + + !================================================================ + ! Build MPI Data types for element fields (full halo) + !================================================================ + ! --- Receive types for elements (full halo) --- + do n=1,com_elem2D_full%rPEnum + nb = 1 + nini = com_elem2D_full%rptr(n) + nend = com_elem2D_full%rptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_elem2D_full%rlist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_elem2D_full%rlist(i) /= com_elem2D_full%rlist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_elem2D_full%rlist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! 2D fbin types: one for each spectral bin + DO i=1,nfbin + blocklen_tmp(1:nb) = blocklen(1:nb) + displace_tmp(1:nb) = displace(1:nb)*nfbin + (i-1) + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%r_mpitype_elem2D_full_fbin(n,i), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_elem2D_full_fbin(n,i), partit%MPIerr) + ENDDO + ! 3D fbin types: one for each spectral bin and n_val + DO i=1,nfbin + DO n_val=1,4 + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val + displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%r_mpitype_elem3D_full_fbin(n,i,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_elem3D_full_fbin(n,i,n_val), partit%MPIerr) + ENDDO + ENDDO + enddo + + ! --- Send types for elements (full halo) --- + do n=1,com_elem2D_full%sPEnum + nb = 1 + nini = com_elem2D_full%sptr(n) + nend = com_elem2D_full%sptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_elem2D_full%slist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_elem2D_full%slist(i) /= com_elem2D_full%slist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_elem2D_full%slist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! 2D fbin types: one for each spectral bin + DO i=1,nfbin + blocklen_tmp(1:nb) = blocklen(1:nb) + displace_tmp(1:nb) = displace(1:nb)*nfbin + (i-1) + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%s_mpitype_elem2D_full_fbin(n,i), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_elem2D_full_fbin(n,i), partit%MPIerr) + ENDDO + ! 3D fbin types: one for each spectral bin and n_val + DO i=1,nfbin + DO n_val=1,4 + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val + displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%s_mpitype_elem3D_full_fbin(n,i,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_elem3D_full_fbin(n,i,n_val), partit%MPIerr) + ENDDO + ENDDO + enddo + + deallocate(displace, blocklen) + deallocate(displace_tmp, blocklen_tmp) + + !================================================================ + ! Build MPI Data types for nodal fields + !================================================================ + max_nb = max(maxval(com_nod2D%rptr(2:com_nod2D%rPEnum+1) - com_nod2D%rptr(1:com_nod2D%rPEnum)), & + maxval(com_nod2D%sptr(2:com_nod2D%sPEnum+1) - com_nod2D%sptr(1:com_nod2D%sPEnum))) + + allocate(displace(max_nb), blocklen(max_nb)) + allocate(displace_tmp(max_nb), blocklen_tmp(max_nb)) + + ! --- Receive types for nodes --- + do n=1,com_nod2D%rPEnum + nb = 1 + nini = com_nod2D%rptr(n) + nend = com_nod2D%rptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_nod2D%rlist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_nod2D%rlist(i) /= com_nod2D%rlist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_nod2D%rlist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + DO i=1,nfbin + DO n_val=1,3 + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val + displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%r_mpitype_nod3D_fbin(n,i,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_nod3D_fbin(n,i,n_val), partit%MPIerr) + ENDDO + ENDDO + enddo + + ! --- Send types for nodes --- + do n=1,com_nod2D%sPEnum + nb = 1 + nini = com_nod2D%sptr(n) + nend = com_nod2D%sptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_nod2D%slist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_nod2D%slist(i) /= com_nod2D%slist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_nod2D%slist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + DO i=1,nfbin + DO n_val=1,3 + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val + displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%s_mpitype_nod3D_fbin(n,i,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_nod3D_fbin(n,i,n_val), partit%MPIerr) + ENDDO + ENDDO + enddo + + deallocate(blocklen, displace) + deallocate(blocklen_tmp, displace_tmp) + +end subroutine init_mpi_types_fbin !=================================================================== subroutine init_gatherLists(partit) USE MOD_PARTIT From da203b4f9599ee835e57a49b9912ab4e421071a7 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 20 Mar 2026 16:05:18 +0100 Subject: [PATCH 22/63] fix small bug --- src/gen_modules_dist2coast.F90 | 12 ++++++++---- src/gen_modules_read_NetCDF.F90 | 3 ++- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/src/gen_modules_dist2coast.F90 b/src/gen_modules_dist2coast.F90 index 45ba7e180..3e95c425e 100644 --- a/src/gen_modules_dist2coast.F90 +++ b/src/gen_modules_dist2coast.F90 @@ -37,7 +37,7 @@ subroutine compute_dist2coast(dist, mesh, partit, modein) real(kind=WP) :: bin_dlon=10.0*rad, bin_dlat=10.0*rad integer , allocatable :: bin_head(:,:), bin_next(:) integer :: bin_nlon, bin_nlat - integer :: elem, node, elnodes(3) + integer :: elem, node, elnodes(3), node_size, elem_size real(kind=WP) :: lon_e, lat_e, lonr(3), xmin character(len=10) :: mode real(kind=WP) :: t0, t1, t2, t3 @@ -85,12 +85,14 @@ subroutine compute_dist2coast(dist, mesh, partit, modein) write(*,*) '____________________________________________________________________' print *, achar(27)//'[0m' write(*,*) - end if + end if + else + elem_size = size(dist) end if !___________________________________________________________________ if (flag_debug .and. partit%mype==0) print *, achar(27)//'[37m'//' --> call nearest_coast_dist'//achar(27)//'[0m' - do elem = 1, partit%myDim_elem2D + do elem = 1, elem_size elnodes = mesh%elem2d_nodes(:,elem) lat_e = sum(mesh%geo_coord_nod2D(2,elnodes))/3.0_WP @@ -124,11 +126,13 @@ subroutine compute_dist2coast(dist, mesh, partit, modein) print *, achar(27)//'[0m' write(*,*) end if + else + node_size = size(dist) end if !___________________________________________________________________ if (flag_debug .and. partit%mype==0) print *, achar(27)//'[37m'//' --> call nearest_coast_dist'//achar(27)//'[0m' - do node = 1, partit%myDim_nod2D + do node = 1, node_size lat_e = mesh%geo_coord_nod2D(2,node) ! convert in degree ! do properly computing of elem centroid lon position across diff --git a/src/gen_modules_read_NetCDF.F90 b/src/gen_modules_read_NetCDF.F90 index a467084c4..fdfbd0e18 100755 --- a/src/gen_modules_read_NetCDF.F90 +++ b/src/gen_modules_read_NetCDF.F90 @@ -261,7 +261,8 @@ subroutine read_other_NetCDF(file, vari, itime, model_2Darray, check_dummy, do_o ! create interpolation coordinates ! do data interpolation on vertices if (do_onvert) then - num=myDim_nod2d+eDim_nod2d + !PSnum=myDim_nod2d+eDim_nod2d + num=size(model_2Darray,1) allocate(temp_x(num), temp_y(num)) do n=1, num temp_x(n)=geo_coord_nod2d(1,n)/rad From d743c55dbd0e72a0ed2529cdecca6d8be2a50d92 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 24 Mar 2026 10:25:35 +0100 Subject: [PATCH 23/63] add gather over spectral domain --- src/io_meandata.F90 | 106 ++++++++++++++++++++++++++++++-------------- 1 file changed, 73 insertions(+), 33 deletions(-) diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index b88e0a98a..a757d7044 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -53,6 +53,7 @@ module io_MEANDATA character :: freq_unit='m' logical :: is_in_use=.false. logical :: is_elem_based = .false. + logical :: is_fbin_based = .false. logical :: flip class(data_strategy_type), allocatable :: data_strategy integer :: comm @@ -1316,7 +1317,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) ! IDEMIX2 mixing Internal-Wave-Energy diagnostics CASE ('IDEMIX2 ') if (mod(mix_scheme_nmb,10)==7) then - call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw' , 'internal wave energy ' , 'm^2/s^2', iwe2_E_iw(taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw' , 'internal wave energy ' , 'm^2/s^2', iwe2_E_iw(iwe2_taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_dt' , 'Eiw total production ' , 'm^2/s^3', iwe2_E_iw_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_diss', 'Eiw production from dissipation', 'm^2/s^3', iwe2_E_iw_diss( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_hdif', 'Eiw production from hor. diff.' , 'm^2/s^3', iwe2_E_iw_hdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1330,33 +1331,45 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_fsrf' , 'surface forcing' , 'm^3/s^3', iwe2_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (idemix2_enable_M2) then - call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_alphac', 'M2 energy dissipation' , 'none' , iwe2_alpha_M2_c(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_tau' , 'M2 dissipation timescale' , 's' , iwe2_M2_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_forc' , 'M2 forcing' , 's' , iwe2_fM2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_w' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_u' , 'M2 zonal propag.' , 'm/s' , iwe2_M2_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_v' , 'M2 merid. propag.' , 'm/s' , iwe2_M2_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_E' , 'M2 wave energy' , 'm^2/s^2' , iwe2_E_M2(taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_Ediv' , 'M2 wave energy divergence' , 'm^2/s^2' , iwe2_Ediv_M2(taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_Estrct', 'M2 structure function energy' , 'm^2/s^2' , iwe2_E_struct_M2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_alphac' , 'M2 energy dissipation' , 'none' , iwe2_alpha_M2_c(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_tau' , 'M2 dissipation timescale' , 's' , iwe2_M2_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_forc' , 'M2 forcing' , 'm^3/s^3/rad', iwe2_fM2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_w' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_u' , 'M2 zonal propag.' , 'm/s' , iwe2_M2_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_v' , 'M2 merid. propag.' , 'm/s' , iwe2_M2_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2' , 'M2 wave energy' , 'm^2/s^2' , iwe2_E_M2( iwe2_taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divh' , 'EM2 horiz wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divh(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divs' , 'EM2 crss spctr wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divs(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Em2_strct' , 'EM2 structure function energy' , 'm^2/s^2' , iwe2_E_M2_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_dt' , 'EM2 total tendency' , 'm^2/s^3' , iwe2_E_M2_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advh' , 'EM2 horizontal advection' , 'm^2/s^3' , iwe2_E_M2_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advs' , 'EM2 spectral advection' , 'm^2/s^3' , iwe2_E_M2_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_diss' , 'EM2 dissipation' , 'm^2/s^3' , iwe2_E_M2_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_forc' , 'EM2 forcing tendency' , 'm^2/s^3' , iwe2_E_M2_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) end if if (idemix2_enable_niw) then - call def_stream( nod2d , myDim_nod2D , 'iwe2_niw_omega', 'niw frequency' , '1/s' , iwe2_omega_niw(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream( nod2d , myDim_nod2D , 'iwe2_niw_tau' , 'niw dissipation timescale' , 's' , iwe2_niw_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_forc' , 'niw forcing' , 's' , iwe2_fniw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_w' , 'niw cross. spectr. propag.' , 'rad/s' , iwe2_niw_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_u' , 'niw zonal propag.' , 'm/s' , iwe2_niw_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_v' , 'niw merid. propag.' , 'm/s' , iwe2_niw_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_E' , 'niw wave energy' , 'm^2/s^2', iwe2_E_niw(taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_Ediv' , 'niw wave energy divergence' , 'm^2/s^2', iwe2_Ediv_niw(taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_Estrct','niw structure function energy' , 'm^2/s^2',iwe2_E_struct_niw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_niw_omega' , 'niw frequency' , '1/s' , iwe2_omega_niw(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_niw_tau' , 'niw dissipation timescale' , 's' , iwe2_niw_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_forc' , 'niw forcing' , 'm^3/s^3/rad', iwe2_fniw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_w' , 'niw cross. spectr. propag.' , 'rad/s' , iwe2_niw_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_u' , 'niw zonal propag.' , 'm/s' , iwe2_niw_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_v' , 'niw merid. propag.' , 'm/s' , iwe2_niw_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw' , 'niw wave energy' , 'm^2/s^2' , iwe2_E_niw( iwe2_taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divh' , 'Eniw horz wave energy diverg.' , 'm^2/s^2' , iwe2_E_niw_divh(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divs' , 'Eniw crss spctr wave energy diverg.', 'm^2/s^2' , iwe2_E_niw_divs(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eniw_strct' , 'Eniw structure function energy' , 'm^2/s^2' , iwe2_E_niw_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_dt' , 'Eniw total tendency' , 'm^2/s^3' , iwe2_E_niw_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advh' , 'Eniw horizontal advection' , 'm^2/s^3' , iwe2_E_niw_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advs' , 'Eniw spectral advection' , 'm^2/s^3' , iwe2_E_niw_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_diss' , 'Eniw dissipation' , 'm^2/s^3' , iwe2_E_niw_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_forc' , 'Eniw forcing tendency' , 'm^2/s^3' , iwe2_E_niw_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) end if if (idemix2_enable_M2 .or. idemix2_enable_niw) then - call def_stream(nod2d, myDim_nod2D, 'topo_dist2c', 'distance from coast', 'm', iwe2_topo_dist, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream(nod2d, myDim_nod2D, 'topo_dist2c', 'distance from coast' , 'm', iwe2_topo_dist, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream(nod2d, myDim_nod2D, 'topo_hrms' , 'Root Mean Square Topographic Heigh', 'm', iwe2_topo_hrms, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream(nod2d, myDim_nod2D, 'topo_hlam' , 'Topographic Wavelength', 'm', iwe2_topo_hrms, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream(nod2d, myDim_nod2D, 'topo_hlam' , 'Topographic Wavelength' , 'm', iwe2_topo_hrms, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) end if end if @@ -2080,16 +2093,25 @@ subroutine write_mean(entry, entry_index) end if !_______________________________________________________________________ - ! loop over vertical layers --> do gather 3d variables layerwise in 2d - ! slices + ! loop over vertical layers or spectral bins --> do gather 3d variables layerwise in 2d slices do lev=1, size1 !___________________________________________________________________ - ! local output variables are gahtered in 2d shaped entry%aux_r8 + ! local output variables are gathered in 2d shaped entry%aux_r8 ! either for vertices or elements - if(.not. entry%is_elem_based) then - call gather_nod2D (entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm, entry%p_partit) + if (entry%is_fbin_based) then + ! Spectral bin arrays: gather bin by bin (same pattern as vertical levels) + if(.not. entry%is_elem_based) then + call gather_nod2D (entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm, entry%p_partit) + else + call gather_elem2D(entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm, entry%p_partit) + end if else - call gather_elem2D(entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm, entry%p_partit) + ! Regular vertical-level arrays: gather layer by layer + if(.not. entry%is_elem_based) then + call gather_nod2D (entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm, entry%p_partit) + else + call gather_elem2D(entry%local_values_r8_copy(lev,1:size(entry%local_values_r8_copy,dim=2)), entry%aux_r8, entry%root_rank, tag, entry%comm, entry%p_partit) + end if end if !___________________________________________________________________ @@ -2116,17 +2138,26 @@ subroutine write_mean(entry, entry_index) end if !_______________________________________________________________________ - ! loop over vertical layers --> do gather 3d variables layerwise in 2d - ! slices + ! loop over vertical layers or spectral bins --> do gather 3d variables layerwise in 2d slices do lev=1, size1 !PS if (entry%p_partit%mype==entry%root_rank) t0=MPI_Wtime() !___________________________________________________________________ - ! local output variables are gahtered in 2d shaped entry%aux_r8 + ! local output variables are gathered in 2d shaped entry%aux_r4 ! either for vertices or elements - if(.not. entry%is_elem_based) then - call gather_real4_nod2D (entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm, entry%p_partit) + if (entry%is_fbin_based) then + ! Spectral bin arrays: gather bin by bin (same pattern as vertical levels) + if(.not. entry%is_elem_based) then + call gather_real4_nod2D (entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm, entry%p_partit) + else + call gather_real4_elem2D(entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm, entry%p_partit) + end if else - call gather_real4_elem2D(entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm, entry%p_partit) + ! Regular vertical-level arrays: gather layer by layer + if(.not. entry%is_elem_based) then + call gather_real4_nod2D (entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm, entry%p_partit) + else + call gather_real4_elem2D(entry%local_values_r4_copy(lev,1:size(entry%local_values_r4_copy,dim=2)), entry%aux_r4, entry%root_rank, tag, entry%comm, entry%p_partit) + end if end if !___________________________________________________________________ @@ -2637,6 +2668,7 @@ subroutine def_stream3D(glsize, lcsize, name, description, units, data, freq, fr use mod_mesh USE MOD_PARTIT USE MOD_PARSUP + use g_cvmix_idemix2, only: idemix2_nfbin implicit none type(t_partit), intent(inout), target :: partit integer, intent(in) :: glsize(2), lcsize(2) @@ -2708,6 +2740,14 @@ subroutine def_stream3D(glsize, lcsize, name, description, units, data, freq, fr entry%dimname(1)=mesh_dimname_from_dimsize(glsize(1), partit, mesh) !2D! mesh_dimname_from_dimsize(glsize, mesh) entry%dimname(2)=mesh_dimname_from_dimsize(glsize(2), partit, mesh) !2D! entry%dimname(2)='unknown' + + ! Check if this is a spectral bin array based on dimension size + if (glsize(1) == idemix2_nfbin) then + entry%is_fbin_based = .true. + else + entry%is_fbin_based = .false. + end if + ! non dimension specific call def_stream_after_dimension_specific(entry, name, description, units, freq, freq_unit, accuracy, partit, mesh, long_description) From ca56b2d26c43506a9bf7b628f63bf1129f1b18b6 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 24 Mar 2026 10:27:00 +0100 Subject: [PATCH 24/63] try to debug idemix implementation --- src/cvmix_driver/cvmix_idemix2.F90 | 318 +++-- .../gen_modules_cvmix_idemix2.F90 | 1026 ++++++++++------- src/cvmix_driver/gen_modules_cvmix_tke.F90 | 4 +- 3 files changed, 803 insertions(+), 545 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index c006ad2b8..002c8a313 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -365,7 +365,7 @@ end subroutine compute_param subroutine compute_compart_groupvel( & nfbin , & coriolis , & - grady_coriol , & + coriol_grady , & coslat , & cn , & cn_gradx , & @@ -383,7 +383,7 @@ subroutine compute_compart_groupvel( & type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef integer , intent(in) :: nfbin real(cvmix_r8) , intent(in) :: coriolis , & - grady_coriol , & + coriol_grady , & coslat , & cn , & cn_gradx , & @@ -398,7 +398,7 @@ subroutine compute_compart_groupvel( & !___Local___________________________________________________________________ integer :: di, fbin_i real(cvmix_r8) :: fxa, intNz, cstar, & - kdot_x, kdot_y, cg + kdot_x, kdot_y, cg_compart type(idemix2_type), pointer :: idemix2_const_in ! do pointer into save variable or into user defined input variable @@ -409,7 +409,7 @@ subroutine compute_compart_groupvel( & !___________________________________________________________________________ ! compute group velocity of M2 internal tidal waves - cg=sqrt( max(0d0, omega_compart**2 - coriolis**2 ) ) * cn/omega_compart + cg_compart=sqrt( max(0d0, omega_compart**2 - coriolis**2 ) ) * cn/omega_compart !___________________________________________________________________________ ! eq4 in EdenOlbers2014: @@ -424,27 +424,25 @@ subroutine compute_compart_groupvel( & ! kdot_M2 = (kdot_x_M2, kdot_y_M2) ! compute: sqrt(omega²-f²) - fxa = max(1d-10,omega_compart**2 - coriolis**2 ) + fxa = max(1d-10, omega_compart**2 - coriolis**2 ) ! 1st part coriolis contribution ! compute: c_n/omega/sqrt(omega²-f²)) * f * grad_f - kdot_y = -cn/sqrt(fxa)*coriolis/omega_compart*grady_coriol - ! | - ! +-> this minus sign is from the -cos(phi) - ! ! 2nd part topographic/buoyancy driven contribution ! compute: sqrt(omega²-f²)/omega * grad_cn - kdot_y = kdot_y - sqrt(fxa)/omega_compart*cn_grady - ! | - ! +-> this minus sign is from the -cos(phi) - kdot_x = sqrt(fxa)/omega_compart*cn_gradx + kdot_y = -cn/sqrt(fxa)*coriolis/omega_compart*coriol_grady & + -sqrt(fxa)/omega_compart*cn_grady + ! | + ! +-> this minus sign is from the -cos(phi) + ! + kdot_x = sqrt(fxa)/omega_compart*cn_gradx !___________________________________________________________________________ !zonal, meridional and cross-spectral component of M2 internal tide group velocity do fbin_i=2,nfbin-1 - u_compart(fbin_i) = cg*cos( phit(fbin_i) ) - v_compart(fbin_i) = cg*sin( phit(fbin_i) ) * coslat + u_compart(fbin_i) = cg_compart*cos( phit(fbin_i) ) + v_compart(fbin_i) = cg_compart*sin( phit(fbin_i) ) * coslat w_compart(fbin_i) = (kdot_y*cos(phiu(fbin_i)) + kdot_x*sin(phiu(fbin_i)) ) end do @@ -482,7 +480,7 @@ subroutine compute_compart_interact_tscale( & !___Output__________________________________________________________________ real(cvmix_r8) , intent(out) :: tau_compart !___Local___________________________________________________________________ - real(cvmix_r8) :: fxb, fxc, N0 + real(cvmix_r8) :: fxb, fxc, N0, small=1.0e-12_cvmix_r8 type(idemix2_type), pointer :: idemix2_const_in ! do pointer into save variable or into user defined input variable @@ -495,10 +493,10 @@ subroutine compute_compart_interact_tscale( & ! compute NIW Dissipation Timescale if (zbottom>0) then N0=cn*cvmix_PI/zbottom - if ( N0> abs(coriolis) .and. omega_compart> abs(coriolis) ) then - fxc = topo_hrms**2.0 * 2.0*cvmix_PI/(1d-12+topo_hlam) + if ( N0 > abs(coriolis) .and. omega_compart > abs(coriolis) ) then + fxc = topo_hrms**2.0 * 2.0*cvmix_PI/(small+topo_hlam) fxb = 0.5* N0*( (omega_compart**2.0 + coriolis**2.0)/omega_compart**2.0 )**2.0 & - *(omega_compart**2.0 - coriolis**2.0)**0.5/omega_compart + *(omega_compart**2.0 - coriolis**2.0)**0.5/omega_compart tau_compart = min(0.5/dtime, fxc*fxb/zbottom) endif endif @@ -578,10 +576,10 @@ subroutine compute_vert_struct_fct( & nlev , & dzw , & coriolis , & - omega_M2 , & - omega_niw , & cn , & Nsqr , & + omega_M2 , & + omega_niw , & E_struct_M2 , & E_struct_niw , & idemix2_const_userdef & @@ -590,20 +588,17 @@ subroutine compute_vert_struct_fct( & type(idemix2_type), intent(in) , optional, target :: idemix2_const_userdef integer , intent(in) :: nlev real(cvmix_r8) , intent(in) :: dzw(:) - real(cvmix_r8) , intent(in) :: coriolis , & - omega_M2 , & - omega_niw , & - cn + real(cvmix_r8) , intent(in) :: coriolis, cn real(cvmix_r8) , intent(in) :: Nsqr(:) - + real(cvmix_r8) , intent(in), optional :: omega_M2, omega_niw + !___Output__________________________________________________________________ - real(cvmix_r8) , intent(inout), optional :: E_struct_M2(:) , & - E_struct_niw(:) + real(cvmix_r8) , intent(inout), optional :: E_struct_M2(:), E_struct_niw(:) !___Local___________________________________________________________________ integer :: di - real(cvmix_r8) :: fxa, norm, phin_dim1 - real(cvmix_r8), dimension(:) :: Nzw(nlev), phin(nlev), dphindz(nlev) + real(cvmix_r8) :: fxa, norm, phin_dim1, small=1.0e-12_cvmix_r8, mask + real(cvmix_r8), dimension(:) :: Nzw(nlev), phin(nlev), dphindz(nlev), dzt(nlev) type(idemix2_type), pointer :: idemix2_const_in ! do pointer into save variable or into user defined input variable @@ -615,33 +610,44 @@ subroutine compute_vert_struct_fct( & !___________________________________________________________________________ ! calculate int_(-h)^z N dz phin(:) = 0.0_cvmix_r8 - Nzw(1) = max(0.0_cvmix_r8, (Nsqr(1)+Nsqr(2)) * 0.5_cvmix_r8) - phin(1) = sqrt(Nzw(1))*dzw(1) + Nzw(1) = max(small, Nsqr(1)) + dzt(1) = dzw(1) * 0.5_cvmix_r8 + phin(1) = sqrt(Nzw(1))*dzt(1) phin_dim1 = phin(1) - fxa = phin(1)/cn + fxa = phin(1)/(small+cn) dphindz(1) = sin(fxa)/Nzw(1)**0.25_cvmix_r8 phin(1) = cos(fxa)*Nzw(1)**0.25_cvmix_r8 - do di = 2, nlev + do di = 2, nlev-1 ! interpolate N² onto tracer levels and cumulative integrate - Nzw(di) = max(0.0_cvmix_r8, (Nsqr(di)+Nsqr(di+1)) * 0.5_cvmix_r8) + Nzw(di) = max(small, Nsqr(di)) + dzt(di) = (dzw(di-1)+dzw(di)) * 0.5_cvmix_r8 ! calculate int_(-h)^z N dz - phin(di) = phin_dim1 + sqrt(Nzw(di))*dzw(di) + phin(di) = phin_dim1 + sqrt(Nzw(di))*dzt(di) phin_dim1 = phin(di) ! calculate phi_n = cos( int_(-h)^z N/c_n dz )*N^0.5 ! and dphi_n/dz = sin( int_(-h)^z N/c_n dz )/N^0.5 - fxa = phin(di)/cn + fxa = phin(di)/(small+cn) dphindz(di) = sin(fxa)/Nzw(di)**0.25_cvmix_r8 phin(di) = cos(fxa)*Nzw(di)**0.25_cvmix_r8 enddo + di = nlev + ! interpolate N² onto tracer levels and cumulative integrate + Nzw(di) = max(small, Nsqr(di)) + dzt(di) = dzw(di-1) * 0.5_cvmix_r8 + phin(di) = phin_dim1 + sqrt(Nzw(di))*dzt(di) + fxa = phin(di)/(small+cn) + dphindz(di) = sin(fxa)/Nzw(di)**0.25_cvmix_r8 + phin(di) = cos(fxa)*Nzw(di)**0.25_cvmix_r8 + ! normalisation with int_(-h)^0 dz (dphi_n/dz )^2 /N^2 = 1 norm = 0.0_cvmix_r8 do di = 1,nlev - norm = norm + dphindz(di)**2/Nzw(di)*dzw(di) + norm = norm + dphindz(di)**2/Nzw(di)*dzt(di) enddo do di = 1,nlev if (norm>0.0_cvmix_r8) dphindz(di) = dphindz(di)/norm**0.5 @@ -650,25 +656,82 @@ subroutine compute_vert_struct_fct( & ! normalisation with int_(-h)^0 dz phi_n^2 /c_n^2 = 1 norm=0.0_cvmix_r8 do di = 1,nlev - norm = norm + phin(di)**2/(cn**2)*dzw(di) + norm = norm + phin(di)**2/(small+cn**2)*dzt(di) enddo do di = 1,nlev if (norm>0.0_cvmix_r8) phin(di) = phin(di)/norm**0.5 enddo if (present(E_struct_M2)) then + ! ATTENTION (this is not part of pyOM2): + ! M2 internal waves can only propagate where their frequency + ! (ω_M2 ≈ 1.405×10⁻⁴ s⁻¹) exceeds the local Coriolis parameter (f = 2Ω sin φ). + ! (Poleward of the critical latitude (~74.5°), where |f| > ω_M2, the dispersion + ! (relation becomes invalid and the vertical structure function E_struct_M2 turns + ! (negative—physically meaningless for wave energy. The condition + ! (abs(coriolis_t) < omega_M2 ensures M2 energy is only computed in regions where + ! (these waves can exist as propagating solutions. Without this check, high-latitude + ! (grid points produce unphysical negative energies that contaminate the solution and + ! (violate energy conservation principles + if ( abs(coriolis) < omega_M2 ) then + mask = 1.0_cvmix_r8 + else + mask = 0.0_cvmix_r8 + end if + ! calculate structure function for energy: ! E(z) = E_0 0.5( (1+f^2/om^2) phi_n^2/c_n^2 + (1-f^2/om^2) (dphi_n/dz)^2/N^2) do di = 1,nlev - E_struct_M2(di) = 0.5_cvmix_r8*( (1.0_cvmix_r8+coriolis**2/omega_M2**2)*phin( di)**2 /(cn**2) & - +(1.0_cvmix_r8-coriolis**2/omega_M2**2)*dphindz(di)**2 /Nzw(di) ) + E_struct_M2(di) = mask * 0.5_cvmix_r8*( (1.0_cvmix_r8+coriolis**2/omega_M2**2)*phin( di)**2 /(small+cn**2) & + +(1.0_cvmix_r8-coriolis**2/omega_M2**2)*dphindz(di)**2 /Nzw(di) ) + + if (E_struct_M2(di)/=E_struct_M2(di) .or. E_struct_M2(di)<0.0_cvmix_r8) then + write(*,*) " }-))))°> found negative/NaN E_struct_M2", E_struct_M2(di) + write(*,*) "di = ", di + write(*,*) "mask = ", mask + write(*,*) "coriolis = ", coriolis + write(*,*) "omega_M2 = ", omega_M2 + write(*,*) "phin( di) = ", phin( di) + write(*,*) "dphindz(di) = ", dphindz(di) + write(*,*) "Nzw(di) = ", Nzw(di) + write(*,*) "cn = ", cn + write(*,*) "coriolis**2/omega_M2**2 = ", coriolis**2/omega_M2**2 + write(*,*) "(1.0_cvmix_r8+coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8+coriolis**2/omega_M2**2) + write(*,*) "(1.0_cvmix_r8-coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8-coriolis**2/omega_M2**2) + end if + enddo endif if (present(E_struct_niw)) then + ! ATTENTION (this is not part of pyOM2): + ! here its a safety switch in theory it should be imposed by definition that + ! abs(coriolis) < omega_niw + if ( abs(coriolis) < omega_niw ) then + mask = 1.0_cvmix_r8 + else + mask = 0.0_cvmix_r8 + end if + + ! calculate structure function for energy: + ! E(z) = E_0 0.5( (1+f^2/om^2) phi_n^2/c_n^2 + (1-f^2/om^2) (dphi_n/dz)^2/N^2) do di = 1,nlev - E_struct_niw(di) = 0.5_cvmix_r8*( (1.0_cvmix_r8+coriolis**2/omega_niw**2)*phin( di)**2/(cn**2) & - +(1.0_cvmix_r8-coriolis**2/omega_niw**2)*dphindz(di)**2/Nzw(di) ) + E_struct_niw(di) = mask * 0.5_cvmix_r8*( (1.0_cvmix_r8+coriolis**2/(small+omega_niw**2))*phin( di)**2/(small+cn**2) & + +(1.0_cvmix_r8-coriolis**2/(small+omega_niw**2))*dphindz(di)**2/Nzw(di) ) + + if (E_struct_niw(di)/=E_struct_niw(di) .or. E_struct_niw(di)<0.0_cvmix_r8) then + write(*,*) " }-))))°> found negative/NaN E_struct_niw", E_struct_niw(di) + write(*,*) "di = ", di + write(*,*) "mask = ", mask + write(*,*) "coriolis = ", coriolis + write(*,*) "omega_niw = ", omega_niw + write(*,*) "phin( di) = ", phin( di) + write(*,*) "dphindz(di) = ", dphindz(di) + write(*,*) "Nzw(di) = ", Nzw(di) + write(*,*) "cn = ", cn + write(*,*) "(1.0_cvmix_r8+coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8+coriolis**2/omega_M2**2) + write(*,*) "(1.0_cvmix_r8-coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8-coriolis**2/omega_M2**2) + end if enddo endif @@ -691,9 +754,9 @@ subroutine compute_vdiff_vdiss_Eiw( & fbot , & Eiw_old , & Eiw_new , & + Eiw_diss , & Eiw_dt , & Eiw_vdif , & - Eiw_diss , & Eiw_srf , & Eiw_bot , & idemix2_const_userdef & @@ -711,11 +774,11 @@ subroutine compute_vdiff_vdiss_Eiw( & real(cvmix_r8) , intent(in), dimension(nlev) :: Eiw_old !___Output_________________________________________________________________ real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_new - real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_dt - real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_vdif real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_diss - real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_bot - real(cvmix_r8) , intent(out) :: Eiw_srf + real(cvmix_r8) , intent(out), optional :: Eiw_dt(nlev) + real(cvmix_r8) , intent(out), optional :: Eiw_vdif(nlev) + real(cvmix_r8) , intent(out), optional :: Eiw_bot(nlev) + real(cvmix_r8) , intent(out), optional :: Eiw_srf !___Local___________________________________________________________________ integer :: nz real(cvmix_r8), dimension(nlev) :: Eiw_max @@ -817,11 +880,14 @@ subroutine compute_vdiff_vdiss_Eiw( & ! | 0 0 0 a_k b_k | (Eiw_k) = (d_k) ! !___________________________________________________________________________ + nz = 1 + dzmid(nz) = dzw(nz)*0.5_cvmix_r8 + do nz = 2, nlev-1 c0_zmid(nz-1) = dt * idemix2_const_in%tau_v * (c0(nz)+c0(nz-1))*0.5_cvmix_r8 / dzw(nz-1) dzmid(nz) = (dzw(nz) + dzw(nz-1))*0.5_cvmix_r8 end do - dzmid(1) = dzw(1)*0.5_cvmix_r8 + nz=nlev dzmid(nz) = dzw(nz-1)*0.5_cvmix_r8 c0_zmid(nz-1) = idemix2_const_in%tau_v * (c0(nz)+c0(nz-1))*0.5_cvmix_r8 / dzw(nz-1) @@ -855,6 +921,7 @@ subroutine compute_vdiff_vdiss_Eiw( & b_tri(nz) = 1.0_cvmix_r8 & + dt * b_dif(nz) c_tri(nz) = -dt * c_dif(nz) + do nz=2,nlev-1 a_tri(nz) = -dt * a_dif(nz) b_tri(nz) = 1.0_cvmix_r8 & @@ -862,6 +929,7 @@ subroutine compute_vdiff_vdiss_Eiw( & + dt * alpha_c(nz)*Eiw_max(nz) c_tri(nz) = -dt * c_dif(nz) end do + nz = nlev a_tri(nz) = -dt * a_dif(nz) b_tri(nz) = 1.0_cvmix_r8 & @@ -870,15 +938,12 @@ subroutine compute_vdiff_vdiss_Eiw( & ! -- d --- do nz=1,nlev - ! bottom production term - Eiw_bot(nz) = fbot(nz)/dzmid(nz) ! --> fbot(nz) must be here an array overf depth since we want this ! in FESOM2 to operate on nodes, but our bottom topography is on elements ! so bottom forcing is injected over the water column where elements ! that participate to the scalar control volume turn into bottom over the ! vertical depth - - d_tri(nz) = Eiw_old(nz) + dt*fadd(nz) + dt*Eiw_bot(nz) + d_tri(nz) = Eiw_old(nz) + dt*fadd(nz) + dt*fbot(nz)/dzmid(nz) end do d_tri(1) = d_tri(1) + dt*fsrf/dzmid(1) @@ -887,32 +952,43 @@ subroutine compute_vdiff_vdiss_Eiw( & ! solve tridiagonal matrix call solve_tridiag(a_tri, b_tri, c_tri, d_tri, Eiw_new, nlev) - !___________________________________________________________________________ - ! diagnose implicite tendencies (only for diagnostics) - ! production of Eiw from vertical diffusion - nz = 1 - Eiw_vdif(nz) = - b_dif(nz)*Eiw_new(nz) + c_dif(nz)*Eiw_new(nz+1) - do nz=2,nlev-1 - Eiw_vdif(nz) = a_dif(nz)*Eiw_new(nz-1) - b_dif(nz)*Eiw_new(nz) + c_dif(nz)*Eiw_new(nz+1) - enddo - nz = nlev - Eiw_vdif(nz) = a_dif(nz)*Eiw_new(nz-1) - b_dif(nz)*Eiw_new(nz) - + do nz=1,nlev + ! if (any(Eiw_new<0.0_cvmix_r8)) then + if (Eiw_new(nz)/=Eiw_new(nz) .or. Eiw_new(nz)<0.0_cvmix_r8) then + write(*,*) " }-))))°> found negative/NaN Eiw_new in vdiff", Eiw_new(nz) + write(*,*) " Eiw_old(nz)=", Eiw_old(nz) + write(*,*) " fsrf =", fsrf + write(*,*) " fbot(nz) =", fbot(nz) + write(*,*) " alpha_c(nz)=", alpha_c(nz) + write(*,*) " Eiw_max(nz)=", Eiw_max(nz) + end if + end do + !___________________________________________________________________________ ! dissipation of E_iw Eiw_diss(:) = -alpha_c(: )*Eiw_max(:)*Eiw_new(:) -! write(*,*) "min/max Eiw_diss: ", minval(Eiw_diss), maxval(Eiw_diss) -! write(*,*) "min/max alpha_c : ", minval(alpha_c) , maxval(alpha_c) -! write(*,*) "min/max Eiw_max : ", minval(Eiw_max) , maxval(Eiw_max) -! write(*,*) "min/max Eiw_new : ", minval(Eiw_new) , maxval(Eiw_new) -! write(*,*) "min/max Eiw_old : ", minval(Eiw_old) , maxval(Eiw_old) -! write(*,*) + + !___________________________________________________________________________ + ! debuggin diagnostics: + ! production of Eiw from vertical diffusion + if (present(Eiw_vdif)) then + nz = 1 + Eiw_vdif(nz) = - b_dif(nz)*Eiw_new(nz) + c_dif(nz)*Eiw_new(nz+1) + do nz=2,nlev-1 + Eiw_vdif(nz) = a_dif(nz)*Eiw_new(nz-1) - b_dif(nz)*Eiw_new(nz) + c_dif(nz)*Eiw_new(nz+1) + enddo + nz = nlev + Eiw_vdif(nz) = a_dif(nz)*Eiw_new(nz-1) - b_dif(nz)*Eiw_new(nz) + end if ! total production of Eiw - Eiw_dt(:) = (Eiw_new(:) - Eiw_old(:))/dt + if (present(Eiw_dt )) Eiw_dt(:) = (Eiw_new(:) - Eiw_old(:))/dt ! surface production term - Eiw_srf = fsrf/dzmid(1) + if (present(Eiw_srf)) Eiw_srf = fsrf/dzmid(1) + + ! bottom production term + if (present(Eiw_bot)) Eiw_bot(:)= fbot(:)/dzmid(:) end subroutine compute_vdiff_vdiss_Eiw @@ -923,23 +999,23 @@ end subroutine compute_vdiff_vdiss_Eiw ! Integrate vertical part of internal wave energy idemix equation, solve vertical ! diffusion an dissipation implicitly over the water column. Keep in mind Eiw lives ! on the full depth levels -subroutine compute_Eiw_waveinteract( & - nlev , & - nfbin , & - dzw , & - dphi , & - dt , & - E_iw_old , & - E_iw_new , & - E_M2_old , & - E_M2_new , & - E_M2_struct , & - alpha_M2_c , & - tau_M2 , & - E_niw_old , & - E_niw_new , & - E_niw_struct , & - tau_niw , & +subroutine compute_Eiw_waveinteract( & + nlev , & + nfbin , & + dzw , & + dphi , & + dt , & + E_iw_old , & + E_iw_new , & + E_M2_old , & + E_M2_new , & + E_M2_struct , & + alpha_M2_c , & + tau_M2 , & + E_niw_old , & + E_niw_new , & + E_niw_struct , & + tau_niw , & idemix2_const_userdef & ) !___Input/Output____________________________________________________________ @@ -963,7 +1039,7 @@ subroutine compute_Eiw_waveinteract( & !___Local___________________________________________________________________ integer :: nz, fbini - real(cvmix_r8) :: vint, sint, aM2c, M2_diss, fmin + real(cvmix_r8) :: vint, sint, aM2c, M2_diss, fmin, vint_dbg, small=1.0e-12_cvmix_r8 type(idemix2_type), pointer :: idemix2_const_in ! do pointer into save variable or into user defined input variable @@ -993,18 +1069,45 @@ subroutine compute_Eiw_waveinteract( & ! update M2 energy: interaction of M2 and continuum aM2c = alpha_M2_c - aM2c = max(0.0_cvmix_r8,min(aM2c,1./max(1d-12,dt*vint))) ! FP 2020 - aM2c = max(0.0_cvmix_r8,min(aM2c,1./max(1d-12,dt*sint))) + aM2c = max(0.0_cvmix_r8,min(aM2c,1./max(small,dt*vint))) ! FP 2020 + aM2c = max(0.0_cvmix_r8,min(aM2c,1./max(small,dt*sint))) do fbini = 2, nfbin-1 - M2_diss = aM2c*vint*E_M2_old(fbini) - E_M2_new(fbini)= E_M2_new(fbini)-dt*M2_diss - - ! update E_iw from E_M2 + M2_diss = aM2c*vint*E_M2_old(fbini) + M2_diss = min(M2_diss, E_M2_new(fbini)/max(small,dt)) + E_M2_new(fbini) = E_M2_new(fbini)-dt*M2_diss + if (E_M2_new(fbini)/=E_M2_new(fbini) .or. E_M2_new(fbini)<0.0_cvmix_r8) then + write(*,*) " }-))))°> found negative/NaN E_M2_new from WWI M2", E_M2_new(fbini) + write(*,*) "fbini = ", fbini + write(*,*) "E_M2_new(fbini) = ", E_M2_new(fbini) + write(*,*) "E_M2_old(fbini) = ", E_M2_old(fbini) + write(*,*) "M2_diss = ", -dt*M2_diss + write(*,*) "aM2c = ", aM2c + write(*,*) "vint = ", vint + end if + end do + + ! update E_iw from E_M2 + do nz = 1, nlev fmin = min( 0.5_cvmix_r8/dt,aM2c*vint ) ! flux limiter - E_iw_new(fbini) = E_iw_new(fbini) & - + dt * tau_M2* sint * E_M2_struct(fbini) & - + dt * fmin * sint * E_M2_struct(fbini) + vint_dbg = E_iw_new(nz) + + E_iw_new(nz) = E_iw_new(nz) & + + dt * tau_M2* sint * E_M2_struct(nz) & + + dt * fmin * sint * E_M2_struct(nz) + + if (E_iw_new(nz)/=E_iw_new(nz) .or. E_iw_new(nz)<0.0_cvmix_r8) then + write(*,*) " }-))))°> found negative/NaN Eiw_new from WWI M2", E_iw_new(nz) + write(*,*) "nz = ", nz + write(*,*) "E_iw_new(nz) = ", E_iw_new(nz) + write(*,*) "E_iw_bf(nz) = ", vint_dbg + write(*,*) "E_M2_new = ", minval(E_M2_new), maxval(E_M2_new) + write(*,*) "E_M2_old = ", minval(E_M2_old), maxval(E_M2_old) + write(*,*) "tau_M2 = ", tau_M2 + write(*,*) "fmin = ", fmin + write(*,*) "sint = ", sint + write(*,*) "E_M2_struct(nz) = ", E_M2_struct(nz) + end if end do end if @@ -1017,13 +1120,20 @@ subroutine compute_Eiw_waveinteract( & end do ! update E_iw from E_niw - do fbini = 2, nfbin-1 - E_iw_new(fbini) = E_iw_new(fbini) & - + dt * tau_niw * sint * E_niw_struct(fbini) + do nz = 1, nlev + E_iw_new(nz) = E_iw_new(nz) & + + dt * tau_niw * sint * E_niw_struct(nz) + + if (E_iw_new(nz)/=E_iw_new(nz) .or. E_iw_new(nz)<0.0_cvmix_r8 ) then + write(*,*) " }-))))°> found negative/NaN Eiw_new from WWI NIW", E_iw_new(nz) + write(*,*) "nz = ", nz + write(*,*) "E_iw_new(nz) = ", E_iw_new(nz) + write(*,*) "tau_niw = ", tau_niw + write(*,*) "sint = ", sint + write(*,*) "E_niw_struct(nz)= ", E_niw_struct(nz) + end if end do end if - - end subroutine compute_Eiw_waveinteract diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index a507d256f..db7e0c5cc 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -43,6 +43,7 @@ module g_cvmix_idemix2 use g_read_other_NetCDF use g_dist2coast, only: compute_dist2coast use find_up_downwind_triangles_interface + use par_support_interfaces, only: init_mpi_types_fbin implicit none public @@ -130,15 +131,15 @@ module g_cvmix_idemix2 ! total global Energy input that should be conserved if 0.0 no conservation is applied real(kind=WP) :: idemix2_botforc_Etot = 0.0_WP ! units W - !___________________________________________________________________________ - ! enable lee wave source of internal wave energy in IDEMIX2, - ! Lee Wave Generation: Generated when mean flow encounters topography Energy - ! transfers from mean flow to internal waves - logical :: idemix2_enable_leew = .true. - - ! filelocation for idemix2 M2 forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) - character(MAX_PATH):: idemix2_leewforc_file = './idemix2_lee_forc_Eden.nc' - character(MAX_PATH):: idemix2_leewforc_vname= 'C_lee' +! !___________________________________________________________________________ +! ! enable lee wave source of internal wave energy in IDEMIX2, +! ! Lee Wave Generation: Generated when mean flow encounters topography Energy +! ! transfers from mean flow to internal waves +! logical :: idemix2_enable_leew = .false. +! +! ! filelocation for idemix2 M2 forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) +! character(MAX_PATH):: idemix2_leewforc_file = './idemix2_lee_forc_Eden.nc' +! character(MAX_PATH):: idemix2_leewforc_vname= 'C_lee' !___________________________________________________________________________ ! filelocation for idemix2 Root Mean Square Topographic Height forcing. Measures the roughness or @@ -160,7 +161,7 @@ module g_cvmix_idemix2 idemix2_botforc_Etot, & idemix2_enable_M2 , idemix2_M2forc_file , idemix2_M2forc_vname , idemix2_M2forc_zname, & idemix2_enable_niw , idemix2_niwforc_file , idemix2_niwforc_vname , idemix2_fniw_usage, & - idemix2_enable_leew, idemix2_leewforc_file, idemix2_leewforc_vname, & +! idemix2_enable_leew, idemix2_leewforc_file, idemix2_leewforc_vname, & idemix2_enable_bot , idemix2_botforc_file , idemix2_botforc_vname , & idemix2_hrmsforc_file, idemix2_hrmsforc_vname, & idemix2_hlamforc_file, idemix2_hlamforc_vname @@ -171,22 +172,24 @@ module g_cvmix_idemix2 ! M2 related global variables real(kind=WP) :: iwe2_omega_M2 - real(kind=WP), allocatable, dimension(:,:,:):: iwe2_M2_uv, iwe2_E_M2, iwe2_Ediv_M2 - real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_w, iwe2_fM2, iwe2_E_struct_M2 + real(kind=WP), allocatable, dimension(:,:,:):: iwe2_M2_uv, iwe2_E_M2, iwe2_E_M2_divh, iwe2_E_M2_divs + real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_w, iwe2_fM2, iwe2_E_M2_struct real(kind=WP), allocatable, dimension(:) :: w_M2_e, iwe2_alpha_M2_c, iwe2_M2_tau + real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_M2_dt, iwe2_E_M2_advh, iwe2_E_M2_advs, iwe2_E_M2_diss, iwe2_E_M2_forc ! niw related global variables real(kind=WP), allocatable, dimension(:) :: iwe2_omega_niw - real(kind=WP), allocatable, dimension(:,:,:):: iwe2_niw_uv, iwe2_E_niw, iwe2_Ediv_niw - real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_w, iwe2_fniw, iwe2_E_struct_niw + real(kind=WP), allocatable, dimension(:,:,:):: iwe2_niw_uv, iwe2_E_niw, iwe2_E_niw_divh, iwe2_E_niw_divs + real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_w, iwe2_fniw, iwe2_E_niw_struct real(kind=WP), allocatable, dimension(:) :: w_niw_e, iwe2_niw_tau + real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_niw_dt, iwe2_E_niw_advh, iwe2_E_niw_advs, iwe2_E_niw_diss, iwe2_E_niw_forc ! general idemix variable real(kind=WP), allocatable, dimension(:) :: iwe2_cn real(kind=WP), allocatable, dimension(:,:) :: iwe2_c0, iwe2_v0, iwe2_alpha_c ! forcing realted variables - real(kind=WP), allocatable, dimension(:) :: iwe2_topo_hrms, iwe2_topo_hlam, iwe2_topo_dist, iwe2_topo_shelf + real(kind=WP), allocatable, dimension(:) :: iwe2_topo_hrms, iwe2_topo_hlam, iwe2_topo_dist real(kind=WP), allocatable, dimension(:) :: iwe2_fbot_e, iwe2_fleew, iwe2_fsrf real(kind=WP), allocatable, dimension(:,:) :: iwe2_fbot @@ -204,7 +207,7 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:) :: iwe2_grady_coriol, aux real(kind=WP), allocatable, dimension(:,:,:):: iwe2_gradxy_e, iwe2_gradxy_n real(kind=WP), allocatable, dimension(:,: ):: iwe2_flx_uv, iwe2_flx_w, iwe2_div_hv - integer :: taum1=1, tau=2, taup1=3, otaum1 + integer :: iwe2_taum1=1, iwe2_tau=2, iwe2_taup1=3, otaum1 ! load variables from CVMix list type(cvmix_data_type) :: CVMix_vars @@ -240,13 +243,72 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) ' --> initialise IDEMIX2' write(*,*) end if - + !_______________________________________________________________________ + ! read cvmix namelist file + nmlfile ='namelist.cvmix' ! name of ocean namelist file + ! check if cvmix namelist file exists if not use default values + file_exist=.False. + inquire(file=trim(nmlfile),exist=file_exist) + if (file_exist) then + open(20,file=trim(nmlfile)) + read(20,nml=param_idemix2) + close(20) + else + write(*,*) ' could not find namelist.cvmix, will use default values !' + end if + + !_______________________________________________________________________ + if (mype==0) then + write(*,*) " IDEMIX2 parameters:" + write(*,*) " ├> idemix2_tau_v = ", idemix2_tau_v + write(*,*) " ├> idemix2_tau_h = ", idemix2_tau_h + write(*,*) " ├> idemix2_gamma = ", idemix2_gamma + write(*,*) " ├> idemix2_jstar = ", idemix2_jstar + write(*,*) " ├> idemix2_mu0 = ", idemix2_mu0 + write(*,*) " │ " +! write(*,*) " ├> idemix2_superbee_adv = ", idemix2_enable_superbee_adv + write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB_timestep + write(*,*) " ├> idemix2_nfbin = ", idemix2_nfbin + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_M2 = ", idemix2_enable_M2 + write(*,*) " │ └> idemix2_M2forc_file = ", trim(idemix2_M2forc_file) + write(*,*) " │ ├> idemix2_M2forc_vname = ", trim(idemix2_M2forc_vname) + write(*,*) " │ └> idemix2_M2forc_zname = ", trim(idemix2_M2forc_zname) + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_niw = ", idemix2_enable_niw + write(*,*) " │ ├> idemix2_fniw_usage = ", idemix2_fniw_usage + write(*,*) " │ └> idemix2_niwforc_file = ", trim(idemix2_niwforc_file) + write(*,*) " │ └> idemix2_niwforc_vname = ", trim(idemix2_niwforc_vname) + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_bot = ", idemix2_enable_bot + write(*,*) " │ └> idemix2_botforc_file = ", trim(idemix2_botforc_file) + write(*,*) " │ ├> idemix2_botforc_vname = ", trim(idemix2_botforc_vname) + write(*,*) " │ └> idemix2_botforc_Etot = ", idemix2_botforc_Etot + write(*,*) " │ " +! write(*,*) " ├> idemix2_enable_leew = ", idemix2_enable_leew +! write(*,*) " │ └> idemix2_leewforc_file = ", trim(idemix2_leewforc_file) +! write(*,*) " │ └> idemix2_leewforc_vname= ", trim(idemix2_leewforc_vname) +! write(*,*) " │ " + write(*,*) " ├> idemix2_hrmsforc_file = ", trim(idemix2_hrmsforc_file) + write(*,*) " │ └> idemix2_hrmsforc_vname = ", trim(idemix2_hrmsforc_vname) + write(*,*) " │ " + write(*,*) " ├> idemix2_hlamforc_file = ", trim(idemix2_hlamforc_file) + write(*,*) " │ └> idemix2_hlamforc_vname = ", trim(idemix2_hlamforc_vname) + write(*,*) " │ " + WRITE(*,*) " └> idemix2_shelf_dist = ", idemix2_shelf_dist + write(*,*) + write(*,*) " IDEMIX2 inputs:" + end if + !_______________________________________________________________________ ! allocate + initialse idemix arrays --> with size myDim_nod2D+eDim_nod2D node_size=myDim_nod2D+eDim_nod2D elem_size=myDim_elem2D+eDim_elem2D nfbin =idemix2_nfbin + ! Build MPI datatypes for spectral bin halo exchange + call init_mpi_types_fbin(idemix2_nfbin, partit) + ! 3d vertical group velocities (m/s) for the continuous internal wave spectrum ! 3d horizontal group velocities (m/s) for the continuous internal wave spectrum allocate(iwe2_c0(nl,node_size), iwe2_v0(nl,node_size)) @@ -284,7 +346,7 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_alpha_M2_c(:) = 0.0_WP ! M2 dissipation timescale - allocate(iwe2_M2_tau(myDim_nod2D)) + allocate(iwe2_M2_tau(node_size)) iwe2_M2_tau(:) = 0.0_WP ! M2 cross spectral propagation at elements @@ -299,18 +361,35 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_M2_w(:,:) = 0.0_WP ! M2 forcing - allocate(iwe2_fM2(nfbin, myDim_nod2D)) + allocate(iwe2_fM2(nfbin, node_size)) iwe2_fM2(:,:) = 0.0_WP ! M2 wave energy, and divergence of M2 wave energy ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) - allocate(iwe2_E_M2( 3, nfbin, node_size), iwe2_Ediv_M2(3, nfbin, node_size)) - iwe2_E_M2( :,:,:) = 0.0_WP - iwe2_Ediv_M2( :,:,:) = 0.0_WP + allocate( iwe2_E_M2( 3, nfbin, node_size) & + , iwe2_E_M2_divh(3, nfbin, node_size) & + , iwe2_E_M2_divs(3, nfbin, node_size) & + ) + iwe2_E_M2( :,:,:)= 0.0_WP + iwe2_E_M2_divh( :,:,:)= 0.0_WP + iwe2_E_M2_divs( :,:,:)= 0.0_WP ! structure function for M2 energy - allocate(iwe2_E_struct_M2(nl-1, node_size)) - iwe2_E_struct_M2(:,:) = 0.0_WP + allocate(iwe2_E_M2_struct(nl, node_size)) + iwe2_E_M2_struct(:,:) = 0.0_WP + + ! diagnostic for M2 spectral energy advection + allocate( iwe2_E_M2_dt( nfbin, myDim_nod2D) & + , iwe2_E_M2_advh(nfbin, myDim_nod2D) & + , iwe2_E_M2_advs(nfbin, myDim_nod2D) & + , iwe2_E_M2_diss(nfbin, myDim_nod2D) & + , iwe2_E_M2_forc(nfbin, myDim_nod2D) & + ) + iwe2_E_M2_dt( :,:) = 0.0_WP + iwe2_E_M2_advh(:,:) = 0.0_WP + iwe2_E_M2_advs(:,:) = 0.0_WP + iwe2_E_M2_diss(:,:) = 0.0_WP + iwe2_E_M2_forc(:,:) = 0.0_WP end if ! initialise niw variables @@ -320,7 +399,7 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_omega_niw(:) = 0.0_WP ! niw dissipation timescale - allocate(iwe2_niw_tau(myDim_nod2D)) + allocate(iwe2_niw_tau(node_size)) iwe2_niw_tau(:) = 0.0_WP ! niw cross spectral propagation at elements @@ -335,23 +414,43 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_niw_w(:,:) = 0.0_WP ! niw forcing - allocate(iwe2_fniw(nfbin, myDim_nod2D)) + allocate(iwe2_fniw(nfbin, node_size)) iwe2_fniw(:,:) = 0.0_WP ! niw wave energy, and divergence of niw wave energy ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) - allocate(iwe2_E_niw( 3, nfbin, node_size), iwe2_Ediv_niw(3, nfbin, node_size)) - iwe2_E_niw( :,:,:) = 0.0_WP - iwe2_Ediv_niw( :,:,:) = 0.0_WP + allocate( iwe2_E_niw( 3, nfbin, node_size) & + , iwe2_E_niw_divh(3, nfbin, node_size) & + , iwe2_E_niw_divs(3, nfbin, node_size) & + ) + iwe2_E_niw( :,:,:)= 0.0_WP + iwe2_E_niw_divh( :,:,:)= 0.0_WP + iwe2_E_niw_divs( :,:,:)= 0.0_WP ! structure function for niw energy - allocate(iwe2_E_struct_niw(nl, node_size)) - iwe2_E_struct_niw(:,:) = 0.0_WP + allocate(iwe2_E_niw_struct(nl, node_size)) + iwe2_E_niw_struct(:,:) = 0.0_WP + ! diagnostic for niw spectral energy advection + allocate( iwe2_E_niw_dt( nfbin, myDim_nod2D) & + , iwe2_E_niw_advh(nfbin, myDim_nod2D) & + , iwe2_E_niw_advs(nfbin, myDim_nod2D) & + , iwe2_E_niw_diss(nfbin, myDim_nod2D) & + , iwe2_E_niw_forc(nfbin, myDim_nod2D) & + ) + iwe2_E_niw_dt( :,:) = 0.0_WP + iwe2_E_niw_advh(:,:) = 0.0_WP + iwe2_E_niw_advs(:,:) = 0.0_WP + iwe2_E_niw_diss(:,:) = 0.0_WP + iwe2_E_niw_forc(:,:) = 0.0_WP end if ! allocate 1d Spectral space coordinates - allocate(iwe2_phit(nfbin), iwe2_phiu(nfbin), iwe2_dphit(nfbin), iwe2_dphiu(nfbin)) + allocate( iwe2_phit( nfbin) & + , iwe2_phiu( nfbin) & + , iwe2_dphit(nfbin) & + , iwe2_dphiu(nfbin) & + ) iwe2_phit(:) = 0.0_WP iwe2_phiu(:) = 0.0_WP iwe2_dphit(:) = 0.0_WP @@ -362,31 +461,41 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_Av(:,:) = 0.0_WP ! forcing fields, M2 tidal forcing (spectral) and NIW forcing (spectral) - allocate(iwe2_fbot_e(myDim_elem2D), iwe2_fbot(nl, node_size), & - iwe2_fleew(myDim_elem2D), iwe2_fsrf(myDim_nod2D)) + allocate( iwe2_fbot_e( myDim_elem2D) & + , iwe2_fbot(nl, node_size) & + , iwe2_fsrf( node_size) & +! , iwe2_fleew( myDim_elem2D) & + ) iwe2_fbot_e(:) = 0.0_WP iwe2_fbot(:,:) = 0.0_WP - iwe2_fleew(:) = 0.0_WP - iwe2_fsrf(:) = 0.0_WP + iwe2_fsrf( :) = 0.0_WP +! iwe2_fleew( :) = 0.0_WP ! Topographic height and Topographic wavelength - allocate(iwe2_topo_hrms(myDim_nod2D), iwe2_topo_hlam(myDim_nod2D), iwe2_topo_shelf(myDim_nod2D), iwe2_topo_dist(myDim_elem2D)) + allocate( iwe2_topo_hrms( node_size) & + , iwe2_topo_hlam( node_size) & + , iwe2_topo_dist( node_size) & + ) iwe2_topo_hrms(:) = 0.0_WP iwe2_topo_hlam(:) = 0.0_WP - iwe2_topo_shelf(:) = 0.0_WP iwe2_topo_dist(:) = 0.0_WP ! support gradient variables - allocate(iwe2_grady_coriol(myDim_elem2D)) - allocate(iwe2_gradxy_e(2, nfbin, elem_size), iwe2_gradxy_n(2, nfbin, myDim_nod2D)) + allocate( iwe2_grady_coriol( elem_size) & + , iwe2_gradxy_e(2, nfbin, elem_size ) & + , iwe2_gradxy_n(2, nfbin, myDim_nod2D ) & + ) iwe2_grady_coriol(:) = 0.0_WP iwe2_gradxy_e(:,:,:) = 0.0_WP iwe2_gradxy_n(:,:,:) = 0.0_WP ! support horizontal edge flux and vertical flux and accumulated divergence variables - allocate(iwe2_flx_uv(nfbin, partit%myDim_edge2D), iwe2_flx_w(nfbin, node_size), iwe2_div_hv(nfbin, node_size)) + allocate( iwe2_flx_uv(nfbin, partit%myDim_edge2D) & + , iwe2_flx_w( nfbin, node_size) & + , iwe2_div_hv(nfbin, node_size) & + ) iwe2_flx_uv(:,:) = 0.0 - iwe2_flx_w(:,:) = 0.0 + iwe2_flx_w( :,:) = 0.0 iwe2_div_hv(:,:) = 0.0 ! support inverse volume of wcell @@ -406,63 +515,6 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_phiu(fbin_i) = iwe2_phiu(fbin_i-1) + iwe2_dphiu(fbin_i) end do - !_______________________________________________________________________ - ! read cvmix namelist file - nmlfile ='namelist.cvmix' ! name of ocean namelist file - ! check if cvmix namelist file exists if not use default values - file_exist=.False. - inquire(file=trim(nmlfile),exist=file_exist) - if (file_exist) then - open(20,file=trim(nmlfile)) - read(20,nml=param_idemix2) - close(20) - else - write(*,*) ' could not find namelist.cvmix, will use default values !' - end if - - !_______________________________________________________________________ - if (mype==0) then - write(*,*) " IDEMIX2 parameters:" - write(*,*) " ├> idemix2_tau_v = ", idemix2_tau_v - write(*,*) " ├> idemix2_tau_h = ", idemix2_tau_h - write(*,*) " ├> idemix2_gamma = ", idemix2_gamma - write(*,*) " ├> idemix2_jstar = ", idemix2_jstar - write(*,*) " ├> idemix2_mu0 = ", idemix2_mu0 - write(*,*) " │ " -! write(*,*) " ├> idemix2_superbee_adv = ", idemix2_enable_superbee_adv - write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB_timestep - write(*,*) " ├> idemix2_nfbin = ", idemix2_nfbin - write(*,*) " │ " - write(*,*) " ├> idemix2_enable_M2 = ", idemix2_enable_M2 - write(*,*) " │ └> idemix2_M2forc_file = ", trim(idemix2_M2forc_file) - write(*,*) " │ ├> idemix2_M2forc_vname = ", trim(idemix2_M2forc_vname) - write(*,*) " │ └> idemix2_M2forc_zname = ", trim(idemix2_M2forc_zname) - write(*,*) " │ " - write(*,*) " ├> idemix2_enable_niw = ", idemix2_enable_niw - write(*,*) " │ ├> idemix2_fniw_usage = ", idemix2_fniw_usage - write(*,*) " │ └> idemix2_niwforc_file = ", trim(idemix2_niwforc_file) - write(*,*) " │ └> idemix2_niwforc_vname = ", trim(idemix2_niwforc_vname) - write(*,*) " │ " - write(*,*) " ├> idemix2_enable_bot = ", idemix2_enable_bot - write(*,*) " │ └> idemix2_botforc_file = ", trim(idemix2_botforc_file) - write(*,*) " │ ├> idemix2_botforc_vname = ", trim(idemix2_botforc_vname) - write(*,*) " │ └> idemix2_botforc_Etot = ", idemix2_botforc_Etot - write(*,*) " │ " - write(*,*) " ├> idemix2_enable_leew = ", idemix2_enable_leew - write(*,*) " │ └> idemix2_leewforc_file = ", trim(idemix2_leewforc_file) - write(*,*) " │ └> idemix2_leewforc_vname= ", trim(idemix2_leewforc_vname) - write(*,*) " │ " - write(*,*) " ├> idemix2_hrmsforc_file = ", trim(idemix2_hrmsforc_file) - write(*,*) " │ └> idemix2_hrmsforc_vname = ", trim(idemix2_hrmsforc_vname) - write(*,*) " │ " - write(*,*) " ├> idemix2_hlamforc_file = ", trim(idemix2_hlamforc_file) - write(*,*) " │ └> idemix2_hlamforc_vname = ", trim(idemix2_hlamforc_vname) - write(*,*) " │ " - WRITE(*,*) " └> idemix2_shelf_dist = ", idemix2_shelf_dist - write(*,*) - write(*,*) " IDEMIX2 inputs:" - end if - !_______________________________________________________________________ ! read idemix M2 forcing from cfsr data --> file if (idemix2_enable_M2) then @@ -508,7 +560,7 @@ subroutine init_cvmix_idemix2(partit, mesh) end if ! --> if (idemix2_enable_M2) then !_______________________________________________________________________ - ! read idemix niw oe srf forcing from cfsr data --> file + ! read idemix niw or srf forcing from cfsr data --> file t0=MPI_Wtime() file_exist=.False. inquire(file=trim(idemix2_niwforc_file),exist=file_exist) @@ -523,9 +575,12 @@ subroutine init_cvmix_idemix2(partit, mesh) partit , & mesh & ) + + ! only 20% (idemix2_fniw_usage) from the surface forcing goes into internal waves ! iwe2_fsrf becomes surface forcing variable when idemix2_enable_niw=.false. ! in this case standard idemix1 behaviour + iwe2_fsrf = max(0.0_WP,iwe2_fsrf) iwe2_fsrf = iwe2_fsrf/density_0*idemix2_fniw_usage if (idemix2_enable_niw) then if (mype==0) write(*,*) ' ├> read IDEMIX2 niw wave forcing' @@ -558,8 +613,8 @@ subroutine init_cvmix_idemix2(partit, mesh) ! from background flows. Physical Context: NIWs are generated by wind events and have frequencies ! close to f. They can only propagate as internal waves if ω > |f|. if (idemix2_enable_niw) then - do node = 1, myDim_nod2D - iwe2_omega_niw(node) = max(1d-8, abs( 1.05 * mesh%coriolis_node(elem) ) ) + do node = 1, myDim_nod2D+eDim_nod2D + iwe2_omega_niw(node) = max(1.0e-8_WP, abs( 1.05 * mesh%coriolis_node(node) ) ) end do end if t1=MPI_Wtime() @@ -578,6 +633,10 @@ subroutine init_cvmix_idemix2(partit, mesh) ! | ! .false.=interpolate on element centroids instead of vertices <---+ + ! make sure forcing is all positive no numerical negative values + iwe2_fbot_e = max(0.0_WP,iwe2_fbot_e) + + ! check for total tidal energy that is infused through the bottom, see how ! much is lossed during interpolation and compare with value of the ! original files @@ -634,35 +693,35 @@ subroutine init_cvmix_idemix2(partit, mesh) if (mype==0) write(*,*) ' │ └> elapsed time:', t1-t0 end if !--> if (idemix2_enable_bot) then - !_______________________________________________________________________ - ! read Lee-Wave forcing - if (idemix2_enable_leew) then - t0=MPI_Wtime() - file_exist=.False. - inquire(file=trim(idemix2_leewforc_file),exist=file_exist) - if (file_exist) then - if (mype==0) write(*,*) ' ├> read IDEMIX2 lee wave forcing --> add to bottom forcing' - call read_other_NetCDF(trim(idemix2_leewforc_file), trim(idemix2_leewforc_vname), 1, iwe2_fleew, .true., .false., partit, mesh) - - iwe2_fbot_e = iwe2_fbot_e + iwe2_fleew - ! | - ! +-> no dividion by density_0, Lee wave Forcing - ! already in units of m^3/s^3 - else - if (mype==0) then - print *, achar(27)//'[33m' - write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: IDEMIX2 Lee-Wave forcing file not found! Cant apply IDEMIX2' - write(*,*) ' vertical mixing parameterisation! ' - write(*,*) ' ├> file: ', trim(idemix2_hrmsforc_file) - write(*,*) ' └> check: namelist.cvmix, idemix2_leewforc_file' - write(*,*) '____________________________________________________________________' - print *, achar(27)//'[0m' - write(*,*) - end if - end if - if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) - end if ! --> if (idemix2_enable_leew) then +! !_______________________________________________________________________ +! ! read Lee-Wave forcing +! if (idemix2_enable_leew) then +! t0=MPI_Wtime() +! file_exist=.False. +! inquire(file=trim(idemix2_leewforc_file),exist=file_exist) +! if (file_exist) then +! if (mype==0) write(*,*) ' ├> read IDEMIX2 lee wave forcing --> add to bottom forcing' +! call read_other_NetCDF(trim(idemix2_leewforc_file), trim(idemix2_leewforc_vname), 1, iwe2_fleew, .true., .false., partit, mesh) +! +! iwe2_fbot_e = iwe2_fbot_e + iwe2_fleew +! ! | +! ! +-> no dividion by density_0, Lee wave Forcing +! ! already in units of m^3/s^3 +! else +! if (mype==0) then +! print *, achar(27)//'[33m' +! write(*,*) '____________________________________________________________________' +! write(*,*) ' ERROR: IDEMIX2 Lee-Wave forcing file not found! Cant apply IDEMIX2' +! write(*,*) ' vertical mixing parameterisation! ' +! write(*,*) ' ├> file: ', trim(idemix2_hrmsforc_file) +! write(*,*) ' └> check: namelist.cvmix, idemix2_leewforc_file' +! write(*,*) '____________________________________________________________________' +! print *, achar(27)//'[0m' +! write(*,*) +! end if +! end if +! if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) +! end if ! --> if (idemix2_enable_leew) then !_______________________________________________________________________ ! read idemix HRMS and HLAM forcing --> file @@ -734,7 +793,7 @@ subroutine init_cvmix_idemix2(partit, mesh) do elem = 1, myDim_elem2D nzmax = nlevels(elem) elnodes = elem2d_nodes(:,elem) - iwe2_fbot(nzmax, elnodes(:)) = iwe2_fbot(nzmax, elnodes(:)) - iwe2_fbot_e(elem)/3.0 + iwe2_fbot(nzmax, elnodes(:)) = iwe2_fbot(nzmax, elnodes(:)) + iwe2_fbot_e(elem)/3.0 end do !_______________________________________________________________________ @@ -759,21 +818,22 @@ subroutine init_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ ! initialise IDEMIX parameters - call cvmix_idemix2_init(tau_v = idemix2_tau_v , & - tau_h = idemix2_tau_h , & - gamma = idemix2_gamma , & - jstar = idemix2_jstar , & - mu0 = idemix2_mu0 , & - nfbin = idemix2_nfbin , & - shelf_dist = idemix2_shelf_dist , & - enable_M2 = idemix2_enable_M2 , & - enable_niw = idemix2_enable_niw , & -! enable_superbee_adv = idemix2_enable_superbee_adv , & - enable_AB_timestep = idemix2_enable_AB_timestep , & - enable_hor_diffusion= idemix2_enable_hor_diffusion, & - enable_hor_diff_iter= idemix2_enable_hor_diff_iter, & - hor_diff_niter = idemix2_hor_diff_niter & - ) + call cvmix_idemix2_init( & + tau_v = idemix2_tau_v & + , tau_h = idemix2_tau_h & + , gamma = idemix2_gamma & + , jstar = idemix2_jstar & + , mu0 = idemix2_mu0 & + , nfbin = idemix2_nfbin & + , shelf_dist = idemix2_shelf_dist & + , enable_M2 = idemix2_enable_M2 & + , enable_niw = idemix2_enable_niw & + , enable_AB_timestep = idemix2_enable_AB_timestep & + , enable_hor_diffusion= idemix2_enable_hor_diffusion & + , enable_hor_diff_iter= idemix2_enable_hor_diff_iter & + , hor_diff_niter = idemix2_hor_diff_niter & + ! enable_superbee_adv = idemix2_enable_superbee_adv & + ) if (partit%mype==0) write(*,*) end subroutine init_cvmix_idemix2 @@ -789,7 +849,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) implicit none type(t_mesh), intent(in), target :: mesh type(t_partit), intent(inout), target :: partit - integer :: node, elem, edge, node_size, elem_size, k, fbini, nfbin + integer :: node, elem, edge, node_size, elem_size, k, fbini, nfbin, nodeH_size, elemH_size integer :: nz, nln, nl1, nl2, nl12, nu1, nu2, nu12, uln, iter integer :: elnodes(3), el(2), ednodes(2) real(kind=WP) :: lat_n_deg, lat_e_deg @@ -801,22 +861,24 @@ subroutine calc_cvmix_idemix2(partit, mesh) #include "../associate_mesh_def.h" #include "../associate_part_ass.h" #include "../associate_mesh_ass.h" - node_size = myDim_nod2D - elem_size = myDim_elem2D - nfbin = idemix2_nfbin + node_size = myDim_nod2D + nodeH_size = myDim_nod2D+eDim_nod2D + elem_size = myDim_elem2D + elemH_size = myDim_elem2D+eDim_elem2D + nfbin = idemix2_nfbin !_______________________________________________________________________ ! do tau timestepping indices shift - otaum1= taum1 - taum1 = tau - tau = taup1 - taup1 = otaum1; - if (mype==0) write(*,*) " --> taum1, tau, taup1: ", taum1, tau, taup1 + otaum1= iwe2_taum1 + iwe2_taum1 = iwe2_tau + iwe2_tau = iwe2_taup1 + iwe2_taup1 = otaum1; + if (mype==0) write(*,*) " --> taum1, tau, taup1: ", iwe2_taum1, iwe2_tau, iwe2_taup1 !_______________________________________________________________________ - do node=1, node_size + do node=1, myDim_nod2D+eDim_nod2D lat_n_deg = geo_coord_nod2D(2,node) * 180.0/pi - + iwe2_M2_w(:,node) = 0.0_WP !___________________________________________________________________ ! compute baroclinic gravity wave speed nln = mesh%nl @@ -851,14 +913,14 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! internal wave spectrum ! c0 ... 3d vertical group velocities (m/s) for the continuous ! internal wave spectrum - call cvmix_idemix2_compute_param( & - nlev = nln-uln+1 , & !IN - coriolis = mesh%coriolis_node( node) , & !IN - Nsqr = bvfreq( uln:nln , node) , & !IN - cn = cn , & !IN - alpha_c = iwe2_alpha_c(uln:nln , node) , & !OUT - c0 = iwe2_c0( uln:nln , node) , & !OUT - v0 = iwe2_v0( uln:nln , node) & !OUT + call cvmix_idemix2_compute_param( & + nlev = nln-uln+1 & !IN + , coriolis = mesh%coriolis_node( node) & !IN + , Nsqr = bvfreq( uln:nln, node) & !IN + , cn = cn & !IN + , alpha_c = iwe2_alpha_c(uln:nln, node) & !OUT + , c0 = iwe2_c0( uln:nln, node) & !OUT + , v0 = iwe2_v0( uln:nln, node) & !OUT ) ! @@ -873,7 +935,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! omega_M2 ... M2 frequency (fixed) ! omega_niw ... NIW frequency (lat dependent) ! cn ... baroclionic gravity wave speed - ! zbottom ... bottom depth at elements + ! zbottom ... bottom depth at nodes (depth must be positive, *(-1)) ! topo_hrms ... root mean square topographic height ! topo_hlam ... characteristic horiz. length scale of topographic features ! topo_shelf... .true. if point is considered on shelf @@ -892,39 +954,42 @@ subroutine calc_cvmix_idemix2(partit, mesh) end if if (idemix2_enable_M2) then call cvmix_idemix2_compute_compart_interact_tscale(& - dtime = dt , & !IN - lat = lat_n_deg , & !IN - coriolis = mesh%coriolis_node( node) , & !IN - cn = cn , & !IN - zbottom = zbar_n_bot( node) , & !IN - topo_hrms = iwe2_topo_hrms( node) , & !IN - topo_hlam = iwe2_topo_hlam( node) , & !IN - topo_shelf = topo_shelf , & !IN - omega_compart= iwe2_omega_M2 , & !IN - tau_compart = iwe2_M2_tau( node) & !OUT + dtime = dt & !IN + , lat = lat_n_deg & !IN + , coriolis = mesh%coriolis_node( node) & !IN + , cn = cn & !IN + , zbottom = -zbar_n_bot( node) & !IN + , topo_hrms = iwe2_topo_hrms( node) & !IN + , topo_hlam = iwe2_topo_hlam( node) & !IN + , topo_shelf = topo_shelf & !IN + , omega_compart= iwe2_omega_M2 & !IN + , tau_compart = iwe2_M2_tau( node) & !OUT ) call cvmix_idemix2_compute_M2_dissipation( & - lat = lat_n_deg , & !IN - cn = cn , & !IN - zbottom = zbar_n_bot( node) , & !IN - alpha_M2_c = iwe2_alpha_M2_c( node) & !OUT + lat = lat_n_deg & !IN + , cn = cn & !IN + , zbottom = -zbar_n_bot( node) & !IN + , alpha_M2_c = iwe2_alpha_M2_c( node) & !OUT ) end if if (idemix2_enable_niw) then call cvmix_idemix2_compute_compart_interact_tscale(& - dtime = dt , & !IN - lat = lat_n_deg , & !IN - coriolis = mesh%coriolis_node( node) , & !IN - cn = cn , & !IN - zbottom = zbar_n_bot( node) , & !IN - topo_hrms = iwe2_topo_hrms( node) , & !IN - topo_hlam = iwe2_topo_hlam( node) , & !IN - topo_shelf = topo_shelf , & !IN - omega_compart= iwe2_omega_niw( node) , & !IN - tau_compart = iwe2_niw_tau( node) & !OUT + dtime = dt & !IN + , lat = lat_n_deg & !IN + , coriolis = mesh%coriolis_node( node) & !IN + , cn = cn & !IN + , zbottom = -zbar_n_bot( node) & !IN + , topo_hrms = iwe2_topo_hrms( node) & !IN + , topo_hlam = iwe2_topo_hlam( node) & !IN + , topo_shelf = topo_shelf & !IN + , omega_compart= iwe2_omega_niw( node) & !IN + , tau_compart = iwe2_niw_tau( node) & !OUT ) end if end if + + + ! ! !___________________________________________________________________ @@ -945,49 +1010,47 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! E_struct_niw... structure function for NIW energy if ((idemix2_enable_M2) .and. (idemix2_enable_niw)) then call cvmix_idemix2_compute_vert_struct_fct( & - nlev = nln-uln+1 , & !IN - dzw = hnode( uln:nln-1, node) , & !IN - coriolis = mesh%coriolis_node( node) , & !IN - omega_M2 = iwe2_omega_M2 , & !IN - omega_niw = iwe2_omega_niw( node) , & !IN - cn = cn , & !IN - Nsqr = bvfreq( uln:nln, node) , & !IN - E_struct_M2 = iwe2_E_struct_M2( uln:nln, node) , & !OUT - E_struct_niw= iwe2_E_struct_niw(uln:nln, node) & !OUT + nlev = nln-uln+1 & !IN + , dzw = hnode( uln:nln-1, node) & !IN + , coriolis = mesh%coriolis_node( node) & !IN + , cn = cn & !IN + , Nsqr = bvfreq( uln:nln, node) & !IN + , omega_M2 = iwe2_omega_M2 & !IN + , omega_niw = iwe2_omega_niw( node) & !IN + , E_struct_M2 = iwe2_E_M2_struct( uln:nln, node) & !OUT + , E_struct_niw= iwe2_E_niw_struct(uln:nln, node) & !OUT ) else if (idemix2_enable_M2) then call cvmix_idemix2_compute_vert_struct_fct( & - nlev = nln-uln+1 , & !IN - dzw = hnode( uln:nln-1, node) , & !IN - coriolis = mesh%coriolis_node( node) , & !IN - omega_M2 = iwe2_omega_M2 , & !IN - omega_niw = iwe2_omega_niw( node) , & !IN - cn = cn , & !IN - Nsqr = bvfreq( uln:nln, node) , & !IN - E_struct_M2 = iwe2_E_struct_M2( uln:nln, node) & !OUT + nlev = nln-uln+1 & !IN + , dzw = hnode( uln:nln-1, node) & !IN + , coriolis = mesh%coriolis_node( node) & !IN + , cn = cn & !IN + , Nsqr = bvfreq( uln:nln, node) & !IN + , omega_M2 = iwe2_omega_M2 & !IN + , E_struct_M2 = iwe2_E_M2_struct( uln:nln, node) & !OUT ) else if (idemix2_enable_niw) then call cvmix_idemix2_compute_vert_struct_fct( & - nlev = nln-uln+1 , & !IN - dzw = hnode( uln:nln-1, node) , & !IN - coriolis = mesh%coriolis_node( node) , & !IN - omega_M2 = iwe2_omega_M2 , & !IN - omega_niw = iwe2_omega_niw( node) , & !IN - cn = cn , & !IN - Nsqr = bvfreq( uln:nln, node) , & !IN - E_struct_niw= iwe2_E_struct_niw(uln:nln, node) & !OUT + nlev = nln-uln+1 & !IN + , dzw = hnode( uln:nln-1, node) & !IN + , coriolis = mesh%coriolis_node( node) & !IN + , cn = cn & !IN + , Nsqr = bvfreq( uln:nln, node) & !IN + , omega_niw = iwe2_omega_niw( node) & !IN + , E_struct_niw= iwe2_E_niw_struct(uln:nln, node) & !OUT ) end if - end do - call exchange_nod(iwe2_cn , partit) - call exchange_nod(iwe2_alpha_c, partit) - call exchange_nod(iwe2_c0 , partit) - call exchange_nod(iwe2_v0 , partit) + end do ! --> do node=1, myDim_nod2D+eDim_nod2D +! call exchange_nod(iwe2_cn , partit) +! call exchange_nod(iwe2_alpha_c, partit) +! call exchange_nod(iwe2_c0 , partit) +! call exchange_nod(iwe2_v0 , partit) !_______________________________________________________________________ ! 5th. compute idemix2 group velocites for M2 an NIW - do elem = 1,elem_size + do elem = 1, myDim_elem2D nln = nlevels(elem)-1 uln = ulevels(elem) elnodes = elem2d_nodes(:,elem) @@ -1006,15 +1069,6 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! average to elem if (idemix2_enable_niw) omega_niw_e = sum(iwe2_omega_niw(elnodes))/3.0 - - !___________________________________________________________________ - ! check if point is near shelf - if (iwe2_topo_dist(elem) <= idemix2_shelf_dist) then - topo_shelf = .True. - else - topo_shelf = .False. - end if - ! ! !___________________________________________________________________ @@ -1053,19 +1107,19 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! w_niw ... cross spectral propagation of NIW internal group velocity if (idemix2_enable_M2) then call cvmix_idemix2_compute_compart_groupvel( & - nfbin = idemix2_nfbin , & !IN - coriolis = mesh%coriolis( elem) , & !IN - grady_coriol = iwe2_grady_coriol( elem) , & !IN - coslat = mesh%elem_cos( elem) , & !IN - cn = cn_e , & !IN - cn_gradx = cn_gradx_e , & !IN - cn_grady = cn_grady_e , & !IN - phit = iwe2_phit , & !IN - phiu = iwe2_phiu , & !IN - omega_compart= iwe2_omega_M2 , & !IN - u_compart = iwe2_M2_uv(1, :, elem) , & !OUT - v_compart = iwe2_M2_uv(2, :, elem) , & !OUT - w_compart = w_M2_e( : ) & !OUT + nfbin = idemix2_nfbin & !IN + , coriolis = mesh%coriolis( elem) & !IN + , coriol_grady = iwe2_grady_coriol( elem) & !IN + , coslat = mesh%elem_cos( elem) & !IN + , cn = cn_e & !IN + , cn_gradx = cn_gradx_e & !IN + , cn_grady = cn_grady_e & !IN + , phit = iwe2_phit & !IN + , phiu = iwe2_phiu & !IN + , omega_compart= iwe2_omega_M2 & !IN + , u_compart = iwe2_M2_uv(1, :, elem) & !OUT + , v_compart = iwe2_M2_uv(2, :, elem) & !OUT + , w_compart = w_M2_e( : ) & !OUT ) ! --> here w_M2_e and w_niw_e are still on elements but for the proper ! finite volume advection implementation we need them on nodes ! @@ -1075,19 +1129,19 @@ subroutine calc_cvmix_idemix2(partit, mesh) end if if (idemix2_enable_niw) then call cvmix_idemix2_compute_compart_groupvel( & - nfbin = idemix2_nfbin , & !IN - coriolis = mesh%coriolis( elem) , & !IN - grady_coriol = iwe2_grady_coriol( elem) , & !IN - coslat = mesh%elem_cos( elem) , & !IN - cn = cn_e , & !IN - cn_gradx = cn_gradx_e , & !IN - cn_grady = cn_grady_e , & !IN - phit = iwe2_phit , & !IN - phiu = iwe2_phiu , & !IN - omega_compart= omega_niw_e , & !IN - u_compart = iwe2_niw_uv(1, :, elem) , & !OUT - v_compart = iwe2_niw_uv(2, :, elem) , & !OUT - w_compart = w_niw_e( : ) & !OUT + nfbin = idemix2_nfbin & !IN + , coriolis = mesh%coriolis( elem) & !IN + , coriol_grady = iwe2_grady_coriol( elem) & !IN + , coslat = mesh%elem_cos( elem) & !IN + , cn = cn_e & !IN + , cn_gradx = cn_gradx_e & !IN + , cn_grady = cn_grady_e & !IN + , phit = iwe2_phit & !IN + , phiu = iwe2_phiu & !IN + , omega_compart= omega_niw_e & !IN + , u_compart = iwe2_niw_uv(1, :, elem) & !OUT + , v_compart = iwe2_niw_uv(2, :, elem) & !OUT + , w_compart = w_niw_e( : ) & !OUT ) do k=1,3 iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*elem_area(elem)/3.0_WP @@ -1095,20 +1149,20 @@ subroutine calc_cvmix_idemix2(partit, mesh) end if ! --> at the end we still need to normalize iwe2_M2_w and iwe2_niw_w ! with the scalararea! - end do ! --> do elem = 1,elem_size + end do ! --> do elem = 1, myDim_elem2D ! finalize elem2node averaging of iwe2_M2_w and iwe2_niw_w ! cross spectral exachange has to be related to nodes, since general advection ! is related to nodes independent of the volume if (idemix2_enable_M2) then - call exchange_elem(iwe2_M2_uv, partit) - do node=1, node_size + call exchange_elem_fbin(iwe2_M2_uv, partit) + do node=1, myDim_nod2D iwe2_M2_w( :, node) = iwe2_M2_w(:, node)/area(1, node) end do end if if (idemix2_enable_niw) then - call exchange_elem(iwe2_niw_uv, partit) - do node=1, node_size + call exchange_elem_fbin(iwe2_niw_uv, partit) + do node=1, myDim_nod2D iwe2_niw_w(:, node) = iwe2_niw_w(:, node)/area(1,node) end do !--> do node=1, node_size end if @@ -1120,42 +1174,58 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! dE/dt = -div(vec_u * E) - tau*E + Forc ! E^(n+1) = E^n + dt*( -div(vec_u^n*E^n) - tau*E^n + Forc^n) if (idemix2_enable_M2) then - call hsintegrate_Ecompart( & - taum1, tau, taup1 , & - iwe2_E_M2 , & - iwe2_Ediv_M2 , & - iwe2_M2_uv , & - iwe2_M2_w , & - iwe2_fM2 , & - iwe2_M2_tau , & - iwe2_dphit , & - iwe2_gradxy_e , & - iwe2_gradxy_n , & - iwe2_flx_uv , & - iwe2_flx_w , & - mesh%edge_up_dn_tri , & - partit , & - mesh & - ) + call hsintegrate_Ecompart(& + iwe2_taum1, iwe2_tau, iwe2_taup1 & + , 'M2' & + , iwe2_E_M2 & + , iwe2_E_M2_divh & + , iwe2_E_M2_divs & + , iwe2_M2_uv & + , iwe2_M2_w & + , iwe2_fM2 & + , iwe2_M2_tau & + , iwe2_dphit & + , iwe2_gradxy_e & + , iwe2_gradxy_n & + , iwe2_flx_uv & + , iwe2_flx_w & + , mesh%edge_up_dn_tri & + , partit & + , mesh & + , iwe2_E_M2_dt & ! optional: diagnostic + , iwe2_E_M2_advh & ! optional: diagnostic + , iwe2_E_M2_advs & ! optional: diagnostic + , iwe2_E_M2_diss & ! optional: diagnostic + , iwe2_E_M2_forc & ! optional: diagnostic + ) + call exchange_nod2D_fbin(iwe2_E_M2(iwe2_taup1,:,:), partit) end if if (idemix2_enable_niw) then - call hsintegrate_Ecompart( & - taum1, tau, taup1 , & - iwe2_E_niw , & - iwe2_Ediv_niw , & - iwe2_niw_uv , & - iwe2_niw_w , & - iwe2_fniw , & - iwe2_niw_tau , & - iwe2_dphit , & - iwe2_gradxy_e , & - iwe2_gradxy_n , & - iwe2_flx_uv , & - iwe2_flx_w , & - edge_up_dn_tri , & - partit , & - mesh & - ) + call hsintegrate_Ecompart(& + iwe2_taum1, iwe2_tau, iwe2_taup1 & + , 'NIW' & + , iwe2_E_niw & + , iwe2_E_niw_divh & + , iwe2_E_niw_divs & + , iwe2_niw_uv & + , iwe2_niw_w & + , iwe2_fniw & + , iwe2_niw_tau & + , iwe2_dphit & + , iwe2_gradxy_e & + , iwe2_gradxy_n & + , iwe2_flx_uv & + , iwe2_flx_w & + , mesh%edge_up_dn_tri & + , partit & + , mesh & + , iwe2_E_niw_dt & ! optional: diagnostic + , iwe2_E_niw_advh & ! optional: diagnostic + , iwe2_E_niw_advs & ! optional: diagnostic + , iwe2_E_niw_diss & ! optional: diagnostic + , iwe2_E_niw_forc & ! optional: diagnostic + ) + call exchange_nod2D_fbin(iwe2_E_niw(iwe2_taup1,:,:), partit) end if !_______________________________________________________________________ @@ -1167,23 +1237,23 @@ subroutine calc_cvmix_idemix2(partit, mesh) do node = 1, myDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) - call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & - nlev = nln-uln+1 , & - dzw = hnode( uln:nln-1, node) , & - dt = dt , & - c0 = iwe2_c0( uln:nln , node) , & - alpha_c = iwe2_alpha_c( uln:nln , node) , & - fsrf = iwe2_fsrf( node) , & - fbot = iwe2_fbot( uln:nln , node) , & - Eiw_old = iwe2_E_iw(tau , uln:nln , node) , & - Eiw_new = iwe2_E_iw(taup1, uln:nln , node) , & - Eiw_dt = iwe2_E_iw_dt( uln:nln , node) , & - Eiw_vdif = iwe2_E_iw_vdif( uln:nln , node) , & - Eiw_diss = iwe2_E_iw_diss( uln:nln , node) , & - Eiw_srf = iwe2_E_iw_fsrf( node) , & - Eiw_bot = iwe2_E_iw_fbot( uln:nln , node) & + call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & + nlev = nln-uln+1 & + , dzw = hnode( uln:nln-1, node) & + , dt = dt & + , c0 = iwe2_c0( uln:nln , node) & + , alpha_c = iwe2_alpha_c( uln:nln , node) & + , fsrf = iwe2_fsrf( node) & + , fbot = iwe2_fbot( uln:nln , node) & + , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & + , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & + , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & + , Eiw_dt = iwe2_E_iw_dt( uln:nln , node) & ! optional: diagnostic + , Eiw_vdif = iwe2_E_iw_vdif( uln:nln , node) & ! optional: diagnostic + , Eiw_srf = iwe2_E_iw_fsrf( node) & ! optional: diagnostic + , Eiw_bot = iwe2_E_iw_fbot( uln:nln , node) & ! optional: diagnostic ) - end do + end do ! --> do node = 1, myDim_nod2D !_______________________________________________________________________ ! 8th. add lateral diffusion term (see. Olbers D., Eden C., 2013, A Global Model @@ -1193,15 +1263,15 @@ subroutine calc_cvmix_idemix2(partit, mesh) iwe2_E_iw_hdif = 0.0_WP end if if (idemix2_enable_hor_diffusion) then - call compute_hdiff_Eiw( & - iwe2_E_iw(tau , :, :) , & - iwe2_E_iw(taup1, :, :) , & - iwe2_E_iw_dt( :, :) , & - iwe2_E_iw_hdif( :, :) , & - iwe2_v0 , & - 1 , & - partit , & - mesh & + call compute_hdiff_Eiw( & + iwe2_E_iw(iwe2_tau , :, :) & + , iwe2_E_iw(iwe2_taup1, :, :) & + , iwe2_v0 & + , 1 & + , partit & + , mesh & + , Eiw_dt = iwe2_E_iw_dt( :, :) & ! optional: diagnostic + , Eiw_hdif = iwe2_E_iw_hdif( :, :) & ! optional: diagnostic ) end if @@ -1210,15 +1280,15 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! high resolution if (idemix2_enable_hor_diff_iter) then do iter=1, idemix2_hor_diff_niter - call compute_hdiff_Eiw( & - iwe2_E_iw(taup1, :, :) , & - iwe2_E_iw(taup1, :, :) , & - iwe2_E_iw_dt( :, :) , & - iwe2_E_iw_hdif( :, :) , & - iwe2_v0 , & - idemix2_hor_diff_niter , & - partit , & - mesh & + call compute_hdiff_Eiw( & + iwe2_E_iw(iwe2_taup1, :, :) & + , iwe2_E_iw(iwe2_taup1, :, :) & + , iwe2_v0 & + , idemix2_hor_diff_niter & + , partit & + , mesh & + , Eiw_dt = iwe2_E_iw_dt( :, :) & ! optional: diagnostic + , Eiw_hdif = iwe2_E_iw_hdif( :, :) & ! optional: diagnostic ) end do end if @@ -1231,52 +1301,52 @@ subroutine calc_cvmix_idemix2(partit, mesh) nln = nlevels_nod2D(node) !_______________________________________________________________ if (idemix2_enable_M2 .and. idemix2_enable_niw) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 , & - nfbin = idemix2_nfbin , & - dzw = hnode( uln:nln-1, node) , & - dphi = iwe2_dphit , & - dt = dt , & - E_iw_old = iwe2_E_iw( tau , uln:nln, node) , & - E_iw_new = iwe2_E_iw( taup1, uln:nln, node) , & - E_M2_old = iwe2_E_M2( tau , :, node) , & - E_M2_new = iwe2_E_M2( taup1, :, node) , & - E_M2_struct = iwe2_E_struct_M2( :, node) , & - alpha_M2_c = iwe2_alpha_M2_c( node) , & - tau_M2 = iwe2_M2_tau( node) , & - E_niw_old = iwe2_E_niw(tau , :, node) , & - E_niw_new = iwe2_E_niw(taup1, :, node) , & - E_niw_struct = iwe2_E_struct_niw(:, node) , & - tau_niw = iwe2_niw_tau( node) & + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & + , E_M2_struct = iwe2_E_M2_struct( : , node) & + , alpha_M2_c = iwe2_alpha_M2_c( node) & + , tau_M2 = iwe2_M2_tau( node) & + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & + , E_niw_struct = iwe2_E_niw_struct( : , node) & + , tau_niw = iwe2_niw_tau( node) & ) elseif (idemix2_enable_M2) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 , & - nfbin = idemix2_nfbin , & - dzw = hnode( uln:nln-1, node) , & - dphi = iwe2_dphit , & - dt = dt , & - E_iw_old = iwe2_E_iw( tau , uln:nln, node) , & - E_iw_new = iwe2_E_iw( taup1, uln:nln, node) , & - E_M2_old = iwe2_E_M2( tau , :, node) , & - E_M2_new = iwe2_E_M2( taup1, :, node) , & - E_M2_struct = iwe2_E_struct_M2( :, node) , & - alpha_M2_c = iwe2_alpha_M2_c( node) , & - tau_M2 = iwe2_M2_tau( node) & + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & + , E_M2_struct = iwe2_E_M2_struct( : , node) & + , alpha_M2_c = iwe2_alpha_M2_c( node) & + , tau_M2 = iwe2_M2_tau( node) & ) elseif (idemix2_enable_niw) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 , & - nfbin = idemix2_nfbin , & - dzw = hnode( uln:nln-1, node) , & - dphi = iwe2_dphit , & - dt = dt , & - E_iw_old = iwe2_E_iw( tau , uln:nln, node) , & - E_iw_new = iwe2_E_iw( taup1, uln:nln, node) , & - E_niw_old = iwe2_E_niw(tau , :, node) , & - E_niw_new = iwe2_E_niw(taup1, :, node) , & - E_niw_struct = iwe2_E_struct_niw(:, node) , & - tau_niw = iwe2_niw_tau( node) & + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & + , E_niw_struct = iwe2_E_niw_struct( : , node) & + , tau_niw = iwe2_niw_tau( node) & ) end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then end do ! --> for node = 1, myDim_nod2D @@ -1289,17 +1359,17 @@ subroutine calc_cvmix_idemix2(partit, mesh) !___________________________________________________________________ ! write out diffusivity --> convert from elem to vertices - do node=1, myDim_nod2D + do node=1, myDim_nod2D+eDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) !_______________________________________________________________ ! convert Eiw disspation into Kv and Av on vertices call cvmix_idemix2_compute_Eiw_diss2KvAv( & - nlev = nln-uln+1 , & - Eiw_diss= iwe2_E_iw_diss(uln:nln, node) , & - Nsqr = bvfreq( uln:nln, node) , & - KappaH = Kv( uln:nln, node) , & - KappaM = iwe2_Av( uln:nln, node) & + nlev = nln-uln+1 & + , Eiw_diss= iwe2_E_iw_diss(uln:nln, node) & + , Nsqr = bvfreq( uln:nln, node) & + , KappaH = Kv( uln:nln, node) & + , KappaM = iwe2_Av( uln:nln, node) & ) end do @@ -1317,6 +1387,12 @@ subroutine calc_cvmix_idemix2(partit, mesh) call exchange_nod(Kv , partit) end if + + !_______________________________________________________________________ +! if (.not. all(iwe2_E_M2_divs(iwe2_tau,:,1:myDim_nod2D)==0.0_WP)) then +! write(*,*) 'iwe2_E_M2_divs(ti,:,:)=', iwe2_E_M2_divs(iwe2_tau,:,1:myDim_nod2D) +! end if + end subroutine calc_cvmix_idemix2 @@ -1423,8 +1499,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & edlen = sqrt(dxdy12(1)**2 + dxdy12(2)**2) !___________________________________________________________________ - !loop over spectral bins -!$OMP simd + !loop over spectral bins do fbini = 2, nfbin-1 !_______________________________________________________________ ! compute volume flux across the segments from el(1) @@ -1570,7 +1645,7 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & real(kind=WP), intent(in) :: W ( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) real(kind=WP), intent(in) :: ttf( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) real(kind=WP), intent(in) :: dphi(idemix2_nfbin) - real(kind=WP), intent(inout) :: flux(idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP), intent(inout) :: flux(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) logical , intent(in) :: flag_2ndord_time logical , intent(in) :: flag_posdef !___LOCAL VARIABLES_____________________________________________________ @@ -1617,7 +1692,7 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & !_______________________________________________________________ ! tracer Slope Ratio Calculation for upwind point ! compute tracer slope - R = ttfp1-ttf(idxp2,node)/(-dttf0p1+small) + R = (ttfp1-ttf(idxp2,node))/(-dttf0p1+small) ! apply superbee limiter Cr = slimiter_superbee(R) @@ -1629,13 +1704,13 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) ! --> CFL = W*dt/dx - Tmean2 = ttfp1 + 0.5_WP*Cr*(-dttf0p1) * (1-merge(cfl, 0.0_WP, flag_2ndord_time)) + Tmean2 = ttfp1 + 0.5_WP*Cr*(-dttf0p1) * (1.0_WP-merge(cfl, 0.0_WP, flag_2ndord_time)) Tmean2 = merge(max(0.0_WP, Tmean2), Tmean2, flag_posdef) !_______________________________________________________________ ! tracer Slope Ratio Calculation for downwind point ! compute tracer slope - R = ttf0-ttf(idxm1,node)/(dttf0p1+small) + R = (ttf0-ttf(idxm1,node))/(dttf0p1+small) ! apply superbee limiter Cr = slimiter_superbee(R) @@ -1647,7 +1722,7 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) ! --> CFL = W*dt/dx - Tmean1 = ttf0 + 0.5_WP*Cr*(dttf0p1) * (1-cfl*merge(cfl, 0.0_WP, flag_2ndord_time)) + Tmean1 = ttf0 + 0.5_WP*Cr*(dttf0p1) * (1.0_WP-merge(cfl, 0.0_WP, flag_2ndord_time)) Tmean1 = merge(max(0.0_WP, Tmean1), Tmean1, flag_posdef) !_______________________________________________________________ ! cross spectral exchange rate @@ -1658,7 +1733,6 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & (vflux+vfabs)*Tmean1+ & (vflux-vfabs)*Tmean2 & ) !- flux(fbini, node) - end do !--> do fbini = 1, nfbin !$ACC END LOOP end do ! --> do node = 1, myDim_nod2D @@ -1698,7 +1772,8 @@ end function slimiter_superbee subroutine adv_Ecompart_flx2tra_spctrl( & flx_h , & flx_v , & - div_hv , & + div_h , & + div_v , & dphit , & partit , & mesh & @@ -1708,8 +1783,9 @@ subroutine adv_Ecompart_flx2tra_spctrl( & type(t_partit), intent(inout), target :: partit type(t_mesh) , intent(in ), target :: mesh real(kind=WP) , intent(in) :: flx_h( idemix2_nfbin, partit%myDim_edge2D) - real(kind=WP) , intent(in) :: flx_v( idemix2_nfbin, partit%myDim_nod2D) - real(kind=WP) , intent(inout) :: div_hv(idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(in) :: flx_v( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: div_h( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: div_v( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) !___LOCAL VARIABLES_____________________________________________________ integer :: node, edge, fbini, nfbin, ednodes(2) @@ -1718,7 +1794,8 @@ subroutine adv_Ecompart_flx2tra_spctrl( & #include "../associate_mesh_def.h" #include "../associate_part_ass.h" #include "../associate_mesh_ass.h" - + + nfbin = idemix2_nfbin ! ! !_______________________________________________________________________ @@ -1729,7 +1806,8 @@ subroutine adv_Ecompart_flx2tra_spctrl( & #endif do node=1, myDim_nod2D do fbini=1, nfbin - div_hv(fbini, node)=0.0_WP + div_h(fbini, node)=0.0_WP + div_v(fbini, node)=0.0_WP end do end do #ifndef ENABLE_OPENACC @@ -1753,9 +1831,9 @@ subroutine adv_Ecompart_flx2tra_spctrl( & do node=1, myDim_nod2d inv_fac1 = 1/areasvol(1,node) !$ACC LOOP VECTOR - do fbini=1,nfbin-1 + do fbini=2,nfbin-1 ! div_hv(fbini,node)=div_hv(fbini,node) + (flx_v(fbini,node)-flx_v(fbini+1,node))*inv_fac1*inv_dphi(fbini) - div_hv(fbini,node)=div_hv(fbini,node) + (flx_v(fbini,node)-flx_v(fbini+1,node))*inv_dphi(fbini) + div_v(fbini,node)=div_v(fbini,node) + (flx_v(fbini,node)-flx_v(fbini-1,node))*inv_dphi(fbini) end do !$ACC END LOOP end do @@ -1800,7 +1878,7 @@ subroutine adv_Ecompart_flx2tra_spctrl( & #if !defined(DISABLE_OPENACC_ATOMICS) !$ACC ATOMIC UPDATE #endif - div_hv(fbini,ednodes(1))=div_hv(fbini,ednodes(1))+flx_h(fbini,edge)*inv_fac1*inv_dphi(fbini) + div_h(fbini,ednodes(1))=div_h(fbini,ednodes(1))+flx_h(fbini,edge)*inv_fac1*inv_dphi(fbini) ! !___________________________________________________________________ ! horizontal flux contribution to ednode_2 @@ -1822,7 +1900,7 @@ subroutine adv_Ecompart_flx2tra_spctrl( & !$ACC ATOMIC UPDATE # endif #endif - div_hv(fbini,ednodes(2))=div_hv(fbini,ednodes(2))-flx_h(fbini,edge)*inv_fac2*inv_dphi(fbini) + div_h(fbini,ednodes(2))=div_h(fbini,ednodes(2))-flx_h(fbini,edge)*inv_fac2*inv_dphi(fbini) end do #ifndef ENABLE_OPENACC # if defined(_OPENMP) && !defined(__openmp_reproducible) @@ -1854,52 +1932,69 @@ end subroutine adv_Ecompart_flx2tra_spctrl ! !___________________________________________________________________________ ! integrate equation for wave energy compartments - subroutine hsintegrate_Ecompart( & - tim1, ti, tip1 , & - E , & - Ediv , & - vel , & - w , & - forc , & - tau , & - dphit , & - gradxy_e , & - gradxy_n , & - flx_uv , & - flx_w , & - edge_up_dn_tri , & - partit , & - mesh & + subroutine hsintegrate_Ecompart( & + tim1, ti, tip1 & + , Ename & + , E & + , Edivh & + , Edivs & + , vel & + , w & + , forc & + , tauE & + , dphit & + , gradxy_e & + , gradxy_n & + , flx_uv & + , flx_cs & + , edge_up_dn_tri & + , partit & + , mesh & + , Edt & + , Eadvh & + , Eadvs & + , Ediss & + , Eforc & ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit) , intent(inout), target :: partit type(t_mesh) , intent(in ), target :: mesh integer , intent(in ) :: ti, tim1, tip1 + character(len=*), intent(in ) :: Ename real(kind=WP) , intent(inout) :: E( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: Ediv( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: Edivh( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: Edivs( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: vel( 2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) real(kind=WP) , intent(in ) :: w( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: forc( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(in ) :: tau( partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: tauE( partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(inout) :: gradxy_e(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) real(kind=WP) , intent(inout) :: gradxy_n(2, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) real(kind=WP) , intent(inout) :: flx_uv( idemix2_nfbin, partit%myDim_edge2D) - real(kind=WP) , intent(inout) :: flx_w( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout) :: flx_cs( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) integer , intent(in ) :: edge_up_dn_tri(2 , partit%myDim_edge2D) + + real(kind=WP) , intent(inout), optional:: Edt( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout), optional:: Eadvh( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout), optional:: Eadvs( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout), optional:: Ediss( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout), optional:: Eforc( idemix2_nfbin, partit%myDim_nod2D) !___LOCAL VARIABLES_____________________________________________________ integer :: node, fbini, nfbin #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" #include "../associate_mesh_ass.h" + !_______________________________________________________________________ + nfbin=idemix2_nfbin + !_______________________________________________________________________ ! compute gradient of iwe2_E_M2 on nodes is need for call tracer_gradient_elements(E(ti,:,:), gradxy_e, partit, mesh, .False.) - call exchange_elem(gradxy_e, partit) + call exchange_elem_fbin(gradxy_e, partit) call interp_e2n(gradxy_e, gradxy_n, mesh, partit, .False.) - ! compute horizontal superbee advected tracer flux call adv_Ecompart_hor_spctrl_superbee( & vel , & @@ -1910,43 +2005,96 @@ subroutine hsintegrate_Ecompart( & partit , & mesh , & edge_up_dn_tri , & - .True. , & ! do 2nd order in space & time - .True. & ! enforce positive definit + .False. , & ! do 2nd order in space & time + .True. & ! enforce positive definit ) +! if ( any(flx_uv/=flx_uv) ) write(*,*) " }-)))d°> found NaN in flx_uv" ! compute cross spectral superbee advected tracer flux call adv_Ecompart_crss_spctrl_superbee( & w , & E(ti,:,:) , & dphit , & - flx_w , & + flx_cs , & partit , & mesh , & - .True. , & ! do 2nd order in space & time + .False. , & ! do 2nd order in space & time .True. & ! enforce positive definit - ) - + ) +! if (any(flx_cs/=flx_cs)) write(*,*) " }-)))d°> found NaN in flx_w" + ! compute flux divergence call adv_Ecompart_flx2tra_spctrl( & flx_uv , & - flx_w , & - Ediv(ti,:,:) , & + flx_cs , & + Edivh(ti,:,:) , & + Edivs(ti,:,:) , & dphit , & partit , & mesh & ) - - ! integrate E_M2^(n+1) = ... +! if (any(Edivh(ti,:,:)/=Edivh(ti,:,:))) write(*,*) " }-)))d°> found NaN in Edivh(ti,:,:)" +! if (any(Edivs(ti,:,:)/=Edivs(ti,:,:))) write(*,*) " }-)))d°> found NaN in Edivs(ti,:,:)" + + ! Eden and Olbers 2014, eq. 2 + ! integrate E_M2^(n+1) = E_M2^(n) + dt*[ + ! - div(c_uv*E_M2^n) + ! - d/dphi (dphit/dt*E_M2^n) + ! + forc + ! + W + T] + ! + ! eq. 7 & 8: Wave-Wave (T) and Topographic interaction + ! T_M2 + W_M2 = alpha_c_M2*E_M2*int(Eiw*dz) - 1/tau_M2 * E_M2 + ! └───────────┬─────────────┘ + ! └> this part added in wave-wave-interaction + ! T_niw + W_niw = -1/tau_niw * E_niw + ! --> here variable tauE is already 1/tau do node= 1, myDim_nod2d do fbini=2,nfbin-1 E(tip1, fbini, node) = E(ti, fbini, node) & - + dt * ( forc( fbini, node) & - - tau(node)*E( ti , fbini, node) & - + (1.5+idemix2_AB_epsilon)*Ediv(ti , fbini, node) & - - (0.5+idemix2_AB_epsilon)*Ediv(tim1, fbini, node)) + + dt * (+ (1.5+idemix2_AB_epsilon)*Edivh(ti , fbini, node) & ! div(c_uv*E_M2^n) + - (0.5+idemix2_AB_epsilon)*Edivh(tim1, fbini, node) & ! div(c_uv*E_M2^n) + + (1.5+idemix2_AB_epsilon)*Edivs(ti , fbini, node) & ! d/dphi (dphit/dt*E_M2) + - (0.5+idemix2_AB_epsilon)*Edivs(tim1, fbini, node) & ! d/dphi (dphit/dt*E_M2) + + forc( fbini, node) & ! forc + - tauE(node)*E( ti , fbini, node) & ! diss + ) + + if (E(tip1, fbini, node)/=E(tip1, fbini, node) .or. E(tip1, fbini, node)<0.0_WP) then + write(*,*) " }-))))°> found negative/NaN " ,trim(Ename)," advection", E(tip1, fbini, node) + write(*,*) " tip1, fbini, node = ", tip1, fbini, node + write(*,*) " E(ti , fbini, node) = ", E(ti , fbini, node) + write(*,*) " E(tip1, fbini, node) = ", E(tip1, fbini, node) + write(*,*) " dt*forc = ", dt*forc(fbini, node) + write(*,*) " -dt*tau*E = ", -dt*tauE(node)*E( ti , fbini, node) + write(*,*) " dt*Edivh(t), (t-1) = ", dt*Edivh(ti , fbini, node), dt*Edivh(tim1 , fbini, node) + write(*,*) " dt*Edivh_AB = ", dt*( (1.5+idemix2_AB_epsilon)*Edivh(ti , fbini, node) - (0.5+idemix2_AB_epsilon)*Edivh(tim1, fbini, node)) + write(*,*) " dt*Edivs(t), (t-1) = ", dt*Edivs(ti , fbini, node), dt*Edivs(tim1 , fbini, node) + write(*,*) " dt*Edivs_AB = ", dt*( (1.5+idemix2_AB_epsilon)*Edivs(ti , fbini, node) - (0.5+idemix2_AB_epsilon)*Edivs(tim1, fbini, node)) + write(*,*) " W = ", w(:, node) + end if end do end do - + + + !_______________________________________________________________________ + ! additional diagnostics + if (present(Edt)) Edt(:,:) = (E(tip1, :, 1:myDim_nod2D)-E(ti, :, 1:myDim_nod2D)) + + if (present(Eadvh)) Eadvh(:,:) = ((1.5+idemix2_AB_epsilon)*Edivh(ti , :, 1:myDim_nod2D) & + - (0.5+idemix2_AB_epsilon)*Edivh(tim1, :, 1:myDim_nod2D)) + + if (present(Eadvs)) Eadvs(:,:) = ((1.5+idemix2_AB_epsilon)*Edivs(ti , :, 1:myDim_nod2D) & + - (0.5+idemix2_AB_epsilon)*Edivs(tim1, :, 1:myDim_nod2D)) + + if (present(Ediss)) then + do node= 1, myDim_nod2d + Ediss(:,node) = - tauE(node)*E( ti , :, node) + end do + end if + + if (present(Eforc)) Eforc(:,:) = forc(:, 1:myDim_nod2D) + end subroutine hsintegrate_Ecompart @@ -2023,12 +2171,12 @@ end subroutine compute_vol_wcell subroutine compute_hdiff_Eiw( & Eiw_old , & Eiw , & - Eiw_dt , & - Eiw_hdif , & v0 , & n_hor_iter , & partit , & - mesh & + mesh , & + Eiw_dt , & + Eiw_hdif & ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ @@ -2036,10 +2184,11 @@ subroutine compute_hdiff_Eiw( & type(t_mesh) , intent(in ), target :: mesh real(kind=WP) , intent(in ) :: Eiw_old(:,:) real(kind=WP) , intent(inout) :: Eiw(:,:) - real(kind=WP) , intent(inout) :: Eiw_dt(:,:) - real(kind=WP) , intent(inout) :: Eiw_hdif(:,:) real(kind=WP) , intent(in ) :: v0(:,:) integer , intent(in ) :: n_hor_iter + real(kind=WP) , intent(inout),optional:: Eiw_dt(:,:) + real(kind=WP) , intent(inout),optional:: Eiw_hdif(:,:) + !___LOCAL VARIABLES_____________________________________________________ integer :: edge, ednodes(2), edel(2), & elnodes1(3), elnodes2(3), & @@ -2284,6 +2433,5 @@ subroutine compute_hdiff_Eiw( & end do end do end subroutine compute_hdiff_Eiw - - -end module g_cvmix_idemix2 \ No newline at end of file + +end module g_cvmix_idemix2 diff --git a/src/cvmix_driver/gen_modules_cvmix_tke.F90 b/src/cvmix_driver/gen_modules_cvmix_tke.F90 index 762272376..6ecd0d17d 100644 --- a/src/cvmix_driver/gen_modules_cvmix_tke.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_tke.F90 @@ -20,7 +20,7 @@ module g_cvmix_tke use cvmix_put_get, only: cvmix_put use cvmix_kinds_and_types use g_cvmix_idemix, only: iwe_n, iwe_Tdis_n, iwe_alpha_c_n - use g_cvmix_idemix2, only: iwe2_E_iw, iwe2_E_iw_diss, iwe2_alpha_c, taup1 + use g_cvmix_idemix2, only: iwe2_E_iw, iwe2_E_iw_diss, iwe2_alpha_c, iwe2_taup1 !___________________________________________________________________________ ! module calls from FESOM @@ -308,7 +308,7 @@ subroutine calc_cvmix_tke(dynamics, partit, mesh) tke_in3d_iwdis = -iwe_Tdis_n tke_in3d_iwealphac = iwe_alpha_c_n else if (mod(mix_scheme_nmb,10)==7) then - tke_in3d_iwe = iwe2_E_iw(taup1,:,:) + tke_in3d_iwe = iwe2_E_iw(iwe2_taup1,:,:) tke_in3d_iwdis = -iwe2_E_iw_diss tke_in3d_iwealphac = iwe2_alpha_c end if From 038b1ae7286ccb8973082048ed6bd4975b336bc2 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 27 Apr 2026 17:29:42 +0200 Subject: [PATCH 25/63] debug occurence of negative E_niw, introduce cross-spectral CFL limiter, fix some bugs in the horizontal advection of E_niw --- src/cvmix_driver/cvmix_idemix2.F90 | 22 +- .../gen_modules_cvmix_idemix2.F90 | 505 ++++++++++++------ src/io_meandata.F90 | 9 +- 3 files changed, 374 insertions(+), 162 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 002c8a313..554d063ff 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -424,25 +424,28 @@ subroutine compute_compart_groupvel( & ! kdot_M2 = (kdot_x_M2, kdot_y_M2) ! compute: sqrt(omega²-f²) - fxa = max(1d-10, omega_compart**2 - coriolis**2 ) + fxa = sqrt(max(1d-10, omega_compart**2 - coriolis**2 )) ! 1st part coriolis contribution ! compute: c_n/omega/sqrt(omega²-f²)) * f * grad_f ! 2nd part topographic/buoyancy driven contribution ! compute: sqrt(omega²-f²)/omega * grad_cn - kdot_y = -cn/sqrt(fxa)*coriolis/omega_compart*coriol_grady & - -sqrt(fxa)/omega_compart*cn_grady + kdot_y = -cn/fxa/omega_compart * coriolis*coriol_grady & + -fxa/omega_compart*cn_grady ! | ! +-> this minus sign is from the -cos(phi) ! - kdot_x = sqrt(fxa)/omega_compart*cn_gradx + kdot_x = fxa/omega_compart*cn_gradx !___________________________________________________________________________ !zonal, meridional and cross-spectral component of M2 internal tide group velocity - do fbin_i=2,nfbin-1 +! do fbin_i=2,nfbin-1 + do fbin_i=1, nfbin ! --> include ghost cells ofthe periodic boundary u_compart(fbin_i) = cg_compart*cos( phit(fbin_i) ) - v_compart(fbin_i) = cg_compart*sin( phit(fbin_i) ) * coslat + ! Keep coslat to match pyOM2 - need to investigate divergence normalization + ! v_compart(fbin_i) = cg_compart*sin( phit(fbin_i) ) * coslat + v_compart(fbin_i) = cg_compart*sin( phit(fbin_i) ) w_compart(fbin_i) = (kdot_y*cos(phiu(fbin_i)) + kdot_x*sin(phiu(fbin_i)) ) end do @@ -1039,7 +1042,7 @@ subroutine compute_Eiw_waveinteract( & !___Local___________________________________________________________________ integer :: nz, fbini - real(cvmix_r8) :: vint, sint, aM2c, M2_diss, fmin, vint_dbg, small=1.0e-12_cvmix_r8 + real(cvmix_r8) :: vint, sint, aM2c, M2_diss, fmin, small=1.0e-12_cvmix_r8 type(idemix2_type), pointer :: idemix2_const_in ! do pointer into save variable or into user defined input variable @@ -1075,6 +1078,7 @@ subroutine compute_Eiw_waveinteract( & M2_diss = aM2c*vint*E_M2_old(fbini) M2_diss = min(M2_diss, E_M2_new(fbini)/max(small,dt)) E_M2_new(fbini) = E_M2_new(fbini)-dt*M2_diss + E_M2_new(fbini) = max(0.0_cvmix_r8, E_M2_new(fbini)) if (E_M2_new(fbini)/=E_M2_new(fbini) .or. E_M2_new(fbini)<0.0_cvmix_r8) then write(*,*) " }-))))°> found negative/NaN E_M2_new from WWI M2", E_M2_new(fbini) write(*,*) "fbini = ", fbini @@ -1089,9 +1093,6 @@ subroutine compute_Eiw_waveinteract( & ! update E_iw from E_M2 do nz = 1, nlev fmin = min( 0.5_cvmix_r8/dt,aM2c*vint ) ! flux limiter - - vint_dbg = E_iw_new(nz) - E_iw_new(nz) = E_iw_new(nz) & + dt * tau_M2* sint * E_M2_struct(nz) & + dt * fmin * sint * E_M2_struct(nz) @@ -1100,7 +1101,6 @@ subroutine compute_Eiw_waveinteract( & write(*,*) " }-))))°> found negative/NaN Eiw_new from WWI M2", E_iw_new(nz) write(*,*) "nz = ", nz write(*,*) "E_iw_new(nz) = ", E_iw_new(nz) - write(*,*) "E_iw_bf(nz) = ", vint_dbg write(*,*) "E_M2_new = ", minval(E_M2_new), maxval(E_M2_new) write(*,*) "E_M2_old = ", minval(E_M2_old), maxval(E_M2_old) write(*,*) "tau_M2 = ", tau_M2 diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index db7e0c5cc..5de1ebc09 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -72,7 +72,7 @@ module g_cvmix_idemix2 ! use superbee-spectral advection scheme and Adams-Bashfort timestepping ! logical :: idemix2_enable_superbee_adv = .true. logical :: idemix2_enable_AB_timestep = .true. - integer :: idemix2_AB_epsilon = 0.1_WP + integer :: idemix2_AB_epsilon = 0.0_WP ! number of spectral bins used for the M2 tidal and near-inertial wave (niw) components ! e.g 50+2 in loop used as do fbin=2,51 ... 1 and 52 serve as spectral boudary condition ! The first and last bins are used for boundary conditions in the spectral space. @@ -209,6 +209,9 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,: ):: iwe2_flx_uv, iwe2_flx_w, iwe2_div_hv integer :: iwe2_taum1=1, iwe2_tau=2, iwe2_taup1=3, otaum1 + real(kind=WP), allocatable, dimension(:) :: iwe2_cn_e, iwe2_cn_gradx, iwe2_cn_grady + real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_w_e, iwe2_niw_w_e, iwe2_niw_cflcs, iwe2_M2_cflcs + ! load variables from CVMix list type(cvmix_data_type) :: CVMix_vars @@ -317,7 +320,13 @@ subroutine init_cvmix_idemix2(partit, mesh) ! baroclionic gravity wave speed allocate(iwe2_cn(node_size)) + allocate(iwe2_cn_e(elem_size)) + allocate(iwe2_cn_gradx(elem_size)) + allocate(iwe2_cn_grady(elem_size)) iwe2_cn(:) = 0.0_WP + iwe2_cn_e(:) = 0.0_WP + iwe2_cn_gradx(:) = 0.0_WP + iwe2_cn_grady(:) = 0.0_WP ! Eiw 3d enery dissipation coefficient allocate(iwe2_alpha_c(nl,node_size)) @@ -357,8 +366,10 @@ subroutine init_cvmix_idemix2(partit, mesh) ! at vertices allocate(iwe2_M2_uv(2, nfbin,elem_size)) allocate(iwe2_M2_w( nfbin,node_size)) + allocate(iwe2_M2_w_e( nfbin,elem_size)) iwe2_M2_uv(:,:,:) = 0.0_WP iwe2_M2_w(:,:) = 0.0_WP + iwe2_M2_w_e(:,:) = 0.0_WP ! M2 forcing allocate(iwe2_fM2(nfbin, node_size)) @@ -390,6 +401,9 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_M2_advs(:,:) = 0.0_WP iwe2_E_M2_diss(:,:) = 0.0_WP iwe2_E_M2_forc(:,:) = 0.0_WP + + allocate( iwe2_M2_cflcs( nfbin, node_size)) + iwe2_M2_cflcs = 0.0_WP end if ! initialise niw variables @@ -410,8 +424,10 @@ subroutine init_cvmix_idemix2(partit, mesh) ! at vertices allocate(iwe2_niw_uv(2, nfbin,elem_size)) allocate(iwe2_niw_w( nfbin,node_size)) + allocate(iwe2_niw_w_e( nfbin,elem_size)) iwe2_niw_uv(:,:,:) = 0.0_WP iwe2_niw_w(:,:) = 0.0_WP + iwe2_niw_w_e(:,:) = 0.0_WP ! niw forcing allocate(iwe2_fniw(nfbin, node_size)) @@ -443,6 +459,9 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_niw_advs(:,:) = 0.0_WP iwe2_E_niw_diss(:,:) = 0.0_WP iwe2_E_niw_forc(:,:) = 0.0_WP + + allocate( iwe2_niw_cflcs( nfbin, node_size)) + iwe2_niw_cflcs = 0.0_WP end if ! allocate 1d Spectral space coordinates @@ -483,7 +502,7 @@ subroutine init_cvmix_idemix2(partit, mesh) ! support gradient variables allocate( iwe2_grady_coriol( elem_size) & , iwe2_gradxy_e(2, nfbin, elem_size ) & - , iwe2_gradxy_n(2, nfbin, myDim_nod2D ) & + , iwe2_gradxy_n(2, nfbin, node_size ) & ) iwe2_grady_coriol(:) = 0.0_WP iwe2_gradxy_e(:,:,:) = 0.0_WP @@ -515,6 +534,14 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_phiu(fbin_i) = iwe2_phiu(fbin_i-1) + iwe2_dphiu(fbin_i) end do + if (partit%mype==0) then + write(*,*) 'iwe2_phit = ', iwe2_phit + write(*,*) 'iwe2_phiu = ', iwe2_phiu + write(*,*) + end if + + + !_______________________________________________________________________ ! read idemix M2 forcing from cfsr data --> file if (idemix2_enable_M2) then @@ -570,8 +597,8 @@ subroutine init_cvmix_idemix2(partit, mesh) trim(idemix2_niwforc_vname) , & 1 , & iwe2_fsrf , & - .true. , & - .true. , & + .false. , & ! NN for missing values + .true. , & ! interpolate to vertices partit , & mesh & ) @@ -872,13 +899,19 @@ subroutine calc_cvmix_idemix2(partit, mesh) iwe2_taum1 = iwe2_tau iwe2_tau = iwe2_taup1 iwe2_taup1 = otaum1; - if (mype==0) write(*,*) " --> taum1, tau, taup1: ", iwe2_taum1, iwe2_tau, iwe2_taup1 + ! if (mype==0) write(*,*) " --> taum1, tau, taup1: ", iwe2_taum1, iwe2_tau, iwe2_taup1 !_______________________________________________________________________ do node=1, myDim_nod2D+eDim_nod2D - + !___________________________________________________________________ + ! re-initialse cross spectral velocites, for later accumulation through + ! elemental values + if (idemix2_enable_M2 ) iwe2_M2_w( :,node) = 0.0_WP + if (idemix2_enable_niw) iwe2_niw_w(:,node) = 0.0_WP + + !___________________________________________________________________ lat_n_deg = geo_coord_nod2D(2,node) * 180.0/pi - iwe2_M2_w(:,node) = 0.0_WP + !___________________________________________________________________ ! compute baroclinic gravity wave speed nln = mesh%nl @@ -988,8 +1021,6 @@ subroutine calc_cvmix_idemix2(partit, mesh) end if end if - - ! ! !___________________________________________________________________ @@ -1042,10 +1073,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) ) end if end do ! --> do node=1, myDim_nod2D+eDim_nod2D -! call exchange_nod(iwe2_cn , partit) -! call exchange_nod(iwe2_alpha_c, partit) -! call exchange_nod(iwe2_c0 , partit) -! call exchange_nod(iwe2_v0 , partit) + !_______________________________________________________________________ @@ -1066,6 +1094,10 @@ subroutine calc_cvmix_idemix2(partit, mesh) cn_gradx_e = sum(gradient_sca(1:3,elem)*iwe2_cn(elnodes)) cn_grady_e = sum(gradient_sca(4:6,elem)*iwe2_cn(elnodes)) + iwe2_cn_e(elem) = cn_e + iwe2_cn_gradx(elem) = cn_gradx_e + iwe2_cn_grady(elem) = cn_grady_e + ! average to elem if (idemix2_enable_niw) omega_niw_e = sum(iwe2_omega_niw(elnodes))/3.0 @@ -1119,13 +1151,16 @@ subroutine calc_cvmix_idemix2(partit, mesh) , omega_compart= iwe2_omega_M2 & !IN , u_compart = iwe2_M2_uv(1, :, elem) & !OUT , v_compart = iwe2_M2_uv(2, :, elem) & !OUT - , w_compart = w_M2_e( : ) & !OUT +! , w_compart = w_M2_e( : ) & !OUT + , w_compart = iwe2_M2_w_e( :, elem) & !OUT ) ! --> here w_M2_e and w_niw_e are still on elements but for the proper ! finite volume advection implementation we need them on nodes ! do k=1,3 - iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + w_M2_e(:)*elem_area(elem)/3.0_WP +! iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + w_M2_e(:)*elem_area(elem)/3.0_WP + iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + iwe2_M2_w_e(:, elem)*elem_area(elem)/3.0_WP end do + end if if (idemix2_enable_niw) then call cvmix_idemix2_compute_compart_groupvel( & @@ -1141,33 +1176,41 @@ subroutine calc_cvmix_idemix2(partit, mesh) , omega_compart= omega_niw_e & !IN , u_compart = iwe2_niw_uv(1, :, elem) & !OUT , v_compart = iwe2_niw_uv(2, :, elem) & !OUT - , w_compart = w_niw_e( : ) & !OUT +! , w_compart = w_niw_e( : ) & !OUT + , w_compart = iwe2_niw_w_e( :, elem) & !OUT ) do k=1,3 - iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*elem_area(elem)/3.0_WP +! iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*elem_area(elem)/3.0_WP + iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + iwe2_niw_w_e(:, elem)*elem_area(elem)/3.0_WP end do end if ! --> at the end we still need to normalize iwe2_M2_w and iwe2_niw_w ! with the scalararea! - end do ! --> do elem = 1, myDim_elem2D + end do ! --> do elem = 1, myDim_elem2D ! finalize elem2node averaging of iwe2_M2_w and iwe2_niw_w ! cross spectral exachange has to be related to nodes, since general advection ! is related to nodes independent of the volume if (idemix2_enable_M2) then call exchange_elem_fbin(iwe2_M2_uv, partit) - do node=1, myDim_nod2D + call exchange_nod_fbin(iwe2_M2_w, partit) + do node=1, myDim_nod2D+eDim_nod2D iwe2_M2_w( :, node) = iwe2_M2_w(:, node)/area(1, node) - end do +! write(*,*) "iwe2_M2_w([1, 2, nfbin-1, nfbin],:)=", iwe2_M2_w(1, node), iwe2_M2_w(2, node), iwe2_M2_w(idemix2_nfbin-1, node), iwe2_M2_w(idemix2_nfbin, node) + end do end if + if (idemix2_enable_niw) then call exchange_elem_fbin(iwe2_niw_uv, partit) - do node=1, myDim_nod2D + call exchange_nod_fbin(iwe2_niw_w, partit) + do node=1, myDim_nod2D+eDim_nod2D iwe2_niw_w(:, node) = iwe2_niw_w(:, node)/area(1,node) - end do !--> do node=1, node_size +! write(*,*) "iwe2_niw_w([1, 2, nfbin-1, nfbin],:)=", iwe2_niw_w(1, node), iwe2_niw_w(2, node), iwe2_niw_w(idemix2_nfbin-1, node), iwe2_niw_w(idemix2_nfbin, node) + end do end if + !_______________________________________________________________________ ! 6th. horizontal spectral integrate energy compartment E_M2^(n+1) and ! E_niw^(n+1) equation. @@ -1189,16 +1232,17 @@ subroutine calc_cvmix_idemix2(partit, mesh) , iwe2_gradxy_n & , iwe2_flx_uv & , iwe2_flx_w & + , iwe2_M2_cflcs & , mesh%edge_up_dn_tri & , partit & , mesh & , iwe2_E_M2_dt & ! optional: diagnostic - , iwe2_E_M2_advh & ! optional: diagnostic , iwe2_E_M2_advs & ! optional: diagnostic , iwe2_E_M2_diss & ! optional: diagnostic , iwe2_E_M2_forc & ! optional: diagnostic + , geo_coord_nod2D(1,:)& + , geo_coord_nod2D(2,:)& ) - call exchange_nod2D_fbin(iwe2_E_M2(iwe2_taup1,:,:), partit) end if if (idemix2_enable_niw) then call hsintegrate_Ecompart(& @@ -1216,6 +1260,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) , iwe2_gradxy_n & , iwe2_flx_uv & , iwe2_flx_w & + , iwe2_niw_cflcs & , mesh%edge_up_dn_tri & , partit & , mesh & @@ -1224,10 +1269,13 @@ subroutine calc_cvmix_idemix2(partit, mesh) , iwe2_E_niw_advs & ! optional: diagnostic , iwe2_E_niw_diss & ! optional: diagnostic , iwe2_E_niw_forc & ! optional: diagnostic + , geo_coord_nod2D(1,:)& + , geo_coord_nod2D(2,:)& ) - call exchange_nod2D_fbin(iwe2_E_niw(iwe2_taup1,:,:), partit) end if + + !_______________________________________________________________________ ! 7th. Integrate IDEMIX equation vertical, solve vertical diffusion and ! dissipation part implicitly @@ -1255,7 +1303,6 @@ subroutine calc_cvmix_idemix2(partit, mesh) ) end do ! --> do node = 1, myDim_nod2D - !_______________________________________________________________________ ! 8th. add lateral diffusion term (see. Olbers D., Eden C., 2013, A Global Model ! for the Diapycnal Diffusivity Induced Internal Gravity Waves...) ! Eiw^(t+1) = Eiw^(t+1) + div_h( v_0 * tau_h * grad_h(v_0*E_iw^(t)) ) @@ -1275,6 +1322,8 @@ subroutine calc_cvmix_idemix2(partit, mesh) ) end if + + !_______________________________________________________________________ ! 9th. add tendency due to lateral diffusion with iterative method in case of ! high resolution @@ -1293,64 +1342,68 @@ subroutine calc_cvmix_idemix2(partit, mesh) end do end if - !_______________________________________________________________________ - ! 10th. compute wave-wave interaction - if (idemix2_enable_M2 .or. idemix2_enable_niw) then - do node = 1, myDim_nod2D - uln = ulevels_nod2D(node) - nln = nlevels_nod2D(node) - !_______________________________________________________________ - if (idemix2_enable_M2 .and. idemix2_enable_niw) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & - , E_M2_struct = iwe2_E_M2_struct( : , node) & - , alpha_M2_c = iwe2_alpha_M2_c( node) & - , tau_M2 = iwe2_M2_tau( node) & - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & - , E_niw_struct = iwe2_E_niw_struct( : , node) & - , tau_niw = iwe2_niw_tau( node) & - ) - elseif (idemix2_enable_M2) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & - , E_M2_struct = iwe2_E_M2_struct( : , node) & - , alpha_M2_c = iwe2_alpha_M2_c( node) & - , tau_M2 = iwe2_M2_tau( node) & - ) - elseif (idemix2_enable_niw) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & - , E_niw_struct = iwe2_E_niw_struct( : , node) & - , tau_niw = iwe2_niw_tau( node) & - ) - end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then - end do ! --> for node = 1, myDim_nod2D - end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then + + +! !_______________________________________________________________________ +! ! 10th. compute wave-wave interaction +! if (idemix2_enable_M2 .or. idemix2_enable_niw) then +! do node = 1, myDim_nod2D +! uln = ulevels_nod2D(node) +! nln = nlevels_nod2D(node) +! !_______________________________________________________________ +! if (idemix2_enable_M2 .and. idemix2_enable_niw) then +! call cvmix_idemix2_compute_Eiw_waveinteract( & +! nlev = nln-uln+1 & +! , nfbin = idemix2_nfbin & +! , dzw = hnode( uln:nln-1, node) & +! , dphi = iwe2_dphit & +! , dt = dt & +! , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & +! , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & +! , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & +! , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & +! , E_M2_struct = iwe2_E_M2_struct( : , node) & +! , alpha_M2_c = iwe2_alpha_M2_c( node) & +! , tau_M2 = iwe2_M2_tau( node) & +! , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & +! , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & +! , E_niw_struct = iwe2_E_niw_struct( : , node) & +! , tau_niw = iwe2_niw_tau( node) & +! ) +! elseif (idemix2_enable_M2) then +! call cvmix_idemix2_compute_Eiw_waveinteract( & +! nlev = nln-uln+1 & +! , nfbin = idemix2_nfbin & +! , dzw = hnode( uln:nln-1, node) & +! , dphi = iwe2_dphit & +! , dt = dt & +! , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & +! , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & +! , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & +! , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & +! , E_M2_struct = iwe2_E_M2_struct( : , node) & +! , alpha_M2_c = iwe2_alpha_M2_c( node) & +! , tau_M2 = iwe2_M2_tau( node) & +! ) +! elseif (idemix2_enable_niw) then +! call cvmix_idemix2_compute_Eiw_waveinteract( & +! nlev = nln-uln+1 & +! , nfbin = idemix2_nfbin & +! , dzw = hnode( uln:nln-1, node) & +! , dphi = iwe2_dphit & +! , dt = dt & +! , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & +! , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & +! , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & +! , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & +! , E_niw_struct = iwe2_E_niw_struct( : , node) & +! , tau_niw = iwe2_niw_tau( node) & +! ) +! end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then +! end do ! --> for node = 1, myDim_nod2D +! end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then + + !_______________________________________________________________________ ! 11th. write IDEMIX2 diffusivities and viscositie to FESOM only when IDEMIX2 is @@ -1387,12 +1440,6 @@ subroutine calc_cvmix_idemix2(partit, mesh) call exchange_nod(Kv , partit) end if - - !_______________________________________________________________________ -! if (.not. all(iwe2_E_M2_divs(iwe2_tau,:,1:myDim_nod2D)==0.0_WP)) then -! write(*,*) 'iwe2_E_M2_divs(ti,:,:)=', iwe2_E_M2_divs(iwe2_tau,:,1:myDim_nod2D) -! end if - end subroutine calc_cvmix_idemix2 @@ -1427,7 +1474,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & logical , intent(in) :: flag_2ndord_time logical , intent(in) :: flag_posdef !___LOCAL VARIABLES_____________________________________________________ - real(kind=WP) :: dx1, dy1, dx2, dy2, dxdy12(2), edlen, n_x, n_y + real(kind=WP) :: dx1, dy1, dx2, dy2, dxdy12(2), edlen, n_x, n_y, n_len real(kind=WP) :: u1, u2, v1, v2, Ue, CFL, fac_2ndord_time real(kind=WP) :: R, ttfp2, ttfm1, ttf0, ttfp1, dttf0p1, Tmean1, Tmean2, Cr, vflux, vfabs integer :: el(2), el2, ednodes(2), edge, fbini, nfbin @@ -1480,7 +1527,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! │ ! ├──> (dy1,-dx1) ! │ - ! ●━━━━━━━━━━━┿━━━━━━━━━━►● + ! ●━━━━━━━━━━━━┿━━━━━━━━━━►● ! │ ! (dy2,-dx2) <──┼──> (-dy2,dx2) ! │ @@ -1498,16 +1545,22 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & end if edlen = sqrt(dxdy12(1)**2 + dxdy12(2)**2) + ! Normalize normal vector to unit length for CFL calculation + n_len = sqrt(n_x**2 + n_y**2) + n_x = n_x / n_len + n_y = n_y / n_len + !___________________________________________________________________ !loop over spectral bins do fbini = 2, nfbin-1 !_______________________________________________________________ ! compute volume flux across the segments from el(1) + ! NOTE: NO dphi here - matches pyOM2 (dphi only in cross-spectral divergence) u1 = vel(1, fbini, el(1)) v1 = vel(2, fbini, el(1)) u2 = vel(1, fbini, el2 ) v2 = vel(2, fbini, el2 ) - vflux = ((-v1*dx1 + u1*dy1) + ( v2*dx2 - u2*dy2)) * dphi(fbini) + vflux = ((-v1*dx1 + u1*dy1) + ( v2*dx2 - u2*dy2)) ! NO * dphi(fbini) ! compute approximated edge centered and along edge projected ! mean velocity --> need to add component to make second order @@ -1537,7 +1590,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! │ dxdy12 │ ! │ │ ! v v - ! ttf_1 ttf_grad_n_2 + ! ttf_0 ttf_grad_n_p1 ! ttfp2 = ttf0 & + 2.0_WP * dxdy12(1)*ttf_grad_n(1, fbini, ednodes(2)) & @@ -1552,6 +1605,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! apply superbee limiter Cr = slimiter_superbee(R) +! Cr = 0.0_WP ! First-order upwind (Cr=0 gives upwind, Cr=1 gives average!) ! construct edge centered tracer value ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dx ]_Limited * dx/2 @@ -1564,6 +1618,23 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! --> n_ed = (n_1 + n_2)/2 ! --> CFL_h = u_ed*n_ed*dt/dx Tmean2 = ttfp1 + 0.5_WP * Cr * (-dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) +! if (ttfp2<0) then +! write(*,*) "mype=", partit%mype, ', edge=', edge, ', fbini=',fbini +! write(*,*) "ttfp2 = ", ttfp2 +! write(*,*) "ttfp1 = ", ttfp1 +! write(*,*) "ttf0 = ", ttf0 +! write(*,*) "dttf0p1 = ", dttf0p1 +! write(*,*) "E(node1) = ", ttf(fbini, ednodes(1)) +! write(*,*) "E(node2) = ", ttf(fbini, ednodes(2)) +! write(*,*) "dxdy12 = ", dxdy12 +! write(*,*) "ttf_grad_nx(node1) = ", ttf_grad_n(1, fbini, ednodes(1)) +! write(*,*) "ttf_grad_ny(node1) = ", ttf_grad_n(2, fbini, ednodes(1)) +! write(*,*) "ttf_grad_nx(node2) = ", ttf_grad_n(1, fbini, ednodes(2)) +! write(*,*) "ttf_grad_ny(node2) = ", ttf_grad_n(2, fbini, ednodes(2)) +! write(*,*) "Cr = ", Cr +! write(*,*) "Tmean2 = ", Tmean2 +! write(*,*) +! end if !_______________________________________________________________ ! tracer Slope Ratio Calculation for downwind augmented point @@ -1581,9 +1652,9 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! │ dxdy12 │ ! │ │ ! v v - ! ttf_grad_n_1 ttf_2 + ! ttf_grad_n_0 ttf_p1 ! - ttfm1 = ttfp1 & + ttfm1 = ttfp1 & - 2.0_WP * dxdy12(1)*ttf_grad_n(1, fbini, ednodes(1)) & - 2.0_WP * dxdy12(2)*ttf_grad_n(2, fbini, ednodes(1)) @@ -1596,6 +1667,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! apply superbee limiter Cr = slimiter_superbee(R) +! Cr = 0.0_WP ! First-order upwind (Cr=0 gives upwind, Cr=1 gives average!) ! construct edge centered tracer value ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dx ]_Limited * dx/2 @@ -1608,14 +1680,64 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! --> n_ed = (n_1 + n_2)/2 ! --> CFL_h = u_ed*n_ed*dt/dx Tmean1 = ttf0 + 0.5_WP * Cr * (dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) +! if (ttfm1<0) then +! write(*,*) "mype=", partit%mype, ' , edge=', edge, ' , fbini=',fbini +! write(*,*) "ttfm1 = ", ttfm1 +! write(*,*) "ttf0 = ", ttf0 +! write(*,*) "ttfp1 = ", ttfp1 +! write(*,*) "ttfp2 = ", ttfp2 +! write(*,*) "dttf0p1 = ", dttf0p1 +! write(*,*) "dxdy12 = ", dxdy12 +! write(*,*) "E(node1) = ", ttf(fbini, ednodes(1)) +! write(*,*) "E(node2) = ", ttf(fbini, ednodes(2)) +! write(*,*) "ttf_grad_nx(node1) = ", ttf_grad_n(1, fbini, ednodes(1)) +! write(*,*) "ttf_grad_ny(node1) = ", ttf_grad_n(2, fbini, ednodes(1)) +! write(*,*) "ttf_grad_nx(node2) = ", ttf_grad_n(1, fbini, ednodes(2)) +! write(*,*) "ttf_grad_ny(node2) = ", ttf_grad_n(2, fbini, ednodes(2)) +! write(*,*) "Cr = ", Cr +! write(*,*) "Tmean1 = ", Tmean1 +! write(*,*) +! end if !_______________________________________________________________ + ! Horizontal flux vfabs = abs(vflux) - flux(fbini, edge)=-0.5_WP*( & + flux(fbini, edge) = -0.5_WP*( & (vflux+vfabs)*Tmean1+ & (vflux-vfabs)*Tmean2 & - ) ! - flux(fbini, edge) + ) + +! if ( (mype==226) & +! .and. (ednodes(1) == 6 .or. ednodes(2)== 6) & +! .and. (fbini==2) & +! ) then +! +! write(*,*) " edge =",edge, ', fbini=',fbini, ', mype=',mype +! write(*,*) " ednodes = ", ednodes +! write(*,*) " el = ", el +! write(*,*) " flux(fbini, edge) = ", flux(fbini, edge) +! write(*,*) " dx1,dy1 = ", dx1,dy1 +! write(*,*) " u1 ,v1 = ", u1,v1 +! write(*,*) " dx2,dy2 = ", dx2,dy2 +! write(*,*) " u2 ,v2 = ", u2,v2 +! write(*,*) " vflux = ", vflux +! write(*,*) " vfabs = ", vfabs +! write(*,*) " ttf0 = ", ttf0 +! write(*,*) " ttfp1 = ", ttfp1 +! write(*,*) " dttf0p1 = ", dttf0p1 +! write(*,*) " Tmean1 = ", Tmean1 +! write(*,*) " Tmean2 = ", Tmean2 +! write(*,*) " CFL = ", CFL +! write(*,*) " Ue = ", Ue +! write(*,*) " edlen = ", edlen +! write(*,*) " dt = ", dt +! write(*,*) " n_x = ", n_x +! write(*,*) " n_y = ", n_y +! write(*,*) +! write(*,*) +! end if + end do ! --> for fbini = 1, nfbin end do !--> do edge=1, myDim_edge2D !$OMP END DO @@ -1633,6 +1755,7 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & ttf , & dphi , & flux , & + cflcs , & partit , & mesh , & flag_2ndord_time , & @@ -1642,16 +1765,17 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit),intent(inout), target :: partit type(t_mesh), intent(in) , target :: mesh - real(kind=WP), intent(in) :: W ( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(inout) :: W ( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) real(kind=WP), intent(in) :: ttf( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) real(kind=WP), intent(in) :: dphi(idemix2_nfbin) real(kind=WP), intent(inout) :: flux(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(inout) :: cflcs(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) logical , intent(in) :: flag_2ndord_time logical , intent(in) :: flag_posdef !___LOCAL VARIABLES_____________________________________________________ - integer :: node, fbini, nfbin, idxp2, idxm1 + integer :: node, fbini, nfbin, idxp1, idxp2, idxm1 real(kind=WP) :: R, ttf0, ttfp1, dttf0p1, Tmean1, Tmean2, Cr, vflux, vfabs - real(kind=WP) :: cfl + real(kind=WP) :: CFL, cflmax=0.50_WP #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" @@ -1671,22 +1795,30 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & !_______________________________________________________________________ ! this advection does !!! NOT !!! go over the vertical dimension it goes ! over the domain of the spectral bins - do node = 1, myDim_nod2D + do node = 1, myDim_nod2D+eDim_nod2D !___________________________________________________________________ !loop over spectral bins -!$ACC LOOP VECTOR - do fbini = 1, nfbin-1 +!$ACC LOOP VECTOR + ! Compute flux at all interfaces (1 to nfbin-1) + ! Bins 1 and nfbin are boundary bins (should have zero energy) + do fbini = 1, nfbin !_______________________________________________________________ - ! do periodic boundary condition accros spectral domain - idxp2 = fbini+2 ; if (idxp2>nfbin) idxp2=3 + ! Periodic wrapping for gradient stencil + idxp1 = fbini+1 ; if (idxp1>nfbin) idxp1=2+(fbini-nfbin) + idxp2 = fbini+2 ; if (idxp2>nfbin) idxp2=2+(fbini-nfbin) idxm1 = fbini-1 ; if (idxm1<1 ) idxm1=nfbin-2 - cfl = abs(W(fbini, node)) * dt / dphi(fbini) + ! limit W cross spectral exchange rate to the CFL limit + W(fbini, node) = min(abs(W(fbini, node)), cflmax*dphi(fbini)/dt)*sign(1.0_WP, W(fbini, node)) + + CFL = abs(W(fbini, node)) * dt / dphi(fbini) + cflcs(fbini, node) = CFL + !_______________________________________________________________ ! compute tracer difference ttf0 = ttf(fbini , node) - ttfp1 = ttf(fbini+1, node) + ttfp1 = ttf(idxp1 , node) dttf0p1 = ttfp1 - ttf0 !_______________________________________________________________ @@ -1704,7 +1836,7 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) ! --> CFL = W*dt/dx - Tmean2 = ttfp1 + 0.5_WP*Cr*(-dttf0p1) * (1.0_WP-merge(cfl, 0.0_WP, flag_2ndord_time)) + Tmean2 = ttfp1 + 0.5_WP*Cr*(-dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) Tmean2 = merge(max(0.0_WP, Tmean2), Tmean2, flag_posdef) !_______________________________________________________________ @@ -1722,20 +1854,32 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) ! --> CFL = W*dt/dx - Tmean1 = ttf0 + 0.5_WP*Cr*(dttf0p1) * (1.0_WP-merge(cfl, 0.0_WP, flag_2ndord_time)) + Tmean1 = ttf0 + 0.5_WP*Cr*(dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) Tmean1 = merge(max(0.0_WP, Tmean1), Tmean1, flag_posdef) + !_______________________________________________________________ - ! cross spectral exchange rate - !! vflux = W(fbini, node*dphi(fbini) + ! cross spectral flux matching pyOM2 (NO negative sign, NO area) vflux = W(fbini, node) vfabs = abs(vflux) - flux(fbini, node)=-0.5_WP*( & + flux(fbini, node) = 0.5_WP*( & (vflux+vfabs)*Tmean1+ & (vflux-vfabs)*Tmean2 & - ) !- flux(fbini, node) + ) + +! if (ttf0 /= 0.0_WP .or. ttfp1 /= 0.0_WP) then +! write(*,*) 'fbini, node = ', fbini, node +! write(*,*) 'flux(fbini, node) = ', flux(fbini, node) +! write(*,*) 'vflux = ', vflux +! write(*,*) 'vfabs = ', vfabs +! write(*,*) 'ttf0, ttfp1 = ', ttf0, ttfp1 +! write(*,*) 'ttf(:, node) = ', ttf(:, node) +! write(*,*) 'Tmean1, Tmean2 = ', Tmean1, Tmean2 +! write(*,*) +! end if end do !--> do fbini = 1, nfbin !$ACC END LOOP end do ! --> do node = 1, myDim_nod2D + #ifndef ENABLE_OPENACC !$OMP END DO !$OMP END PARALLEL @@ -1777,7 +1921,7 @@ subroutine adv_Ecompart_flx2tra_spctrl( & dphit , & partit , & mesh & - ) + ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit), intent(inout), target :: partit @@ -1804,7 +1948,7 @@ subroutine adv_Ecompart_flx2tra_spctrl( & #else !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) #endif - do node=1, myDim_nod2D + do node=1, myDim_nod2D+eDim_nod2D do fbini=1, nfbin div_h(fbini, node)=0.0_WP div_v(fbini, node)=0.0_WP @@ -1828,12 +1972,13 @@ subroutine adv_Ecompart_flx2tra_spctrl( & #else !$ACC PARALLEL LOOP GANG DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) #endif - do node=1, myDim_nod2d - inv_fac1 = 1/areasvol(1,node) + do node=1, myDim_nod2d+eDim_nod2D !$ACC LOOP VECTOR do fbini=2,nfbin-1 -! div_hv(fbini,node)=div_hv(fbini,node) + (flx_v(fbini,node)-flx_v(fbini+1,node))*inv_fac1*inv_dphi(fbini) - div_v(fbini,node)=div_v(fbini,node) + (flx_v(fbini,node)-flx_v(fbini-1,node))*inv_dphi(fbini) + ! Cross-spectral divergence matching pyOM2: -(flux(k) - flux(k-1))/dphi + ! flux(fbini) is at interface between fbini and fbini+1 + ! flux(fbini-1) is at interface between fbini-1 and fbini + div_v(fbini,node) = div_v(fbini,node) - (flx_v(fbini,node) - flx_v(fbini-1,node)) * inv_dphi(fbini) end do !$ACC END LOOP end do @@ -1858,6 +2003,13 @@ subroutine adv_Ecompart_flx2tra_spctrl( & #endif do edge=1, myDim_edge2D ednodes = edges(:,edge) + + +! if ((ednodes(1)==6 .or. ednodes(2) == 6) .and. partit%mype==226) then +! write(*,*) " critical edge index:", edge +! end if + + inv_fac1 = 1.0_WP/areasvol(1,ednodes(1)) inv_fac2 = 1.0_WP/areasvol(1,ednodes(2)) #ifndef ENABLE_OPENACC @@ -1878,7 +2030,9 @@ subroutine adv_Ecompart_flx2tra_spctrl( & #if !defined(DISABLE_OPENACC_ATOMICS) !$ACC ATOMIC UPDATE #endif - div_h(fbini,ednodes(1))=div_h(fbini,ednodes(1))+flx_h(fbini,edge)*inv_fac1*inv_dphi(fbini) + ! Horizontal divergence: flux/area (NO inv_dphi - that's only for cross-spectral!) + div_h(fbini,ednodes(1))=div_h(fbini,ednodes(1))+flx_h(fbini,edge)*inv_fac1 +! div_h(fbini,ednodes(1))=div_h(fbini,ednodes(1))-flx_h(fbini,edge)*inv_fac1 ! !___________________________________________________________________ ! horizontal flux contribution to ednode_2 @@ -1900,7 +2054,9 @@ subroutine adv_Ecompart_flx2tra_spctrl( & !$ACC ATOMIC UPDATE # endif #endif - div_h(fbini,ednodes(2))=div_h(fbini,ednodes(2))-flx_h(fbini,edge)*inv_fac2*inv_dphi(fbini) + ! Horizontal divergence: flux/area (NO inv_dphi - that's only for cross-spectral!) + div_h(fbini,ednodes(2))=div_h(fbini,ednodes(2))-flx_h(fbini,edge)*inv_fac2 +! div_h(fbini,ednodes(2))=div_h(fbini,ednodes(2))+flx_h(fbini,edge)*inv_fac2 end do #ifndef ENABLE_OPENACC # if defined(_OPENMP) && !defined(__openmp_reproducible) @@ -1947,6 +2103,7 @@ subroutine hsintegrate_Ecompart( & , gradxy_n & , flx_uv & , flx_cs & + , cflcs & , edge_up_dn_tri & , partit & , mesh & @@ -1955,6 +2112,7 @@ subroutine hsintegrate_Ecompart( & , Eadvs & , Ediss & , Eforc & + , glon,glat & ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ @@ -1966,7 +2124,7 @@ subroutine hsintegrate_Ecompart( & real(kind=WP) , intent(inout) :: Edivh( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(inout) :: Edivs( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: vel( 2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) - real(kind=WP) , intent(in ) :: w( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: w( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: forc( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: tauE( partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(inout) :: gradxy_e(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) @@ -1974,6 +2132,7 @@ subroutine hsintegrate_Ecompart( & real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) real(kind=WP) , intent(inout) :: flx_uv( idemix2_nfbin, partit%myDim_edge2D) real(kind=WP) , intent(inout) :: flx_cs( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: cflcs( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) integer , intent(in ) :: edge_up_dn_tri(2 , partit%myDim_edge2D) real(kind=WP) , intent(inout), optional:: Edt( idemix2_nfbin, partit%myDim_nod2D) @@ -1981,6 +2140,10 @@ subroutine hsintegrate_Ecompart( & real(kind=WP) , intent(inout), optional:: Eadvs( idemix2_nfbin, partit%myDim_nod2D) real(kind=WP) , intent(inout), optional:: Ediss( idemix2_nfbin, partit%myDim_nod2D) real(kind=WP) , intent(inout), optional:: Eforc( idemix2_nfbin, partit%myDim_nod2D) + + real(kind=WP) , intent(in) , optional:: glon(partit%myDim_nod2D+partit%eDim_nod2D),glat(partit%myDim_nod2D+partit%eDim_nod2D) + + real(kind=WP) :: mval !___LOCAL VARIABLES_____________________________________________________ integer :: node, fbini, nfbin #include "../associate_part_def.h" @@ -1991,10 +2154,18 @@ subroutine hsintegrate_Ecompart( & nfbin=idemix2_nfbin !_______________________________________________________________________ - ! compute gradient of iwe2_E_M2 on nodes is need for - call tracer_gradient_elements(E(ti,:,:), gradxy_e, partit, mesh, .False.) - call exchange_elem_fbin(gradxy_e, partit) + ! Exchange energy at ghost nodes before advection + ! Exchange all 3 time levels (minimal overhead, avoids array slicing issues) + call exchange_nod_fbin(E, partit) + + !_______________________________________________________________________ + ! compute gradient of iwe2_E_M2 on nodes is need for + call tracer_gradient_elements(E(ti,:,:), gradxy_e, partit, mesh, .False.) + call exchange_elem_fbin(gradxy_e, partit) call interp_e2n(gradxy_e, gradxy_n, mesh, partit, .False.) + call exchange_nod_fbin(gradxy_n, partit) + + ! compute horizontal superbee advected tracer flux call adv_Ecompart_hor_spctrl_superbee( & vel , & @@ -2005,10 +2176,9 @@ subroutine hsintegrate_Ecompart( & partit , & mesh , & edge_up_dn_tri , & - .False. , & ! do 2nd order in space & time - .True. & ! enforce positive definit + .True. , & ! do 2nd order in space & time + .True. & ! enforce positive definit ) -! if ( any(flx_uv/=flx_uv) ) write(*,*) " }-)))d°> found NaN in flx_uv" ! compute cross spectral superbee advected tracer flux call adv_Ecompart_crss_spctrl_superbee( & @@ -2016,12 +2186,12 @@ subroutine hsintegrate_Ecompart( & E(ti,:,:) , & dphit , & flx_cs , & + cflcs , & partit , & mesh , & - .False. , & ! do 2nd order in space & time - .True. & ! enforce positive definit - ) -! if (any(flx_cs/=flx_cs)) write(*,*) " }-)))d°> found NaN in flx_w" + .True. , & ! do 2nd order in space & time + .True. & ! enforce positive definit + ) ! compute flux divergence call adv_Ecompart_flx2tra_spctrl( & @@ -2049,31 +2219,66 @@ subroutine hsintegrate_Ecompart( & ! └> this part added in wave-wave-interaction ! T_niw + W_niw = -1/tau_niw * E_niw ! --> here variable tauE is already 1/tau - do node= 1, myDim_nod2d + do node= 1, myDim_nod2d+eDim_nod2D do fbini=2,nfbin-1 - E(tip1, fbini, node) = E(ti, fbini, node) & - + dt * (+ (1.5+idemix2_AB_epsilon)*Edivh(ti , fbini, node) & ! div(c_uv*E_M2^n) - - (0.5+idemix2_AB_epsilon)*Edivh(tim1, fbini, node) & ! div(c_uv*E_M2^n) - + (1.5+idemix2_AB_epsilon)*Edivs(ti , fbini, node) & ! d/dphi (dphit/dt*E_M2) - - (0.5+idemix2_AB_epsilon)*Edivs(tim1, fbini, node) & ! d/dphi (dphit/dt*E_M2) - + forc( fbini, node) & ! forc - - tauE(node)*E( ti , fbini, node) & ! diss - ) + ! Check if this is the first timestep (previous divergence is zero) +! if (abs(Edivh(tim1, fbini, node)) < 1.0e-20_WP .and. abs(Edivs(tim1, fbini, node)) < 1.0e-20_WP) then + ! First timestep: use forward Euler to avoid Adams-Bashforth amplification + E(tip1, fbini, node) = E(ti, fbini, node) & + + dt * (+ Edivh(ti , fbini, node) & ! div(c_uv*E_M2^n) + + Edivs(ti , fbini, node) & ! d/dphi (dphit/dt*E_M2) + + forc( fbini, node) & ! forc + - tauE(node)*E( ti , fbini, node) & ! diss + ) +! else +! ! Subsequent timesteps: use Adams-Bashforth +! E(tip1, fbini, node) = E(ti, fbini, node) & +! + dt * (+ (1.5+idemix2_AB_epsilon)*Edivh(ti , fbini, node) & ! div(c_uv*E_M2^n) +! - (0.5+idemix2_AB_epsilon)*Edivh(tim1, fbini, node) & ! div(c_uv*E_M2^n) +! + (1.5+idemix2_AB_epsilon)*Edivs(ti , fbini, node) & ! d/dphi (dphit/dt*E_M2) +! - (0.5+idemix2_AB_epsilon)*Edivs(tim1, fbini, node) & ! d/dphi (dphit/dt*E_M2) +! + forc( fbini, node) & ! forc +! - tauE(node)*E( ti , fbini, node) & ! diss +! ) +! endif if (E(tip1, fbini, node)/=E(tip1, fbini, node) .or. E(tip1, fbini, node)<0.0_WP) then write(*,*) " }-))))°> found negative/NaN " ,trim(Ename)," advection", E(tip1, fbini, node) - write(*,*) " tip1, fbini, node = ", tip1, fbini, node + write(*,*) " tip1, fbini, node, myDim_nod2D = ", tip1, fbini, node, myDim_nod2D + write(*,*) " mype = ", mype + write(*,*) " glon, glat = ", glon(node)/rad, glat(node)/rad write(*,*) " E(ti , fbini, node) = ", E(ti , fbini, node) write(*,*) " E(tip1, fbini, node) = ", E(tip1, fbini, node) write(*,*) " dt*forc = ", dt*forc(fbini, node) - write(*,*) " -dt*tau*E = ", -dt*tauE(node)*E( ti , fbini, node) - write(*,*) " dt*Edivh(t), (t-1) = ", dt*Edivh(ti , fbini, node), dt*Edivh(tim1 , fbini, node) - write(*,*) " dt*Edivh_AB = ", dt*( (1.5+idemix2_AB_epsilon)*Edivh(ti , fbini, node) - (0.5+idemix2_AB_epsilon)*Edivh(tim1, fbini, node)) - write(*,*) " dt*Edivs(t), (t-1) = ", dt*Edivs(ti , fbini, node), dt*Edivs(tim1 , fbini, node) - write(*,*) " dt*Edivs_AB = ", dt*( (1.5+idemix2_AB_epsilon)*Edivs(ti , fbini, node) - (0.5+idemix2_AB_epsilon)*Edivs(tim1, fbini, node)) - write(*,*) " W = ", w(:, node) + write(*,*) " -dt*tau*E = ", -dt*tauE(node)*E( ti , fbini, node) + write(*,*) " dt*Edivh(t) = ", dt*Edivh(ti , fbini, node)!, dt*Edivh(tim1 , fbini, node) +! write(*,*) " dt*Edivh_AB q = ", dt*( (1.5+idemix2_AB_epsilon)*Edivh(ti , fbini, node) - (0.5+idemix2_AB_epsilon)*Edivh(tim1, fbini, node)) + write(*,*) " dt*Edivs(t) = ", dt*Edivs(ti , fbini, node)!, dt*Edivs(tim1 , fbini, node) +! write(*,*) " dt*Edivs_AB = ", dt*( (1.5+idemix2_AB_epsilon)*Edivs(ti , fbini, node) - (0.5+idemix2_AB_epsilon)*Edivs(tim1, fbini, node)) + write(*,*) +! write(*,*) " E(fbin-1,fbin,fbin+1) = ", E(ti,fbini-1, node), E(ti,fbini, node), E(ti,fbini-1, node) +! write(*,*) " W(fbin-1,fbin,fbin+1) = ", w(fbini-1, node), w(fbini, node), w(fbini-1, node) +! write(*,*) " CFLcs(fbin-1,fbin,fbin+1)= ", cflcs(fbini-1, node),cflcs(fbini, node),cflcs(fbini+1, node) +! write(*,*) +! write(*,*) " E = ", E(ti,:, node) +! write(*,*) " W = ", w(:, node), w(fbini, node), w(fbini-1, node) +! write(*,*) " CFLcs = ", cflcs(:, node) end if - end do + + ! ATTENTION: + ! This line ensures that the compartment energy is always numerically + ! positive, clip off negative values due to rounding error ! + ! BUT this line will also hide a lot of bugs if there are some. + ! If you suspect bugs in the code of the Energy compartment + ! integration comment this line. + E(tip1, fbini, node) = max(0.0_WP, E(tip1, fbini, node)) + end do + + !___________________________________________________________________ + ! Fill ghost cells with periodic boundary values, ensure periodic wrapping + ! in specrtal domain, + E(tip1, 1, node) = E(tip1, nfbin-1, node) ! left ghost = right interior + E(tip1, nfbin, node) = E(tip1, 2, node) ! right ghost = left interior end do diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index a757d7044..728ad5ece 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1329,12 +1329,18 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_alpha_c' , 'Eiw dissipation coefficien' , 'none' , iwe2_alpha_c(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( elem2D , myDim_elem2D , 'iwe2_fbot' , 'bottom forcing' , 'm^3/s^3', iwe2_fbot_e(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_fsrf' , 'surface forcing' , 'm^3/s^3', iwe2_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - + call def_stream( nod2d , myDim_nod2D , 'iwe2_cn' , 'baroclinic velocity' , 'm/s' , iwe2_cn(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_e' , 'baroclinic velocity elem' , 'm/s' , iwe2_cn_e(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_gradx', 'gradx baroclinic velocity' , '1/s' , iwe2_cn_gradx(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_grady', 'grady baroclinic velocity' , '1/s' , iwe2_cn_grady(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + + if (idemix2_enable_M2) then call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_alphac' , 'M2 energy dissipation' , 'none' , iwe2_alpha_M2_c(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_tau' , 'M2 dissipation timescale' , 's' , iwe2_M2_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_forc' , 'M2 forcing' , 'm^3/s^3/rad', iwe2_fM2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_w' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_w_e' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w_e(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_u' , 'M2 zonal propag.' , 'm/s' , iwe2_M2_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_v' , 'M2 merid. propag.' , 'm/s' , iwe2_M2_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2' , 'M2 wave energy' , 'm^2/s^2' , iwe2_E_M2( iwe2_taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1353,6 +1359,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_niw_tau' , 'niw dissipation timescale' , 's' , iwe2_niw_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_forc' , 'niw forcing' , 'm^3/s^3/rad', iwe2_fniw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_w' , 'niw cross. spectr. propag.' , 'rad/s' , iwe2_niw_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_w_e' , 'niw cross. spectr. propag.' , 'rad/s' , iwe2_niw_w_e(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_u' , 'niw zonal propag.' , 'm/s' , iwe2_niw_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_v' , 'niw merid. propag.' , 'm/s' , iwe2_niw_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw' , 'niw wave energy' , 'm^2/s^2' , iwe2_E_niw( iwe2_taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) From 13d14a96505c3a56f3b6ed067d56beb61516ab0e Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 22 May 2026 16:48:36 +0200 Subject: [PATCH 26/63] fix halo exchange for cross-spectral data --- src/MOD_PARTIT.F90 | 4 +- src/associate_part_ass.h | 20 +- src/gen_halo_exchange.F90 | 140 +++++----- src/gen_modules_partitioning.F90 | 459 +++++++++++++++---------------- 4 files changed, 297 insertions(+), 326 deletions(-) diff --git a/src/MOD_PARTIT.F90 b/src/MOD_PARTIT.F90 index d68f449ff..2f26b4b6d 100644 --- a/src/MOD_PARTIT.F90 +++ b/src/MOD_PARTIT.F90 @@ -87,9 +87,9 @@ module MOD_PARTIT integer, allocatable :: s_mpitype_nod3D(:,:,:), r_mpitype_nod3D(:,:,:) ! Spectral bin (fbin) fields for IDEMIX2 halo exchange - ! The first dimension is the number of spectral bins (nfbin) instead of vertical levels. + ! Full spectral column exchanged at once (like standard nod3D exchanges full depth column). ! Nodal fields: (peer, nfbin:nfbin, n_val) with n_val=1..3 - ! Element fields: (peer, nfbin:nfbin, n_val) with n_val=1..4, small halo and full halo + ! Element fields: (peer, nfbin:nfbin) for 2D, (peer, nfbin:nfbin, n_val) for 3D with n_val=1..4 integer :: nfbin_mpi = 0 ! number of spectral bins for MPI types (0 = not initialized) integer, allocatable :: s_mpitype_nod3D_fbin(:,:,:), r_mpitype_nod3D_fbin(:,:,:) integer, allocatable :: s_mpitype_elem2D_fbin(:,:), r_mpitype_elem2D_fbin(:,:) diff --git a/src/associate_part_ass.h b/src/associate_part_ass.h index 39a25bd35..da4d03e51 100644 --- a/src/associate_part_ass.h +++ b/src/associate_part_ass.h @@ -73,14 +73,14 @@ end if nfbin_mpi => partit%nfbin_mpi if (allocated(partit%s_mpitype_nod3D_fbin)) then - s_mpitype_nod3D_fbin( 1:com_nod2D%sPEnum , 1:nfbin_mpi, 1:3) => partit%s_mpitype_nod3D_fbin( :,:,:) - r_mpitype_nod3D_fbin( 1:com_nod2D%rPEnum , 1:nfbin_mpi, 1:3) => partit%r_mpitype_nod3D_fbin( :,:,:) - s_mpitype_elem2D_fbin( 1:com_elem2D%sPEnum , 1:nfbin_mpi ) => partit%s_mpitype_elem2D_fbin( :,:) - r_mpitype_elem2D_fbin( 1:com_elem2D%rPEnum , 1:nfbin_mpi ) => partit%r_mpitype_elem2D_fbin( :,:) - s_mpitype_elem2D_full_fbin(1:com_elem2D_full%sPEnum, 1:nfbin_mpi ) => partit%s_mpitype_elem2D_full_fbin( :,:) - r_mpitype_elem2D_full_fbin(1:com_elem2D_full%rPEnum, 1:nfbin_mpi ) => partit%r_mpitype_elem2D_full_fbin( :,:) - s_mpitype_elem3D_fbin( 1:com_elem2D%sPEnum , 1:nfbin_mpi, 1:4) => partit%s_mpitype_elem3D_fbin( :,:,:) - r_mpitype_elem3D_fbin( 1:com_elem2D%rPEnum , 1:nfbin_mpi, 1:4) => partit%r_mpitype_elem3D_fbin( :,:,:) - s_mpitype_elem3D_full_fbin(1:com_elem2D_full%sPEnum, 1:nfbin_mpi, 1:4) => partit%s_mpitype_elem3D_full_fbin(:,:,:) - r_mpitype_elem3D_full_fbin(1:com_elem2D_full%rPEnum, 1:nfbin_mpi, 1:4) => partit%r_mpitype_elem3D_full_fbin(:,:,:) + s_mpitype_nod3D_fbin( 1:com_nod2D%sPEnum , nfbin_mpi:nfbin_mpi, 1:3) => partit%s_mpitype_nod3D_fbin( :,:,:) + r_mpitype_nod3D_fbin( 1:com_nod2D%rPEnum , nfbin_mpi:nfbin_mpi, 1:3) => partit%r_mpitype_nod3D_fbin( :,:,:) + s_mpitype_elem2D_fbin( 1:com_elem2D%sPEnum , nfbin_mpi:nfbin_mpi ) => partit%s_mpitype_elem2D_fbin( :,:) + r_mpitype_elem2D_fbin( 1:com_elem2D%rPEnum , nfbin_mpi:nfbin_mpi ) => partit%r_mpitype_elem2D_fbin( :,:) + s_mpitype_elem2D_full_fbin(1:com_elem2D_full%sPEnum, nfbin_mpi:nfbin_mpi ) => partit%s_mpitype_elem2D_full_fbin( :,:) + r_mpitype_elem2D_full_fbin(1:com_elem2D_full%rPEnum, nfbin_mpi:nfbin_mpi ) => partit%r_mpitype_elem2D_full_fbin( :,:) + s_mpitype_elem3D_fbin( 1:com_elem2D%sPEnum , nfbin_mpi:nfbin_mpi, 1:4) => partit%s_mpitype_elem3D_fbin( :,:,:) + r_mpitype_elem3D_fbin( 1:com_elem2D%rPEnum , nfbin_mpi:nfbin_mpi, 1:4) => partit%r_mpitype_elem3D_fbin( :,:,:) + s_mpitype_elem3D_full_fbin(1:com_elem2D_full%sPEnum, nfbin_mpi:nfbin_mpi, 1:4) => partit%s_mpitype_elem3D_full_fbin(:,:,:) + r_mpitype_elem3D_full_fbin(1:com_elem2D_full%rPEnum, nfbin_mpi:nfbin_mpi, 1:4) => partit%r_mpitype_elem3D_full_fbin(:,:,:) end if \ No newline at end of file diff --git a/src/gen_halo_exchange.F90 b/src/gen_halo_exchange.F90 index adf8a84b5..33be86d05 100755 --- a/src/gen_halo_exchange.F90 +++ b/src/gen_halo_exchange.F90 @@ -2990,7 +2990,7 @@ subroutine exchange_nod2D_fbin_begin(nod_array, partit) IMPLICIT NONE type(t_partit), intent(inout), target :: partit real(real64), intent(inout) :: nod_array(:,:) -integer :: n, sn, rn, i +integer :: n, sn, rn #include "associate_part_def.h" #include "associate_part_ass.h" @@ -3003,19 +3003,17 @@ subroutine exchange_nod2D_fbin_begin(nod_array, partit) sn=com_nod2D%sPEnum rn=com_nod2D%rPEnum - ! Exchange all spectral bins - DO i=1,nfbin_mpi - DO n=1,rn - call MPI_IRECV(nod_array, 1, r_mpitype_nod3D_fbin(n,i,1), com_nod2D%rPE(n), & - com_nod2D%rPE(n), MPI_COMM_FESOM, com_nod2D%req(n), MPIerr) - END DO - DO n=1, sn - call MPI_ISEND(nod_array, 1, s_mpitype_nod3D_fbin(n,i,1), com_nod2D%sPE(n), & - mype, MPI_COMM_FESOM, com_nod2D%req(rn+n), MPIerr) - END DO - com_nod2D%nreq = rn+sn - call MPI_WAITALL(com_nod2D%nreq, com_nod2D%req, MPI_STATUSES_IGNORE, MPIerr) + ! Exchange full spectral column at once (n_val=1 for 2D array) + DO n=1,rn + call MPI_IRECV(nod_array, 1, r_mpitype_nod3D_fbin(n,nfbin_mpi,1), com_nod2D%rPE(n), & + com_nod2D%rPE(n), MPI_COMM_FESOM, com_nod2D%req(n), MPIerr) END DO + DO n=1, sn + call MPI_ISEND(nod_array, 1, s_mpitype_nod3D_fbin(n,nfbin_mpi,1), com_nod2D%sPE(n), & + mype, MPI_COMM_FESOM, com_nod2D%req(rn+n), MPIerr) + END DO + com_nod2D%nreq = rn+sn + call MPI_WAITALL(com_nod2D%nreq, com_nod2D%req, MPI_STATUSES_IGNORE, MPIerr) endif END SUBROUTINE exchange_nod2D_fbin_begin @@ -3042,7 +3040,7 @@ subroutine exchange_nod3D_fbin_begin(nod_array, partit) IMPLICIT NONE type(t_partit), intent(inout), target :: partit real(real64), intent(inout) :: nod_array(:,:,:) -integer :: n, sn, rn, n_val, i +integer :: n, sn, rn, n_val #include "associate_part_def.h" #include "associate_part_ass.h" @@ -3062,19 +3060,17 @@ subroutine exchange_nod3D_fbin_begin(nod_array, partit) sn=com_nod2D%sPEnum rn=com_nod2D%rPEnum - ! Exchange all spectral bins - DO i=1,nfbin_mpi - DO n=1,rn - call MPI_IRECV(nod_array, 1, r_mpitype_nod3D_fbin(n,i,n_val), com_nod2D%rPE(n), & - com_nod2D%rPE(n), MPI_COMM_FESOM, com_nod2D%req(n), MPIerr) - END DO - DO n=1, sn - call MPI_ISEND(nod_array, 1, s_mpitype_nod3D_fbin(n,i,n_val), com_nod2D%sPE(n), & - mype, MPI_COMM_FESOM, com_nod2D%req(rn+n), MPIerr) - END DO - com_nod2D%nreq = rn+sn - call MPI_WAITALL(com_nod2D%nreq, com_nod2D%req, MPI_STATUSES_IGNORE, MPIerr) + ! Exchange full spectral column at once + DO n=1,rn + call MPI_IRECV(nod_array, 1, r_mpitype_nod3D_fbin(n,nfbin_mpi,n_val), com_nod2D%rPE(n), & + com_nod2D%rPE(n), MPI_COMM_FESOM, com_nod2D%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(nod_array, 1, s_mpitype_nod3D_fbin(n,nfbin_mpi,n_val), com_nod2D%sPE(n), & + mype, MPI_COMM_FESOM, com_nod2D%req(rn+n), MPIerr) END DO + com_nod2D%nreq = rn+sn + call MPI_WAITALL(com_nod2D%nreq, com_nod2D%req, MPI_STATUSES_IGNORE, MPIerr) endif END SUBROUTINE exchange_nod3D_fbin_begin @@ -3104,7 +3100,7 @@ subroutine exchange_elem2D_fbin_begin(elem_array, partit) IMPLICIT NONE type(t_partit), intent(inout), target :: partit real(real64), intent(inout) :: elem_array(:,:) -integer :: n, sn, rn, i +integer :: n, sn, rn #include "associate_part_def.h" #include "associate_part_ass.h" @@ -3120,38 +3116,34 @@ subroutine exchange_elem2D_fbin_begin(elem_array, partit) sn=com_elem2D%sPEnum rn=com_elem2D%rPEnum - ! Exchange all spectral bins - DO i=1,nfbin_mpi - DO n=1,rn - call MPI_IRECV(elem_array, 1, r_mpitype_elem2D_fbin(n,i), com_elem2D%rPE(n), & - com_elem2D%rPE(n), MPI_COMM_FESOM, com_elem2D%req(n), MPIerr) - END DO - DO n=1, sn - call MPI_ISEND(elem_array, 1, s_mpitype_elem2D_fbin(n,i), com_elem2D%sPE(n), & - mype, MPI_COMM_FESOM, com_elem2D%req(rn+n), MPIerr) - END DO - com_elem2D%nreq = rn+sn - call MPI_WAITALL(com_elem2D%nreq, com_elem2D%req, MPI_STATUSES_IGNORE, MPIerr) + ! Exchange full spectral column at once + DO n=1,rn + call MPI_IRECV(elem_array, 1, r_mpitype_elem2D_fbin(n,nfbin_mpi), com_elem2D%rPE(n), & + com_elem2D%rPE(n), MPI_COMM_FESOM, com_elem2D%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(elem_array, 1, s_mpitype_elem2D_fbin(n,nfbin_mpi), com_elem2D%sPE(n), & + mype, MPI_COMM_FESOM, com_elem2D%req(rn+n), MPIerr) END DO + com_elem2D%nreq = rn+sn + call MPI_WAITALL(com_elem2D%nreq, com_elem2D%req, MPI_STATUSES_IGNORE, MPIerr) else ! full halo elem_full_flag = .true. sn=com_elem2D_full%sPEnum rn=com_elem2D_full%rPEnum - ! Exchange all spectral bins - DO i=1,nfbin_mpi - DO n=1,rn - call MPI_IRECV(elem_array, 1, r_mpitype_elem2D_full_fbin(n,i), com_elem2D_full%rPE(n), & - com_elem2D_full%rPE(n), MPI_COMM_FESOM, com_elem2D_full%req(n), MPIerr) - END DO - DO n=1, sn - call MPI_ISEND(elem_array, 1, s_mpitype_elem2D_full_fbin(n,i), com_elem2D_full%sPE(n), & - mype, MPI_COMM_FESOM, com_elem2D_full%req(rn+n), MPIerr) - END DO - com_elem2D_full%nreq = rn+sn - call MPI_WAITALL(com_elem2D_full%nreq, com_elem2D_full%req, MPI_STATUSES_IGNORE, MPIerr) + ! Exchange full spectral column at once + DO n=1,rn + call MPI_IRECV(elem_array, 1, r_mpitype_elem2D_full_fbin(n,nfbin_mpi), com_elem2D_full%rPE(n), & + com_elem2D_full%rPE(n), MPI_COMM_FESOM, com_elem2D_full%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(elem_array, 1, s_mpitype_elem2D_full_fbin(n,nfbin_mpi), com_elem2D_full%sPE(n), & + mype, MPI_COMM_FESOM, com_elem2D_full%req(rn+n), MPIerr) END DO + com_elem2D_full%nreq = rn+sn + call MPI_WAITALL(com_elem2D_full%nreq, com_elem2D_full%req, MPI_STATUSES_IGNORE, MPIerr) endif endif END SUBROUTINE exchange_elem2D_fbin_begin @@ -3182,7 +3174,7 @@ subroutine exchange_elem3D_fbin_begin(elem_array, partit) IMPLICIT NONE type(t_partit), intent(inout), target :: partit real(real64), intent(inout) :: elem_array(:,:,:) -integer :: n, sn, rn, n_val, i +integer :: n, sn, rn, n_val #include "associate_part_def.h" #include "associate_part_ass.h" @@ -3205,38 +3197,34 @@ subroutine exchange_elem3D_fbin_begin(elem_array, partit) sn=com_elem2D%sPEnum rn=com_elem2D%rPEnum - ! Exchange all spectral bins - DO i=1,nfbin_mpi - DO n=1,rn - call MPI_IRECV(elem_array, 1, r_mpitype_elem3D_fbin(n,i,n_val), com_elem2D%rPE(n), & - com_elem2D%rPE(n), MPI_COMM_FESOM, com_elem2D%req(n), MPIerr) - END DO - DO n=1, sn - call MPI_ISEND(elem_array, 1, s_mpitype_elem3D_fbin(n,i,n_val), com_elem2D%sPE(n), & - mype, MPI_COMM_FESOM, com_elem2D%req(rn+n), MPIerr) - END DO - com_elem2D%nreq = rn+sn - call MPI_WAITALL(com_elem2D%nreq, com_elem2D%req, MPI_STATUSES_IGNORE, MPIerr) + ! Exchange full spectral column at once + DO n=1,rn + call MPI_IRECV(elem_array, 1, r_mpitype_elem3D_fbin(n,nfbin_mpi,n_val), com_elem2D%rPE(n), & + com_elem2D%rPE(n), MPI_COMM_FESOM, com_elem2D%req(n), MPIerr) END DO + DO n=1, sn + call MPI_ISEND(elem_array, 1, s_mpitype_elem3D_fbin(n,nfbin_mpi,n_val), com_elem2D%sPE(n), & + mype, MPI_COMM_FESOM, com_elem2D%req(rn+n), MPIerr) + END DO + com_elem2D%nreq = rn+sn + call MPI_WAITALL(com_elem2D%nreq, com_elem2D%req, MPI_STATUSES_IGNORE, MPIerr) else ! full halo elem_full_flag = .true. sn=com_elem2D_full%sPEnum rn=com_elem2D_full%rPEnum - ! Exchange all spectral bins - DO i=1,nfbin_mpi - DO n=1,rn - call MPI_IRECV(elem_array, 1, r_mpitype_elem3D_full_fbin(n,i,n_val), com_elem2D_full%rPE(n), & - com_elem2D_full%rPE(n), MPI_COMM_FESOM, com_elem2D_full%req(n), MPIerr) - END DO - DO n=1, sn - call MPI_ISEND(elem_array, 1, s_mpitype_elem3D_full_fbin(n,i,n_val), com_elem2D_full%sPE(n), & - mype, MPI_COMM_FESOM, com_elem2D_full%req(rn+n), MPIerr) - END DO - com_elem2D_full%nreq = rn+sn - call MPI_WAITALL(com_elem2D_full%nreq, com_elem2D_full%req, MPI_STATUSES_IGNORE, MPIerr) + ! Exchange full spectral column at once + DO n=1,rn + call MPI_IRECV(elem_array, 1, r_mpitype_elem3D_full_fbin(n,nfbin_mpi,n_val), com_elem2D_full%rPE(n), & + com_elem2D_full%rPE(n), MPI_COMM_FESOM, com_elem2D_full%req(n), MPIerr) + END DO + DO n=1, sn + call MPI_ISEND(elem_array, 1, s_mpitype_elem3D_full_fbin(n,nfbin_mpi,n_val), com_elem2D_full%sPE(n), & + mype, MPI_COMM_FESOM, com_elem2D_full%req(rn+n), MPIerr) END DO + com_elem2D_full%nreq = rn+sn + call MPI_WAITALL(com_elem2D_full%nreq, com_elem2D_full%req, MPI_STATUSES_IGNORE, MPIerr) endif endif END SUBROUTINE exchange_elem3D_fbin_begin diff --git a/src/gen_modules_partitioning.F90 b/src/gen_modules_partitioning.F90 index f079789e7..7c4161ff7 100644 --- a/src/gen_modules_partitioning.F90 +++ b/src/gen_modules_partitioning.F90 @@ -522,266 +522,249 @@ end subroutine init_mpi_types ! (number of spectral frequency bins) instead of nl (number of vertical levels). ! Must be called after init_mpi_types and before first spectral bin exchange. subroutine init_mpi_types_fbin(nfbin, partit) - USE MOD_PARTIT - USE MOD_PARSUP - implicit none + USE MOD_PARTIT + USE MOD_PARSUP + implicit none - integer, intent(in) :: nfbin - type(t_partit), intent(inout), target :: partit - integer :: n, n_val - integer :: i, max_nb, nb, nini, nend - integer, allocatable :: blocklen(:), displace(:) - integer, allocatable :: blocklen_tmp(:), displace_tmp(:) + integer, intent(in) :: nfbin + type(t_partit), intent(inout), target :: partit + integer :: n, n_val + integer :: i, max_nb, nb, nini, nend + integer, allocatable :: blocklen(:), displace(:) + integer, allocatable :: blocklen_tmp(:), displace_tmp(:) #include "associate_part_def.h" #include "associate_part_ass.h" - if (npes <= 1) return - - ! Store nfbin for runtime checks in exchange routines - partit%nfbin_mpi = nfbin - - !================================================================ - ! Allocate MPI datatype arrays for spectral bin exchange - !================================================================ - allocate(partit%r_mpitype_nod3D_fbin(com_nod2D%rPEnum, 1:nfbin, 3)) ! nodes, 1-3 values - allocate(partit%s_mpitype_nod3D_fbin(com_nod2D%sPEnum, 1:nfbin, 3)) - allocate(partit%r_mpitype_elem2D_fbin(com_elem2D%rPEnum, 1:nfbin)) ! elems 2D small halo - allocate(partit%s_mpitype_elem2D_fbin(com_elem2D%sPEnum, 1:nfbin)) - allocate(partit%r_mpitype_elem2D_full_fbin(com_elem2D_full%rPEnum, 1:nfbin)) ! elems 2D full halo - allocate(partit%s_mpitype_elem2D_full_fbin(com_elem2D_full%sPEnum, 1:nfbin)) - allocate(partit%r_mpitype_elem3D_fbin(com_elem2D%rPEnum, 1:nfbin, 4)) ! elems 3D small halo, 1-4 values - allocate(partit%s_mpitype_elem3D_fbin(com_elem2D%sPEnum, 1:nfbin, 4)) - allocate(partit%r_mpitype_elem3D_full_fbin(com_elem2D_full%rPEnum, 1:nfbin, 4)) ! elems 3D full halo - allocate(partit%s_mpitype_elem3D_full_fbin(com_elem2D_full%sPEnum, 1:nfbin, 4)) - - !================================================================ - ! Build MPI Data types for element fields (small halo) - !================================================================ - max_nb = max( & - maxval(com_elem2D%rptr(2:com_elem2D%rPEnum+1) - com_elem2D%rptr(1:com_elem2D%rPEnum)), & - maxval(com_elem2D%sptr(2:com_elem2D%sPEnum+1) - com_elem2D%sptr(1:com_elem2D%sPEnum)), & - maxval(com_elem2D_full%rptr(2:com_elem2D_full%rPEnum+1) - com_elem2D_full%rptr(1:com_elem2D_full%rPEnum)), & - maxval(com_elem2D_full%sptr(2:com_elem2D_full%sPEnum+1) - com_elem2D_full%sptr(1:com_elem2D_full%sPEnum))) - - allocate(displace(max_nb), blocklen(max_nb)) - allocate(displace_tmp(max_nb), blocklen_tmp(max_nb)) - - ! --- Receive types for elements (small halo) --- - do n=1,com_elem2D%rPEnum - nb = 1 - nini = com_elem2D%rptr(n) - nend = com_elem2D%rptr(n+1) - 1 - displace(:) = 0 - displace(1) = com_elem2D%rlist(nini) -1 - blocklen(:) = 1 - do i=nini+1, nend - if (com_elem2D%rlist(i) /= com_elem2D%rlist(i-1) + 1) then - nb = nb+1 - displace(nb) = com_elem2D%rlist(i) -1 - else - blocklen(nb) = blocklen(nb)+1 - endif - enddo - ! 2D fbin types: one for each spectral bin - DO i=1,nfbin - blocklen_tmp(1:nb) = blocklen(1:nb) - displace_tmp(1:nb) = displace(1:nb)*nfbin + (i-1) + if (npes <= 1) return + + ! Store nfbin for runtime checks in exchange routines + partit%nfbin_mpi = nfbin + + !================================================================ + ! Allocate MPI datatype arrays for spectral bin exchange + ! Full spectral column exchanged at once (mirroring standard nod3D/elem3D pattern) + !================================================================ + allocate(partit%r_mpitype_nod3D_fbin( com_nod2D%rPEnum , nfbin:nfbin, 3)) ! nodes, nfbin bins, 1-3 values + allocate(partit%s_mpitype_nod3D_fbin( com_nod2D%sPEnum , nfbin:nfbin, 3)) + allocate(partit%r_mpitype_elem2D_fbin( com_elem2D%rPEnum , nfbin:nfbin )) ! elems 2D small halo + allocate(partit%s_mpitype_elem2D_fbin( com_elem2D%sPEnum , nfbin:nfbin )) + allocate(partit%r_mpitype_elem2D_full_fbin(com_elem2D_full%rPEnum, nfbin:nfbin )) ! elems 2D full halo + allocate(partit%s_mpitype_elem2D_full_fbin(com_elem2D_full%sPEnum, nfbin:nfbin )) + allocate(partit%r_mpitype_elem3D_fbin( com_elem2D%rPEnum , nfbin:nfbin, 4)) ! elems 3D small halo, 1-4 values + allocate(partit%s_mpitype_elem3D_fbin( com_elem2D%sPEnum , nfbin:nfbin, 4)) + allocate(partit%r_mpitype_elem3D_full_fbin(com_elem2D_full%rPEnum, nfbin:nfbin, 4)) ! elems 3D full halo + allocate(partit%s_mpitype_elem3D_full_fbin(com_elem2D_full%sPEnum, nfbin:nfbin, 4)) + + !================================================================ + ! Build MPI Data types for element fields (small halo) + !================================================================ + max_nb = max( & + maxval(com_elem2D%rptr( 2:com_elem2D%rPEnum+1 ) - com_elem2D%rptr( 1:com_elem2D%rPEnum )), & + maxval(com_elem2D%sptr( 2:com_elem2D%sPEnum+1 ) - com_elem2D%sptr( 1:com_elem2D%sPEnum )), & + maxval(com_elem2D_full%rptr(2:com_elem2D_full%rPEnum+1) - com_elem2D_full%rptr(1:com_elem2D_full%rPEnum)), & + maxval(com_elem2D_full%sptr(2:com_elem2D_full%sPEnum+1) - com_elem2D_full%sptr(1:com_elem2D_full%sPEnum))) + + allocate(displace(max_nb), blocklen(max_nb)) + allocate(displace_tmp(max_nb), blocklen_tmp(max_nb)) + + ! --- Receive types for elements (small halo) --- + do n=1,com_elem2D%rPEnum + nb = 1 + nini = com_elem2D%rptr(n) + nend = com_elem2D%rptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_elem2D%rlist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_elem2D%rlist(i) /= com_elem2D%rlist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_elem2D%rlist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! 2D fbin type: full spectral column at once (nfbin per element) + blocklen_tmp(1:nb) = blocklen(1:nb)*nfbin + displace_tmp(1:nb) = displace(1:nb)*nfbin call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%r_mpitype_elem2D_fbin(n,i), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%r_mpitype_elem2D_fbin(n,i), partit%MPIerr) - ENDDO - ! 3D fbin types: one for each spectral bin and n_val - DO i=1,nfbin + partit%r_mpitype_elem2D_fbin(n,nfbin), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_elem2D_fbin(n,nfbin), partit%MPIerr) + ! 3D fbin types: full spectral column, n_val values per bin DO n_val=1,4 - blocklen_tmp(1:nb) = blocklen(1:nb)*n_val - displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val - call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%r_mpitype_elem3D_fbin(n,i,n_val), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%r_mpitype_elem3D_fbin(n,i,n_val), partit%MPIerr) + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val*nfbin + displace_tmp(1:nb) = displace(1:nb)*n_val*nfbin + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%r_mpitype_elem3D_fbin(n,nfbin,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_elem3D_fbin(n,nfbin,n_val), partit%MPIerr) ENDDO - ENDDO - enddo - - ! --- Send types for elements (small halo) --- - do n=1,com_elem2D%sPEnum - nb = 1 - nini = com_elem2D%sptr(n) - nend = com_elem2D%sptr(n+1) - 1 - displace(:) = 0 - displace(1) = com_elem2D%slist(nini) -1 - blocklen(:) = 1 - do i=nini+1, nend - if (com_elem2D%slist(i) /= com_elem2D%slist(i-1) + 1) then - nb = nb+1 - displace(nb) = com_elem2D%slist(i) -1 - else - blocklen(nb) = blocklen(nb)+1 - endif - enddo - ! 2D fbin types: one for each spectral bin - DO i=1,nfbin - blocklen_tmp(1:nb) = blocklen(1:nb) - displace_tmp(1:nb) = displace(1:nb)*nfbin + (i-1) + enddo + + ! --- Send types for elements (small halo) --- + do n=1,com_elem2D%sPEnum + nb = 1 + nini = com_elem2D%sptr(n) + nend = com_elem2D%sptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_elem2D%slist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_elem2D%slist(i) /= com_elem2D%slist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_elem2D%slist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! 2D fbin type: full spectral column at once + blocklen_tmp(1:nb) = blocklen(1:nb)*nfbin + displace_tmp(1:nb) = displace(1:nb)*nfbin call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%s_mpitype_elem2D_fbin(n,i), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%s_mpitype_elem2D_fbin(n,i), partit%MPIerr) - ENDDO - ! 3D fbin types: one for each spectral bin and n_val - DO i=1,nfbin + partit%s_mpitype_elem2D_fbin(n,nfbin), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_elem2D_fbin(n,nfbin), partit%MPIerr) + ! 3D fbin types: full spectral column, n_val values per bin DO n_val=1,4 - blocklen_tmp(1:nb) = blocklen(1:nb)*n_val - displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val - call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%s_mpitype_elem3D_fbin(n,i,n_val), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%s_mpitype_elem3D_fbin(n,i,n_val), partit%MPIerr) + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val*nfbin + displace_tmp(1:nb) = displace(1:nb)*n_val*nfbin + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%s_mpitype_elem3D_fbin(n,nfbin,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_elem3D_fbin(n,nfbin,n_val), partit%MPIerr) ENDDO - ENDDO - enddo - - !================================================================ - ! Build MPI Data types for element fields (full halo) - !================================================================ - ! --- Receive types for elements (full halo) --- - do n=1,com_elem2D_full%rPEnum - nb = 1 - nini = com_elem2D_full%rptr(n) - nend = com_elem2D_full%rptr(n+1) - 1 - displace(:) = 0 - displace(1) = com_elem2D_full%rlist(nini) -1 - blocklen(:) = 1 - do i=nini+1, nend - if (com_elem2D_full%rlist(i) /= com_elem2D_full%rlist(i-1) + 1) then - nb = nb+1 - displace(nb) = com_elem2D_full%rlist(i) -1 - else - blocklen(nb) = blocklen(nb)+1 - endif - enddo - ! 2D fbin types: one for each spectral bin - DO i=1,nfbin - blocklen_tmp(1:nb) = blocklen(1:nb) - displace_tmp(1:nb) = displace(1:nb)*nfbin + (i-1) + enddo + + !================================================================ + ! Build MPI Data types for element fields (full halo) + !================================================================ + ! --- Receive types for elements (full halo) --- + do n=1,com_elem2D_full%rPEnum + nb = 1 + nini = com_elem2D_full%rptr(n) + nend = com_elem2D_full%rptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_elem2D_full%rlist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_elem2D_full%rlist(i) /= com_elem2D_full%rlist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_elem2D_full%rlist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! 2D fbin type: full spectral column at once + blocklen_tmp(1:nb) = blocklen(1:nb)*nfbin + displace_tmp(1:nb) = displace(1:nb)*nfbin call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%r_mpitype_elem2D_full_fbin(n,i), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%r_mpitype_elem2D_full_fbin(n,i), partit%MPIerr) - ENDDO - ! 3D fbin types: one for each spectral bin and n_val - DO i=1,nfbin + partit%r_mpitype_elem2D_full_fbin(n,nfbin), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_elem2D_full_fbin(n,nfbin), partit%MPIerr) + ! 3D fbin types: full spectral column, n_val values per bin DO n_val=1,4 - blocklen_tmp(1:nb) = blocklen(1:nb)*n_val - displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val - call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%r_mpitype_elem3D_full_fbin(n,i,n_val), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%r_mpitype_elem3D_full_fbin(n,i,n_val), partit%MPIerr) + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val*nfbin + displace_tmp(1:nb) = displace(1:nb)*n_val*nfbin + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%r_mpitype_elem3D_full_fbin(n,nfbin,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_elem3D_full_fbin(n,nfbin,n_val), partit%MPIerr) ENDDO - ENDDO - enddo - - ! --- Send types for elements (full halo) --- - do n=1,com_elem2D_full%sPEnum - nb = 1 - nini = com_elem2D_full%sptr(n) - nend = com_elem2D_full%sptr(n+1) - 1 - displace(:) = 0 - displace(1) = com_elem2D_full%slist(nini) -1 - blocklen(:) = 1 - do i=nini+1, nend - if (com_elem2D_full%slist(i) /= com_elem2D_full%slist(i-1) + 1) then - nb = nb+1 - displace(nb) = com_elem2D_full%slist(i) -1 - else - blocklen(nb) = blocklen(nb)+1 - endif - enddo - ! 2D fbin types: one for each spectral bin - DO i=1,nfbin - blocklen_tmp(1:nb) = blocklen(1:nb) - displace_tmp(1:nb) = displace(1:nb)*nfbin + (i-1) + enddo + + ! --- Send types for elements (full halo) --- + do n=1,com_elem2D_full%sPEnum + nb = 1 + nini = com_elem2D_full%sptr(n) + nend = com_elem2D_full%sptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_elem2D_full%slist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_elem2D_full%slist(i) /= com_elem2D_full%slist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_elem2D_full%slist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! 2D fbin type: full spectral column at once + blocklen_tmp(1:nb) = blocklen(1:nb)*nfbin + displace_tmp(1:nb) = displace(1:nb)*nfbin call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%s_mpitype_elem2D_full_fbin(n,i), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%s_mpitype_elem2D_full_fbin(n,i), partit%MPIerr) - ENDDO - ! 3D fbin types: one for each spectral bin and n_val - DO i=1,nfbin + partit%s_mpitype_elem2D_full_fbin(n,nfbin), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_elem2D_full_fbin(n,nfbin), partit%MPIerr) + ! 3D fbin types: full spectral column, n_val values per bin DO n_val=1,4 - blocklen_tmp(1:nb) = blocklen(1:nb)*n_val - displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val - call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%s_mpitype_elem3D_full_fbin(n,i,n_val), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%s_mpitype_elem3D_full_fbin(n,i,n_val), partit%MPIerr) + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val*nfbin + displace_tmp(1:nb) = displace(1:nb)*n_val*nfbin + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%s_mpitype_elem3D_full_fbin(n,nfbin,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_elem3D_full_fbin(n,nfbin,n_val), partit%MPIerr) ENDDO - ENDDO - enddo - - deallocate(displace, blocklen) - deallocate(displace_tmp, blocklen_tmp) - - !================================================================ - ! Build MPI Data types for nodal fields - !================================================================ - max_nb = max(maxval(com_nod2D%rptr(2:com_nod2D%rPEnum+1) - com_nod2D%rptr(1:com_nod2D%rPEnum)), & - maxval(com_nod2D%sptr(2:com_nod2D%sPEnum+1) - com_nod2D%sptr(1:com_nod2D%sPEnum))) - - allocate(displace(max_nb), blocklen(max_nb)) - allocate(displace_tmp(max_nb), blocklen_tmp(max_nb)) - - ! --- Receive types for nodes --- - do n=1,com_nod2D%rPEnum - nb = 1 - nini = com_nod2D%rptr(n) - nend = com_nod2D%rptr(n+1) - 1 - displace(:) = 0 - displace(1) = com_nod2D%rlist(nini) -1 - blocklen(:) = 1 - do i=nini+1, nend - if (com_nod2D%rlist(i) /= com_nod2D%rlist(i-1) + 1) then - nb = nb+1 - displace(nb) = com_nod2D%rlist(i) -1 - else - blocklen(nb) = blocklen(nb)+1 - endif - enddo - DO i=1,nfbin + enddo + + deallocate(displace, blocklen) + deallocate(displace_tmp, blocklen_tmp) + + !================================================================ + ! Build MPI Data types for nodal fields + !================================================================ + max_nb = max(maxval(com_nod2D%rptr(2:com_nod2D%rPEnum+1) - com_nod2D%rptr(1:com_nod2D%rPEnum)), & + maxval(com_nod2D%sptr(2:com_nod2D%sPEnum+1) - com_nod2D%sptr(1:com_nod2D%sPEnum))) + + allocate(displace(max_nb), blocklen(max_nb)) + allocate(displace_tmp(max_nb), blocklen_tmp(max_nb)) + + ! --- Receive types for nodes --- + do n=1,com_nod2D%rPEnum + nb = 1 + nini = com_nod2D%rptr(n) + nend = com_nod2D%rptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_nod2D%rlist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_nod2D%rlist(i) /= com_nod2D%rlist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_nod2D%rlist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! Full spectral column: n_val*nfbin contiguous elements per node DO n_val=1,3 - blocklen_tmp(1:nb) = blocklen(1:nb)*n_val - displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val - call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%r_mpitype_nod3D_fbin(n,i,n_val), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%r_mpitype_nod3D_fbin(n,i,n_val), partit%MPIerr) + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val*nfbin + displace_tmp(1:nb) = displace(1:nb)*n_val*nfbin + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%r_mpitype_nod3D_fbin(n,nfbin,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%r_mpitype_nod3D_fbin(n,nfbin,n_val), partit%MPIerr) ENDDO - ENDDO - enddo - - ! --- Send types for nodes --- - do n=1,com_nod2D%sPEnum - nb = 1 - nini = com_nod2D%sptr(n) - nend = com_nod2D%sptr(n+1) - 1 - displace(:) = 0 - displace(1) = com_nod2D%slist(nini) -1 - blocklen(:) = 1 - do i=nini+1, nend - if (com_nod2D%slist(i) /= com_nod2D%slist(i-1) + 1) then - nb = nb+1 - displace(nb) = com_nod2D%slist(i) -1 - else - blocklen(nb) = blocklen(nb)+1 - endif - enddo - DO i=1,nfbin + enddo + + ! --- Send types for nodes --- + do n=1,com_nod2D%sPEnum + nb = 1 + nini = com_nod2D%sptr(n) + nend = com_nod2D%sptr(n+1) - 1 + displace(:) = 0 + displace(1) = com_nod2D%slist(nini) -1 + blocklen(:) = 1 + do i=nini+1, nend + if (com_nod2D%slist(i) /= com_nod2D%slist(i-1) + 1) then + nb = nb+1 + displace(nb) = com_nod2D%slist(i) -1 + else + blocklen(nb) = blocklen(nb)+1 + endif + enddo + ! Full spectral column: n_val*nfbin contiguous elements per node DO n_val=1,3 - blocklen_tmp(1:nb) = blocklen(1:nb)*n_val - displace_tmp(1:nb) = (displace(1:nb)*nfbin + (i-1))*n_val - call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & - partit%s_mpitype_nod3D_fbin(n,i,n_val), partit%MPIerr) - call MPI_TYPE_COMMIT(partit%s_mpitype_nod3D_fbin(n,i,n_val), partit%MPIerr) + blocklen_tmp(1:nb) = blocklen(1:nb)*n_val*nfbin + displace_tmp(1:nb) = displace(1:nb)*n_val*nfbin + call MPI_TYPE_INDEXED(nb, blocklen_tmp, displace_tmp, MPI_DOUBLE_PRECISION, & + partit%s_mpitype_nod3D_fbin(n,nfbin,n_val), partit%MPIerr) + call MPI_TYPE_COMMIT(partit%s_mpitype_nod3D_fbin(n,nfbin,n_val), partit%MPIerr) ENDDO - ENDDO - enddo + enddo - deallocate(blocklen, displace) - deallocate(blocklen_tmp, displace_tmp) + deallocate(blocklen, displace) + deallocate(blocklen_tmp, displace_tmp) end subroutine init_mpi_types_fbin !=================================================================== From b9754092f588d573bf0d1ef3247b315e1c013ada Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 22 May 2026 16:52:30 +0200 Subject: [PATCH 27/63] fix bug in idemix2, now Energy converges towards equilibrium --- src/cvmix_driver/cvmix_idemix2.F90 | 146 +- .../gen_modules_cvmix_idemix2.F90 | 1399 +++++++++++------ src/io_meandata.F90 | 12 +- 3 files changed, 1020 insertions(+), 537 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 554d063ff..761127e9c 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -337,23 +337,7 @@ subroutine compute_param( & ! v0(di) = 0d0 !endif enddo - ! --> ATTENTION: REMEMBER TO CHECK HORIZONTAL STABILTY CRITERIA WHEN - ! HORIZOTNAL OPERATION IS DONE !!! - ! --> pyOM2: - ! if (enable_idemix_hor_diffusion .or. enable_idemix_hor_diffusion_iter) then - ! ! check for stability criterium, lateral diffusion is explicit - ! ! tau_h v0^2 *dt/dx^2 <= 0.5 -> v0 < sqrt( 0.5*dx^2/(dt tau_h) ) - ! do j=js_pe-onx,je_pe+onx - ! do i=is_pe-onx,ie_pe+onx - ! if (enable_idemix_hor_diffusion_iter) then - ! fxa = 0.2*min( dxt(i)*cost(j), dyt(j) )**2/ max(1D0,dt_tracer/idemix_hor_diffusion_iter *tau_h ) - ! else - ! fxa = 0.2*min( dxt(i)*cost(j), dyt(j) )**2/ max(1D0,dt_tracer *tau_h ) - ! endif - ! v0(i,j,:) = min( sqrt(fxa), v0(i,j,:) ) - ! enddo - ! enddo - ! endif + end subroutine compute_param @@ -467,6 +451,7 @@ subroutine compute_compart_interact_tscale( & topo_shelf , & omega_compart , & tau_compart , & + compart_name , & idemix2_const_userdef & ) !___Input___________________________________________________________________ @@ -482,6 +467,7 @@ subroutine compute_compart_interact_tscale( & logical , intent(in) :: topo_shelf !___Output__________________________________________________________________ real(cvmix_r8) , intent(out) :: tau_compart + character(len=*) , intent(in) :: compart_name !___Local___________________________________________________________________ real(cvmix_r8) :: fxb, fxc, N0, small=1.0e-12_cvmix_r8 type(idemix2_type), pointer :: idemix2_const_in @@ -497,17 +483,36 @@ subroutine compute_compart_interact_tscale( & if (zbottom>0) then N0=cn*cvmix_PI/zbottom if ( N0 > abs(coriolis) .and. omega_compart > abs(coriolis) ) then - fxc = topo_hrms**2.0 * 2.0*cvmix_PI/(small+topo_hlam) - fxb = 0.5* N0*( (omega_compart**2.0 + coriolis**2.0)/omega_compart**2.0 )**2.0 & - *(omega_compart**2.0 - coriolis**2.0)**0.5/omega_compart - tau_compart = min(0.5/dtime, fxc*fxb/zbottom) + + if (trim(compart_name)=='niw') then + ! fxc = topo_hrms**2.0 * 2.0*cvmix_PI/(small+topo_hlam) ! Goff & Arbic + fxc = topo_hrms**2.0 * 2.0*sqrt(2.6)/(small+topo_hlam) ! Goff for nu=0.8 FP 2020 + fxb = 0.5* N0*( (omega_compart**2.0 + coriolis**2.0)/omega_compart**2.0 )**2.0 & + *(omega_compart**2.0 - coriolis**2.0)**0.5/omega_compart + tau_compart = min(0.5/dtime, fxc*fxb/zbottom) + + elseif (trim(compart_name)=='M2') then + + if (topo_hrms>0.0) then + ! fxc = topo_hrms**2.0 * 2.0*cvmix_PI/(small+topo_hlam) ! Goff & Arbic + fxc = topo_hrms**2.0 * 2.0*sqrt(2.6)/(small+topo_hlam) ! Goff for nu=0.8 FP 2020 + fxb = 0.5* N0*( (omega_compart**2.0 + coriolis**2.0)/omega_compart**2.0 )**2.0 & + *(omega_compart**2.0 - coriolis**2.0)**0.5/omega_compart + tau_compart = min(0.5/dtime, fxc*fxb/zbottom) + else + tau_compart = 1./(50.*86400.0) + end if + end if endif endif ! on shelf limitation - if (topo_shelf) tau_compart = 1./(3.*86400.0) - tau_compart = max(1d0/(50.*86400.0), tau_compart ) - + if (topo_shelf) tau_compart = 1./(7.*86400.0) + if (trim(compart_name)=='niw') then + tau_compart = max(1d0/(3.*86400.0), tau_compart ) + else if (trim(compart_name)=='M2') then + tau_compart = max(1d0/(50.*86400.0), tau_compart ) + end if end subroutine compute_compart_interact_tscale @@ -530,7 +535,7 @@ subroutine compute_M2_dissipation( & !___Output__________________________________________________________________ real(cvmix_r8) , intent(out) :: alpha_M2_c !___Local___________________________________________________________________ - real(cvmix_r8) :: N0 + real(cvmix_r8) :: N0, xalpha1, xalpha2 real(cvmix_r8) :: mstar=0.01 ,& M2_f=2*cvmix_PI/(12.42*60*60) type(idemix2_type), pointer :: idemix2_const_in @@ -546,13 +551,36 @@ subroutine compute_M2_dissipation( & alpha_M2_c = 0.0 if (zbottom > 0.) then N0 = cn*cvmix_PI/zbottom+1D-20 +! if (abs(lat) < 28.5 ) then +! ! lambda+/M2=15*E*mstar/N * (sin(phi-28.5)/sin(28.5))^1/2 +! alpha_M2_c=alpha_M2_c+ M2_f*15*mstar/N0* (sin( abs(abs(lat) -28.5)/180.*cvmix_PI )/sin(28.5/180.*cvmix_PI) )**0.5 +! endif +! if (abs(lat) < 74.5 ) then +! ! lambda-/M2 = 0.7*E*mstar/N *sin^2(phi) +! alpha_M2_c=alpha_M2_c+ M2_f*0.7*mstar/N0* sin( abs(lat)/180.*cvmix_PI )**2 +! endif + ! sum interaction !FP 2020 if (abs(lat) < 28.5 ) then - ! lambda+/M2=15*E*mstar/N * (sin(phi-28.5)/sin(28.5))^1/2 - alpha_M2_c=alpha_M2_c+ M2_f*15*mstar/N0* (sin( abs(abs(lat) -28.5)/180.*cvmix_PI )/sin(28.5/180.*cvmix_PI) )**0.5 + if(lat < 0.) then + xalpha1 = 13.0076 + xalpha2 = 3.1617*1d-6 + else + xalpha1 = 13.1923 + xalpha2 = 3.4391*1d-6 + endif + alpha_M2_c = alpha_M2_c + xalpha2*10.0**(abs(lat)/xalpha1) endif + + ! difference interaction !FP 2020 if (abs(lat) < 74.5 ) then - ! lambda-/M2 = 0.7*E*mstar/N *sin^2(phi) - alpha_M2_c=alpha_M2_c+ M2_f*0.7*mstar/N0* sin( abs(lat)/180.*cvmix_PI )**2 + if(lat < 0.) then + xalpha1 = -2.8223 + xalpha2 = 1.4875*1d-4 + else + xalpha1 = -6.6848 + xalpha2 = 1.8207*1d-4 + endif + alpha_M2_c = alpha_M2_c + xalpha2*(sin((2.*lat+xalpha1)*cvmix_PI/180.)/sin(74.5*cvmix_PI/180.))**2. endif alpha_M2_c=alpha_M2_c/zbottom endif @@ -1079,15 +1107,15 @@ subroutine compute_Eiw_waveinteract( & M2_diss = min(M2_diss, E_M2_new(fbini)/max(small,dt)) E_M2_new(fbini) = E_M2_new(fbini)-dt*M2_diss E_M2_new(fbini) = max(0.0_cvmix_r8, E_M2_new(fbini)) - if (E_M2_new(fbini)/=E_M2_new(fbini) .or. E_M2_new(fbini)<0.0_cvmix_r8) then - write(*,*) " }-))))°> found negative/NaN E_M2_new from WWI M2", E_M2_new(fbini) - write(*,*) "fbini = ", fbini - write(*,*) "E_M2_new(fbini) = ", E_M2_new(fbini) - write(*,*) "E_M2_old(fbini) = ", E_M2_old(fbini) - write(*,*) "M2_diss = ", -dt*M2_diss - write(*,*) "aM2c = ", aM2c - write(*,*) "vint = ", vint - end if +! if (E_M2_new(fbini)/=E_M2_new(fbini) .or. E_M2_new(fbini)<0.0_cvmix_r8) then +! write(*,*) " }-))))°> found negative/NaN E_M2_new from WWI M2", E_M2_new(fbini) +! write(*,*) "fbini = ", fbini +! write(*,*) "E_M2_new(fbini) = ", E_M2_new(fbini) +! write(*,*) "E_M2_old(fbini) = ", E_M2_old(fbini) +! write(*,*) "M2_diss = ", -dt*M2_diss +! write(*,*) "aM2c = ", aM2c +! write(*,*) "vint = ", vint +! end if end do ! update E_iw from E_M2 @@ -1096,18 +1124,18 @@ subroutine compute_Eiw_waveinteract( & E_iw_new(nz) = E_iw_new(nz) & + dt * tau_M2* sint * E_M2_struct(nz) & + dt * fmin * sint * E_M2_struct(nz) - - if (E_iw_new(nz)/=E_iw_new(nz) .or. E_iw_new(nz)<0.0_cvmix_r8) then - write(*,*) " }-))))°> found negative/NaN Eiw_new from WWI M2", E_iw_new(nz) - write(*,*) "nz = ", nz - write(*,*) "E_iw_new(nz) = ", E_iw_new(nz) - write(*,*) "E_M2_new = ", minval(E_M2_new), maxval(E_M2_new) - write(*,*) "E_M2_old = ", minval(E_M2_old), maxval(E_M2_old) - write(*,*) "tau_M2 = ", tau_M2 - write(*,*) "fmin = ", fmin - write(*,*) "sint = ", sint - write(*,*) "E_M2_struct(nz) = ", E_M2_struct(nz) - end if + E_iw_new(nz) = max(0.0_cvmix_r8, E_iw_new(nz)) +! if (E_iw_new(nz)/=E_iw_new(nz) .or. E_iw_new(nz)<0.0_cvmix_r8) then +! write(*,*) " }-))))°> found negative/NaN Eiw_new from WWI M2", E_iw_new(nz) +! write(*,*) "nz = ", nz +! write(*,*) "E_iw_new(nz) = ", E_iw_new(nz) +! write(*,*) "E_M2_new = ", minval(E_M2_new), maxval(E_M2_new) +! write(*,*) "E_M2_old = ", minval(E_M2_old), maxval(E_M2_old) +! write(*,*) "tau_M2 = ", tau_M2 +! write(*,*) "fmin = ", fmin +! write(*,*) "sint = ", sint +! write(*,*) "E_M2_struct(nz) = ", E_M2_struct(nz) +! end if end do end if @@ -1123,15 +1151,15 @@ subroutine compute_Eiw_waveinteract( & do nz = 1, nlev E_iw_new(nz) = E_iw_new(nz) & + dt * tau_niw * sint * E_niw_struct(nz) - - if (E_iw_new(nz)/=E_iw_new(nz) .or. E_iw_new(nz)<0.0_cvmix_r8 ) then - write(*,*) " }-))))°> found negative/NaN Eiw_new from WWI NIW", E_iw_new(nz) - write(*,*) "nz = ", nz - write(*,*) "E_iw_new(nz) = ", E_iw_new(nz) - write(*,*) "tau_niw = ", tau_niw - write(*,*) "sint = ", sint - write(*,*) "E_niw_struct(nz)= ", E_niw_struct(nz) - end if + E_iw_new(nz) = max(0.0_cvmix_r8, E_iw_new(nz)) +! if (E_iw_new(nz)/=E_iw_new(nz) .or. E_iw_new(nz)<0.0_cvmix_r8 ) then +! write(*,*) " }-))))°> found negative/NaN Eiw_new from WWI NIW", E_iw_new(nz) +! write(*,*) "nz = ", nz +! write(*,*) "E_iw_new(nz) = ", E_iw_new(nz) +! write(*,*) "tau_niw = ", tau_niw +! write(*,*) "sint = ", sint +! write(*,*) "E_niw_struct(nz)= ", E_niw_struct(nz) +! end if end do end if end subroutine compute_Eiw_waveinteract diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 5de1ebc09..1ce5f02ce 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -72,7 +72,7 @@ module g_cvmix_idemix2 ! use superbee-spectral advection scheme and Adams-Bashfort timestepping ! logical :: idemix2_enable_superbee_adv = .true. logical :: idemix2_enable_AB_timestep = .true. - integer :: idemix2_AB_epsilon = 0.0_WP + integer :: idemix2_AB_epsilon = 0.1_WP ! number of spectral bins used for the M2 tidal and near-inertial wave (niw) components ! e.g 50+2 in loop used as do fbin=2,51 ... 1 and 52 serve as spectral boudary condition ! The first and last bins are used for boundary conditions in the spectral space. @@ -92,6 +92,9 @@ module g_cvmix_idemix2 ! define shelf is defined as distance from coast (default 300km) real(kind=WP) :: idemix2_shelf_dist = 300.0e3 + ! scal down baroclinic wave speed when not all modes are used + real(kind=WP) :: idemix2_scal_cn = 1.0 + !___________________________________________________________________________ ! enable M2 tidal component as significant source of internal wave energy in IDEMIX2, ! lower frequency modes @@ -154,7 +157,7 @@ module g_cvmix_idemix2 character(MAX_PATH):: idemix2_hlamforc_file = './idemix2_forcing_t-scattering_1deg.nc' character(MAX_PATH):: idemix2_hlamforc_vname= 'LAMBDA_G10' - namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, & + namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, idemix2_scal_cn, & idemix2_enable_AB_timestep, idemix2_nfbin, & ! idemix2_enable_superbee_adv idemix2_enable_hor_diffusion, idemix2_enable_hor_diff_iter, idemix2_hor_diff_niter, & idemix2_shelf_dist, & @@ -176,6 +179,7 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_w, iwe2_fM2, iwe2_E_M2_struct real(kind=WP), allocatable, dimension(:) :: w_M2_e, iwe2_alpha_M2_c, iwe2_M2_tau real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_M2_dt, iwe2_E_M2_advh, iwe2_E_M2_advs, iwe2_E_M2_diss, iwe2_E_M2_forc + real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_div_uv ! niw related global variables real(kind=WP), allocatable, dimension(:) :: iwe2_omega_niw @@ -183,6 +187,7 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_w, iwe2_fniw, iwe2_E_niw_struct real(kind=WP), allocatable, dimension(:) :: w_niw_e, iwe2_niw_tau real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_niw_dt, iwe2_E_niw_advh, iwe2_E_niw_advs, iwe2_E_niw_diss, iwe2_E_niw_forc + real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_div_uv ! general idemix variable real(kind=WP), allocatable, dimension(:) :: iwe2_cn @@ -202,15 +207,15 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,:) :: iwe2_Av ! support variables + real(kind=WP), allocatable, dimension(:) :: vol_nodB2T real(kind=WP), allocatable, dimension(:,:) :: vol_wcelli integer , allocatable, dimension(:,:) :: edge_up_dn_tri real(kind=WP), allocatable, dimension(:) :: iwe2_grady_coriol, aux real(kind=WP), allocatable, dimension(:,:,:):: iwe2_gradxy_e, iwe2_gradxy_n - real(kind=WP), allocatable, dimension(:,: ):: iwe2_flx_uv, iwe2_flx_w, iwe2_div_hv + real(kind=WP), allocatable, dimension(:,: ):: iwe2_flx_uv, iwe2_flx_w integer :: iwe2_taum1=1, iwe2_tau=2, iwe2_taup1=3, otaum1 - real(kind=WP), allocatable, dimension(:) :: iwe2_cn_e, iwe2_cn_gradx, iwe2_cn_grady - real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_w_e, iwe2_niw_w_e, iwe2_niw_cflcs, iwe2_M2_cflcs + ! real(kind=WP), allocatable, dimension(:) :: iwe2_cn_e, iwe2_cn_gradx, iwe2_cn_grady ! load variables from CVMix list type(cvmix_data_type) :: CVMix_vars @@ -320,13 +325,14 @@ subroutine init_cvmix_idemix2(partit, mesh) ! baroclionic gravity wave speed allocate(iwe2_cn(node_size)) - allocate(iwe2_cn_e(elem_size)) - allocate(iwe2_cn_gradx(elem_size)) - allocate(iwe2_cn_grady(elem_size)) iwe2_cn(:) = 0.0_WP - iwe2_cn_e(:) = 0.0_WP - iwe2_cn_gradx(:) = 0.0_WP - iwe2_cn_grady(:) = 0.0_WP + +! allocate(iwe2_cn_e(elem_size)) +! allocate(iwe2_cn_gradx(elem_size)) +! allocate(iwe2_cn_grady(elem_size)) +! iwe2_cn_e(:) = 0.0_WP +! iwe2_cn_gradx(:) = 0.0_WP +! iwe2_cn_grady(:) = 0.0_WP ! Eiw 3d enery dissipation coefficient allocate(iwe2_alpha_c(nl,node_size)) @@ -366,10 +372,11 @@ subroutine init_cvmix_idemix2(partit, mesh) ! at vertices allocate(iwe2_M2_uv(2, nfbin,elem_size)) allocate(iwe2_M2_w( nfbin,node_size)) - allocate(iwe2_M2_w_e( nfbin,elem_size)) iwe2_M2_uv(:,:,:) = 0.0_WP iwe2_M2_w(:,:) = 0.0_WP - iwe2_M2_w_e(:,:) = 0.0_WP + + allocate(iwe2_M2_div_uv( nfbin,elem_size)) + iwe2_M2_div_uv = 0.0_WP ! M2 forcing allocate(iwe2_fM2(nfbin, node_size)) @@ -402,8 +409,6 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_M2_diss(:,:) = 0.0_WP iwe2_E_M2_forc(:,:) = 0.0_WP - allocate( iwe2_M2_cflcs( nfbin, node_size)) - iwe2_M2_cflcs = 0.0_WP end if ! initialise niw variables @@ -424,10 +429,11 @@ subroutine init_cvmix_idemix2(partit, mesh) ! at vertices allocate(iwe2_niw_uv(2, nfbin,elem_size)) allocate(iwe2_niw_w( nfbin,node_size)) - allocate(iwe2_niw_w_e( nfbin,elem_size)) iwe2_niw_uv(:,:,:) = 0.0_WP iwe2_niw_w(:,:) = 0.0_WP - iwe2_niw_w_e(:,:) = 0.0_WP + + allocate(iwe2_niw_div_uv( nfbin,elem_size)) + iwe2_niw_div_uv = 0.0_WP ! niw forcing allocate(iwe2_fniw(nfbin, node_size)) @@ -460,8 +466,6 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_niw_diss(:,:) = 0.0_WP iwe2_E_niw_forc(:,:) = 0.0_WP - allocate( iwe2_niw_cflcs( nfbin, node_size)) - iwe2_niw_cflcs = 0.0_WP end if ! allocate 1d Spectral space coordinates @@ -501,25 +505,26 @@ subroutine init_cvmix_idemix2(partit, mesh) ! support gradient variables allocate( iwe2_grady_coriol( elem_size) & - , iwe2_gradxy_e(2, nfbin, elem_size ) & - , iwe2_gradxy_n(2, nfbin, node_size ) & + , iwe2_gradxy_e(2, nfbin, elem_size) & + , iwe2_gradxy_n(2, nfbin, node_size) & ) iwe2_grady_coriol(:) = 0.0_WP iwe2_gradxy_e(:,:,:) = 0.0_WP iwe2_gradxy_n(:,:,:) = 0.0_WP ! support horizontal edge flux and vertical flux and accumulated divergence variables - allocate( iwe2_flx_uv(nfbin, partit%myDim_edge2D) & - , iwe2_flx_w( nfbin, node_size) & - , iwe2_div_hv(nfbin, node_size) & + allocate( iwe2_flx_uv(nfbin, partit%myDim_edge2D) & + , iwe2_flx_w( nfbin, partit%myDim_nod2D ) & ) iwe2_flx_uv(:,:) = 0.0 iwe2_flx_w( :,:) = 0.0 - iwe2_div_hv(:,:) = 0.0 ! support inverse volume of wcell allocate(vol_wcelli(nl, node_size)) - vol_wcelli(:,:) = 0.0_WP + vol_wcelli(:,:) = 0.0_WP + allocate(vol_nodB2T(node_size)) + vol_nodB2T(:) = 0.0_WP + !_______________________________________________________________________ ! width of spectral frequency bins @@ -532,15 +537,7 @@ subroutine init_cvmix_idemix2(partit, mesh) do fbin_i=2,nfbin iwe2_phit(fbin_i) = iwe2_phit(fbin_i-1) + iwe2_dphit(fbin_i) iwe2_phiu(fbin_i) = iwe2_phiu(fbin_i-1) + iwe2_dphiu(fbin_i) - end do - - if (partit%mype==0) then - write(*,*) 'iwe2_phit = ', iwe2_phit - write(*,*) 'iwe2_phiu = ', iwe2_phiu - write(*,*) - end if - - + end do !_______________________________________________________________________ ! read idemix M2 forcing from cfsr data --> file @@ -609,15 +606,26 @@ subroutine init_cvmix_idemix2(partit, mesh) ! in this case standard idemix1 behaviour iwe2_fsrf = max(0.0_WP,iwe2_fsrf) iwe2_fsrf = iwe2_fsrf/density_0*idemix2_fniw_usage + + ! check for total tidal energy that is infused through the surface, see how + ! much is lossed during interpolation and compare with value of the + ! original files + loc_Etot = 0.0_WP + do node=1, myDim_nod2D + loc_Etot = loc_Etot + area(1,node)*iwe2_fsrf(node)*density_0 + end do + call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + if (idemix2_enable_niw) then if (mype==0) write(*,*) ' ├> read IDEMIX2 niw wave forcing' do fbin_i =2, nfbin-1 - iwe2_fniw(fbin_i, :) = iwe2_fsrf(:)/iwe2_dphit(fbin_i) !!!ATTENTION CHECK THIS AGAIN!!! + iwe2_fniw(fbin_i, :) = iwe2_fsrf(:)/(2.0_WP*pi) end do iwe2_fsrf(:) = 0.0_WP else if (mype==0) write(*,*) ' ├> read IDEMIX2 surface wave forcing' end if + if (mype==0) write(*,*) ' ├> IDEMIX2 total srf. energy Etot_srf =', glb_Etot*1.0e-12, ' TW' else if (mype==0) then @@ -843,6 +851,13 @@ subroutine init_cvmix_idemix2(partit, mesh) ! compute d/dy of coriolis call find_up_downwind_triangles(partit, mesh, mesh%edge_up_dn_tri) + !_______________________________________________________________________ + ! compute scalar cell volume from top to bottom + ! --> if take the fixed standard levels (zbar) to compute the ocean volume + ! than only normal numerical drift, ocean volume can be computed at + ! initialisation point + call compute_vol_nodB2T_fix(vol_nodB2T, mesh, partit) + !_______________________________________________________________________ ! initialise IDEMIX parameters call cvmix_idemix2_init( & @@ -901,6 +916,15 @@ subroutine calc_cvmix_idemix2(partit, mesh) iwe2_taup1 = otaum1; ! if (mype==0) write(*,*) " --> taum1, tau, taup1: ", iwe2_taum1, iwe2_tau, iwe2_taup1 + !_______________________________________________________________________ + ! compute scalar cell volume from top to bottom + ! --> if we take not the ALE variying ocean layer into account --> slight + ! numerical drift + ! --> if take the fixed standard levels (zbar) to compute the ocean volume + ! than only normal numerical drift, ocean volume can be computed at + ! initialisation point + ! call compute_vol_nodB2T_hnode(vol_nodB2T, mesh, partit) + !_______________________________________________________________________ do node=1, myDim_nod2D+eDim_nod2D !___________________________________________________________________ @@ -924,7 +948,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) do nz=uln, nln-1 cn=cn+hnode(nz,node)*sqrt(max(bvfreq(nz,node), 0._WP) + max(bvfreq(nz+1,node), 0._WP))/2._WP end do - cn = cn/pi + cn = cn/pi * idemix2_scal_cn iwe2_cn(node)=cn ! @@ -997,6 +1021,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) , topo_shelf = topo_shelf & !IN , omega_compart= iwe2_omega_M2 & !IN , tau_compart = iwe2_M2_tau( node) & !OUT + , compart_name = 'M2' & ) call cvmix_idemix2_compute_M2_dissipation( & lat = lat_n_deg & !IN @@ -1017,6 +1042,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) , topo_shelf = topo_shelf & !IN , omega_compart= iwe2_omega_niw( node) & !IN , tau_compart = iwe2_niw_tau( node) & !OUT + , compart_name = 'niw' & ) end if end if @@ -1050,7 +1076,8 @@ subroutine calc_cvmix_idemix2(partit, mesh) , omega_niw = iwe2_omega_niw( node) & !IN , E_struct_M2 = iwe2_E_M2_struct( uln:nln, node) & !OUT , E_struct_niw= iwe2_E_niw_struct(uln:nln, node) & !OUT - ) + ) + else if (idemix2_enable_M2) then call cvmix_idemix2_compute_vert_struct_fct( & nlev = nln-uln+1 & !IN @@ -1060,7 +1087,8 @@ subroutine calc_cvmix_idemix2(partit, mesh) , Nsqr = bvfreq( uln:nln, node) & !IN , omega_M2 = iwe2_omega_M2 & !IN , E_struct_M2 = iwe2_E_M2_struct( uln:nln, node) & !OUT - ) + ) + else if (idemix2_enable_niw) then call cvmix_idemix2_compute_vert_struct_fct( & nlev = nln-uln+1 & !IN @@ -1070,7 +1098,8 @@ subroutine calc_cvmix_idemix2(partit, mesh) , Nsqr = bvfreq( uln:nln, node) & !IN , omega_niw = iwe2_omega_niw( node) & !IN , E_struct_niw= iwe2_E_niw_struct(uln:nln, node) & !OUT - ) + ) + end if end do ! --> do node=1, myDim_nod2D+eDim_nod2D @@ -1094,9 +1123,9 @@ subroutine calc_cvmix_idemix2(partit, mesh) cn_gradx_e = sum(gradient_sca(1:3,elem)*iwe2_cn(elnodes)) cn_grady_e = sum(gradient_sca(4:6,elem)*iwe2_cn(elnodes)) - iwe2_cn_e(elem) = cn_e - iwe2_cn_gradx(elem) = cn_gradx_e - iwe2_cn_grady(elem) = cn_grady_e +! iwe2_cn_e(elem) = cn_e +! iwe2_cn_gradx(elem) = cn_gradx_e +! iwe2_cn_grady(elem) = cn_grady_e ! average to elem if (idemix2_enable_niw) omega_niw_e = sum(iwe2_omega_niw(elnodes))/3.0 @@ -1151,14 +1180,12 @@ subroutine calc_cvmix_idemix2(partit, mesh) , omega_compart= iwe2_omega_M2 & !IN , u_compart = iwe2_M2_uv(1, :, elem) & !OUT , v_compart = iwe2_M2_uv(2, :, elem) & !OUT -! , w_compart = w_M2_e( : ) & !OUT - , w_compart = iwe2_M2_w_e( :, elem) & !OUT + , w_compart = w_M2_e( : ) & !OUT ) ! --> here w_M2_e and w_niw_e are still on elements but for the proper ! finite volume advection implementation we need them on nodes ! do k=1,3 -! iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + w_M2_e(:)*elem_area(elem)/3.0_WP - iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + iwe2_M2_w_e(:, elem)*elem_area(elem)/3.0_WP + iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + w_M2_e(:)*elem_area(elem)/3.0_WP end do end if @@ -1176,12 +1203,17 @@ subroutine calc_cvmix_idemix2(partit, mesh) , omega_compart= omega_niw_e & !IN , u_compart = iwe2_niw_uv(1, :, elem) & !OUT , v_compart = iwe2_niw_uv(2, :, elem) & !OUT -! , w_compart = w_niw_e( : ) & !OUT - , w_compart = iwe2_niw_w_e( :, elem) & !OUT + , w_compart = w_niw_e( : ) & !OUT ) + + ! Mask out NIW velocities near equator where physics is singular + if (abs(lat_e_deg) < 5.0_WP) then ! ~5° latitude + iwe2_niw_uv( :, :, elem) = 0.0_WP + w_niw_e( : ) = 0.0_WP + end if + do k=1,3 -! iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*elem_area(elem)/3.0_WP - iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + iwe2_niw_w_e(:, elem)*elem_area(elem)/3.0_WP + iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*elem_area(elem)/3.0_WP end do end if ! --> at the end we still need to normalize iwe2_M2_w and iwe2_niw_w @@ -1196,7 +1228,6 @@ subroutine calc_cvmix_idemix2(partit, mesh) call exchange_nod_fbin(iwe2_M2_w, partit) do node=1, myDim_nod2D+eDim_nod2D iwe2_M2_w( :, node) = iwe2_M2_w(:, node)/area(1, node) -! write(*,*) "iwe2_M2_w([1, 2, nfbin-1, nfbin],:)=", iwe2_M2_w(1, node), iwe2_M2_w(2, node), iwe2_M2_w(idemix2_nfbin-1, node), iwe2_M2_w(idemix2_nfbin, node) end do end if @@ -1204,11 +1235,9 @@ subroutine calc_cvmix_idemix2(partit, mesh) call exchange_elem_fbin(iwe2_niw_uv, partit) call exchange_nod_fbin(iwe2_niw_w, partit) do node=1, myDim_nod2D+eDim_nod2D - iwe2_niw_w(:, node) = iwe2_niw_w(:, node)/area(1,node) -! write(*,*) "iwe2_niw_w([1, 2, nfbin-1, nfbin],:)=", iwe2_niw_w(1, node), iwe2_niw_w(2, node), iwe2_niw_w(idemix2_nfbin-1, node), iwe2_niw_w(idemix2_nfbin, node) + iwe2_niw_w( :, node) = iwe2_niw_w(:, node)/area(1, node) end do - end if - + end if !_______________________________________________________________________ @@ -1217,61 +1246,68 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! dE/dt = -div(vec_u * E) - tau*E + Forc ! E^(n+1) = E^n + dt*( -div(vec_u^n*E^n) - tau*E^n + Forc^n) if (idemix2_enable_M2) then - call hsintegrate_Ecompart(& - iwe2_taum1, iwe2_tau, iwe2_taup1 & - , 'M2' & - , iwe2_E_M2 & - , iwe2_E_M2_divh & - , iwe2_E_M2_divs & - , iwe2_M2_uv & - , iwe2_M2_w & - , iwe2_fM2 & - , iwe2_M2_tau & - , iwe2_dphit & - , iwe2_gradxy_e & - , iwe2_gradxy_n & - , iwe2_flx_uv & - , iwe2_flx_w & - , iwe2_M2_cflcs & - , mesh%edge_up_dn_tri & - , partit & - , mesh & - , iwe2_E_M2_dt & ! optional: diagnostic - , iwe2_E_M2_advs & ! optional: diagnostic - , iwe2_E_M2_diss & ! optional: diagnostic - , iwe2_E_M2_forc & ! optional: diagnostic - , geo_coord_nod2D(1,:)& - , geo_coord_nod2D(2,:)& + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & + , 'M2' & + , iwe2_E_M2 & + , iwe2_E_M2_divh & + , iwe2_E_M2_divs & + , iwe2_M2_uv & + , iwe2_M2_w & + , iwe2_fM2 & + , iwe2_M2_tau & + , iwe2_dphit & + , iwe2_gradxy_e & + , iwe2_gradxy_n & + , iwe2_flx_uv & + , iwe2_flx_w & + , vol_nodB2T & + , partit & + , mesh & + , .True. & ! flag_AB2, do 2nd order adams-bashfort in time + , iwe2_E_M2_dt & ! optional: diagnostic + , iwe2_E_M2_advh & ! optional: diagnostic + , iwe2_E_M2_advs & ! optional: diagnostic + , iwe2_E_M2_diss & ! optional: diagnostic + , iwe2_E_M2_forc & ! optional: diagnostic ) - end if + + ! Compute global total NIW energy for conservation check + call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') +! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'M2') + end if + if (idemix2_enable_niw) then - call hsintegrate_Ecompart(& - iwe2_taum1, iwe2_tau, iwe2_taup1 & - , 'NIW' & - , iwe2_E_niw & - , iwe2_E_niw_divh & - , iwe2_E_niw_divs & - , iwe2_niw_uv & - , iwe2_niw_w & - , iwe2_fniw & - , iwe2_niw_tau & - , iwe2_dphit & - , iwe2_gradxy_e & - , iwe2_gradxy_n & - , iwe2_flx_uv & - , iwe2_flx_w & - , iwe2_niw_cflcs & - , mesh%edge_up_dn_tri & - , partit & - , mesh & - , iwe2_E_niw_dt & ! optional: diagnostic - , iwe2_E_niw_advh & ! optional: diagnostic - , iwe2_E_niw_advs & ! optional: diagnostic - , iwe2_E_niw_diss & ! optional: diagnostic - , iwe2_E_niw_forc & ! optional: diagnostic - , geo_coord_nod2D(1,:)& - , geo_coord_nod2D(2,:)& + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & + , 'NIW' & + , iwe2_E_niw & + , iwe2_E_niw_divh & + , iwe2_E_niw_divs & + , iwe2_niw_uv & + , iwe2_niw_w & + , iwe2_fniw & + , iwe2_niw_tau & + , iwe2_dphit & + , iwe2_gradxy_e & + , iwe2_gradxy_n & + , iwe2_flx_uv & + , iwe2_flx_w & + , vol_nodB2T & + , partit & + , mesh & + , .True. & ! flag_AB2, do 2nd order adams-bashfort in time + , iwe2_E_niw_dt & ! optional: diagnostic + , iwe2_E_niw_advh & ! optional: diagnostic + , iwe2_E_niw_advs & ! optional: diagnostic + , iwe2_E_niw_diss & ! optional: diagnostic + , iwe2_E_niw_forc & ! optional: diagnostic ) + + ! Compute global total NIW energy for conservation check + call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') +! call check_max_cfl(iwe2_niw_uv, iwe2_niw_w, iwe2_dphit, partit, mesh, 'niw') +! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'niw') end if @@ -1344,67 +1380,67 @@ subroutine calc_cvmix_idemix2(partit, mesh) -! !_______________________________________________________________________ -! ! 10th. compute wave-wave interaction -! if (idemix2_enable_M2 .or. idemix2_enable_niw) then -! do node = 1, myDim_nod2D -! uln = ulevels_nod2D(node) -! nln = nlevels_nod2D(node) -! !_______________________________________________________________ -! if (idemix2_enable_M2 .and. idemix2_enable_niw) then -! call cvmix_idemix2_compute_Eiw_waveinteract( & -! nlev = nln-uln+1 & -! , nfbin = idemix2_nfbin & -! , dzw = hnode( uln:nln-1, node) & -! , dphi = iwe2_dphit & -! , dt = dt & -! , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & -! , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & -! , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & -! , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & -! , E_M2_struct = iwe2_E_M2_struct( : , node) & -! , alpha_M2_c = iwe2_alpha_M2_c( node) & -! , tau_M2 = iwe2_M2_tau( node) & -! , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & -! , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & -! , E_niw_struct = iwe2_E_niw_struct( : , node) & -! , tau_niw = iwe2_niw_tau( node) & -! ) -! elseif (idemix2_enable_M2) then -! call cvmix_idemix2_compute_Eiw_waveinteract( & -! nlev = nln-uln+1 & -! , nfbin = idemix2_nfbin & -! , dzw = hnode( uln:nln-1, node) & -! , dphi = iwe2_dphit & -! , dt = dt & -! , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & -! , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & -! , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & -! , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & -! , E_M2_struct = iwe2_E_M2_struct( : , node) & -! , alpha_M2_c = iwe2_alpha_M2_c( node) & -! , tau_M2 = iwe2_M2_tau( node) & -! ) -! elseif (idemix2_enable_niw) then -! call cvmix_idemix2_compute_Eiw_waveinteract( & -! nlev = nln-uln+1 & -! , nfbin = idemix2_nfbin & -! , dzw = hnode( uln:nln-1, node) & -! , dphi = iwe2_dphit & -! , dt = dt & -! , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & -! , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & -! , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & -! , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & -! , E_niw_struct = iwe2_E_niw_struct( : , node) & -! , tau_niw = iwe2_niw_tau( node) & -! ) -! end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then -! end do ! --> for node = 1, myDim_nod2D -! end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then - - - + !_______________________________________________________________________ + ! 10th. compute wave-wave interaction + if (idemix2_enable_M2 .or. idemix2_enable_niw) then + do node = 1, myDim_nod2D+eDim_nod2D + uln = ulevels_nod2D(node) + nln = nlevels_nod2D(node) + !_______________________________________________________________ + if (idemix2_enable_M2 .and. idemix2_enable_niw) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & + , E_M2_struct = iwe2_E_M2_struct( : , node) & + , alpha_M2_c = iwe2_alpha_M2_c( node) & + , tau_M2 = iwe2_M2_tau( node) & + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & + , E_niw_struct = iwe2_E_niw_struct( : , node) & + , tau_niw = iwe2_niw_tau( node) & + ) + elseif (idemix2_enable_M2) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & + , E_M2_struct = iwe2_E_M2_struct( : , node) & + , alpha_M2_c = iwe2_alpha_M2_c( node) & + , tau_M2 = iwe2_M2_tau( node) & + ) + elseif (idemix2_enable_niw) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & + , E_niw_struct = iwe2_E_niw_struct( : , node) & + , tau_niw = iwe2_niw_tau( node) & + ) + end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then + end do ! --> for node = 1, myDim_nod2D + end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then + + + !_______________________________________________________________________ ! 11th. write IDEMIX2 diffusivities and viscositie to FESOM only when IDEMIX2 is ! used alone --> mostly for debuging --> otherwise TKE Av and Kv are use @@ -1452,11 +1488,9 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & vel , & ttf , & ttf_grad_n , & - dphi , & flux , & partit , & mesh , & - edge_up_dn_tri , & flag_2ndord_time , & flag_posdef & ) @@ -1465,19 +1499,19 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit) , intent(inout), target :: partit type(t_mesh) , intent(in) , target :: mesh - real(kind=WP) , intent(in) :: ttf( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) - real(kind=WP) , intent(in) :: ttf_grad_n(2, idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(in) :: ttf( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in) :: ttf_grad_n(2, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in) :: vel(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) - real(kind=WP) , intent(in) :: dphi( idemix2_nfbin) real(kind=WP) , intent(inout) :: flux( idemix2_nfbin, partit%myDim_edge2D) - integer , intent(in) :: edge_up_dn_tri(2 , partit%myDim_edge2D) logical , intent(in) :: flag_2ndord_time logical , intent(in) :: flag_posdef + !___LOCAL VARIABLES_____________________________________________________ real(kind=WP) :: dx1, dy1, dx2, dy2, dxdy12(2), edlen, n_x, n_y, n_len - real(kind=WP) :: u1, u2, v1, v2, Ue, CFL, fac_2ndord_time + real(kind=WP) :: u1, u2, v1, v2, Ue, CFL, dh1, dh2 real(kind=WP) :: R, ttfp2, ttfm1, ttf0, ttfp1, dttf0p1, Tmean1, Tmean2, Cr, vflux, vfabs - integer :: el(2), el2, ednodes(2), edge, fbini, nfbin + integer :: el(2), el2, ednodes(2), edge, fbini, nfbin, nln, uln, nz + logical, parameter :: flag_volfix=.True. #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" @@ -1486,12 +1520,12 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & !_______________________________________________________________________ nfbin=idemix2_nfbin - !_______________________________________________________________________ ! this advection does !!! NOT !!! go over the vertical dimension it goes ! over the domain of the spectral bins -!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(edge, ednodes, el, el2, fbini, & -!$OMP dx1, dy1, dx2, dy2, dxdy12, vflux, vfabs, & -!$OMP ttf0, ttfp1, dttf02, ttfp2, ttfm1, R, Cr, Tmean1, Tmean2 +!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(edge, ednodes, el, el2, fbini, nln, & +!$OMP dx1, dy1, dx2, dy2, dxdy12, dh1, dh2, n_x, n_y, n_len, edlen, & +!$OMP u1, v1, u2, v2, Ue, CFL, vflux, vfabs, & +!$OMP ttf0, ttfp1, dttf0p1, ttfp2, ttfm1, R, Cr, Tmean1, Tmean2) !$OMP DO do edge=1, myDim_edge2D !___________________________________________________________________ @@ -1509,16 +1543,43 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! length of edge dx dy dxdy12 = edge_dxdy(:,edge)*r_earth + ! compute elemental local bottom depth for volume flux computation + if (flag_volfix) then + nln = nlevels(el(1)) + dh1 = abs(zbar(nln)) + else + uln = ulevels(el(1)) + nln = nlevels(el(1))-1 + dh1 = 0.0_WP + do nz=uln,nln + dh1 = dh1 + helem(nz, el(1)) + end do + end if + !___________________________________________________________________ ! same parameter but for other element el(2) that contributes to edge ed ! if el(2)==0 than edge is boundary edge dx2 = 0.0_WP dy2 = 0.0_WP + dh2 = 0.0_WP el2 = el(1) ! --> just a dummy index here is vel(el2) are multiplied with 0.0_WP if(el(2)>0) then el2 = el(2) ! --> dummy replaced with valid el(2), dx2 and dy2 dx2 = edge_cross_dxdy(3,edge) dy2 = edge_cross_dxdy(4,edge) + + ! compute elemental local bottom depth for volume flux computation + if (flag_volfix) then + nln = nlevels(el2) + dh2 = abs(zbar(nln)) + else + uln = ulevels(el2) + nln = nlevels(el2)-1 + do nz=uln,nln + dh2 = dh2 + helem(nz, el2) + end do + end if + dxdy12(1)= dxdy12(1) * (elem_cos(el(1)) + elem_cos(el2)) * 0.5_WP ! compute mean edge-segment normal vector @@ -1560,19 +1621,21 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & v1 = vel(2, fbini, el(1)) u2 = vel(1, fbini, el2 ) v2 = vel(2, fbini, el2 ) - vflux = ((-v1*dx1 + u1*dy1) + ( v2*dx2 - u2*dy2)) ! NO * dphi(fbini) + + vflux = (-v1*dx1 + u1*dy1) * dh1 & + + ( v2*dx2 - u2*dy2) * dh2 ! NO * dphi(fbini) ! compute approximated edge centered and along edge projected ! mean velocity --> need to add component to make second order ! in time - Ue = sqrt((0.5_WP*( u1 + u2 )*n_x)**2 + (0.5_WP*( v1 + v2 )*n_y)**2) - CFL = Ue*dt/edlen + Ue = sqrt((0.5_WP*( u1 + u2 )*n_x)**2 + (0.5_WP*( v1 + v2 )*n_y)**2) + CFL = min(1.0_WP, Ue*dt/edlen) !_______________________________________________________________ ! compute tracer difference allong edge ttf0 = ttf(fbini, ednodes(1)) ttfp1 = ttf(fbini, ednodes(2)) - dttf0p1 = ttfp1-ttf0 + dttf0p1 = (ttfp1-ttf0) !_______________________________________________________________ ! tracer Slope Ratio Calculation for upwind augmented point @@ -1604,9 +1667,8 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & R = (ttfp1-ttfp2)/(-dttf0p1+small) ! apply superbee limiter - Cr = slimiter_superbee(R) -! Cr = 0.0_WP ! First-order upwind (Cr=0 gives upwind, Cr=1 gives average!) - + Cr = slimiter_superbee(R) ! DEBUG: force pure upwind (no reconstruction) + ! construct edge centered tracer value ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dx ]_Limited * dx/2 ! --> this is seconds order in space, but first order in time @@ -1618,23 +1680,6 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! --> n_ed = (n_1 + n_2)/2 ! --> CFL_h = u_ed*n_ed*dt/dx Tmean2 = ttfp1 + 0.5_WP * Cr * (-dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) -! if (ttfp2<0) then -! write(*,*) "mype=", partit%mype, ', edge=', edge, ', fbini=',fbini -! write(*,*) "ttfp2 = ", ttfp2 -! write(*,*) "ttfp1 = ", ttfp1 -! write(*,*) "ttf0 = ", ttf0 -! write(*,*) "dttf0p1 = ", dttf0p1 -! write(*,*) "E(node1) = ", ttf(fbini, ednodes(1)) -! write(*,*) "E(node2) = ", ttf(fbini, ednodes(2)) -! write(*,*) "dxdy12 = ", dxdy12 -! write(*,*) "ttf_grad_nx(node1) = ", ttf_grad_n(1, fbini, ednodes(1)) -! write(*,*) "ttf_grad_ny(node1) = ", ttf_grad_n(2, fbini, ednodes(1)) -! write(*,*) "ttf_grad_nx(node2) = ", ttf_grad_n(1, fbini, ednodes(2)) -! write(*,*) "ttf_grad_ny(node2) = ", ttf_grad_n(2, fbini, ednodes(2)) -! write(*,*) "Cr = ", Cr -! write(*,*) "Tmean2 = ", Tmean2 -! write(*,*) -! end if !_______________________________________________________________ ! tracer Slope Ratio Calculation for downwind augmented point @@ -1666,8 +1711,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & R = (ttf0-ttfm1)/(dttf0p1+small) ! apply superbee limiter - Cr = slimiter_superbee(R) -! Cr = 0.0_WP ! First-order upwind (Cr=0 gives upwind, Cr=1 gives average!) + Cr = slimiter_superbee(R) ! DEBUG: force pure upwind (no reconstruction) ! construct edge centered tracer value ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dx ]_Limited * dx/2 @@ -1680,24 +1724,6 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & ! --> n_ed = (n_1 + n_2)/2 ! --> CFL_h = u_ed*n_ed*dt/dx Tmean1 = ttf0 + 0.5_WP * Cr * (dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) -! if (ttfm1<0) then -! write(*,*) "mype=", partit%mype, ' , edge=', edge, ' , fbini=',fbini -! write(*,*) "ttfm1 = ", ttfm1 -! write(*,*) "ttf0 = ", ttf0 -! write(*,*) "ttfp1 = ", ttfp1 -! write(*,*) "ttfp2 = ", ttfp2 -! write(*,*) "dttf0p1 = ", dttf0p1 -! write(*,*) "dxdy12 = ", dxdy12 -! write(*,*) "E(node1) = ", ttf(fbini, ednodes(1)) -! write(*,*) "E(node2) = ", ttf(fbini, ednodes(2)) -! write(*,*) "ttf_grad_nx(node1) = ", ttf_grad_n(1, fbini, ednodes(1)) -! write(*,*) "ttf_grad_ny(node1) = ", ttf_grad_n(2, fbini, ednodes(1)) -! write(*,*) "ttf_grad_nx(node2) = ", ttf_grad_n(1, fbini, ednodes(2)) -! write(*,*) "ttf_grad_ny(node2) = ", ttf_grad_n(2, fbini, ednodes(2)) -! write(*,*) "Cr = ", Cr -! write(*,*) "Tmean1 = ", Tmean1 -! write(*,*) -! end if !_______________________________________________________________ ! Horizontal flux @@ -1706,42 +1732,11 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & (vflux+vfabs)*Tmean1+ & (vflux-vfabs)*Tmean2 & ) - - -! if ( (mype==226) & -! .and. (ednodes(1) == 6 .or. ednodes(2)== 6) & -! .and. (fbini==2) & -! ) then -! -! write(*,*) " edge =",edge, ', fbini=',fbini, ', mype=',mype -! write(*,*) " ednodes = ", ednodes -! write(*,*) " el = ", el -! write(*,*) " flux(fbini, edge) = ", flux(fbini, edge) -! write(*,*) " dx1,dy1 = ", dx1,dy1 -! write(*,*) " u1 ,v1 = ", u1,v1 -! write(*,*) " dx2,dy2 = ", dx2,dy2 -! write(*,*) " u2 ,v2 = ", u2,v2 -! write(*,*) " vflux = ", vflux -! write(*,*) " vfabs = ", vfabs -! write(*,*) " ttf0 = ", ttf0 -! write(*,*) " ttfp1 = ", ttfp1 -! write(*,*) " dttf0p1 = ", dttf0p1 -! write(*,*) " Tmean1 = ", Tmean1 -! write(*,*) " Tmean2 = ", Tmean2 -! write(*,*) " CFL = ", CFL -! write(*,*) " Ue = ", Ue -! write(*,*) " edlen = ", edlen -! write(*,*) " dt = ", dt -! write(*,*) " n_x = ", n_x -! write(*,*) " n_y = ", n_y -! write(*,*) -! write(*,*) -! end if - + end do ! --> for fbini = 1, nfbin end do !--> do edge=1, myDim_edge2D !$OMP END DO -!$OMP END PARALLEL DO +!$OMP END PARALLEL end subroutine adv_Ecompart_hor_spctrl_superbee @@ -1751,31 +1746,32 @@ end subroutine adv_Ecompart_hor_spctrl_superbee !___________________________________________________________________________ ! cross spectral superbee advection across spectral bins subroutine adv_Ecompart_crss_spctrl_superbee( & - W , & - ttf , & - dphi , & - flux , & - cflcs , & + cs , & ! cross-spectral exchange rate + ttf , & ! Energy compartment @ node + dphi , & ! width spectral bin + flux , & ! cross-spectral flux partit , & mesh , & flag_2ndord_time , & flag_posdef & + ! flag_wlimitcfl & ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit),intent(inout), target :: partit type(t_mesh), intent(in) , target :: mesh - real(kind=WP), intent(inout) :: W ( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(inout) :: cs( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) real(kind=WP), intent(in) :: ttf( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) real(kind=WP), intent(in) :: dphi(idemix2_nfbin) - real(kind=WP), intent(inout) :: flux(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) - real(kind=WP), intent(inout) :: cflcs(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(inout) :: flux(idemix2_nfbin, partit%myDim_nod2D) logical , intent(in) :: flag_2ndord_time logical , intent(in) :: flag_posdef + ! logical , intent(in) :: flag_wlimitcfl + !___LOCAL VARIABLES_____________________________________________________ integer :: node, fbini, nfbin, idxp1, idxp2, idxm1 real(kind=WP) :: R, ttf0, ttfp1, dttf0p1, Tmean1, Tmean2, Cr, vflux, vfabs - real(kind=WP) :: CFL, cflmax=0.50_WP + real(kind=WP) :: CFL !, cflmax=0.50_WP #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" @@ -1786,8 +1782,9 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & !_______________________________________________________________________ #ifndef ENABLE_OPENACC -!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, fbini, idxp2, idxm1, tff0, tffp1, & -!$OMP dttf0p1, R, Cr, Tmean2, Tmean1, vfabs) +!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, fbini, idxp1, idxp2, idxm1, & +!$OMP ttf0, ttfp1, dttf0p1, R, Cr, Tmean1, Tmean2, & +!$OMP CFL, vflux, vfabs) !$OMP DO #else !$ACC PARALLEL LOOP GANG DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) @@ -1795,7 +1792,7 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & !_______________________________________________________________________ ! this advection does !!! NOT !!! go over the vertical dimension it goes ! over the domain of the spectral bins - do node = 1, myDim_nod2D+eDim_nod2D + do node = 1, myDim_nod2D !___________________________________________________________________ !loop over spectral bins @@ -1805,15 +1802,17 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & do fbini = 1, nfbin !_______________________________________________________________ ! Periodic wrapping for gradient stencil - idxp1 = fbini+1 ; if (idxp1>nfbin) idxp1=2+(fbini-nfbin) - idxp2 = fbini+2 ; if (idxp2>nfbin) idxp2=2+(fbini-nfbin) + idxp1 = fbini+1 ; if (idxp1>nfbin) idxp1=idxp1-(nfbin-2) + idxp2 = fbini+2 ; if (idxp2>nfbin) idxp2=idxp2-(nfbin-2) idxm1 = fbini-1 ; if (idxm1<1 ) idxm1=nfbin-2 - ! limit W cross spectral exchange rate to the CFL limit - W(fbini, node) = min(abs(W(fbini, node)), cflmax*dphi(fbini)/dt)*sign(1.0_WP, W(fbini, node)) + ! ! limit W cross spectral exchange rate to the CFL limit + ! cs(fbini, node) = merge( min(abs(cs(fbini, node)), cflmax*dphi(fbini)/dt)*sign(1.0_WP, cs(fbini, node)) & + ! , cs(fbini, node) & + ! , flag_wlimitcfl & + ! ) - CFL = abs(W(fbini, node)) * dt / dphi(fbini) - cflcs(fbini, node) = CFL + CFL = abs(cs(fbini, node)) * dt / dphi(fbini) !_______________________________________________________________ ! compute tracer difference @@ -1859,23 +1858,13 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & !_______________________________________________________________ ! cross spectral flux matching pyOM2 (NO negative sign, NO area) - vflux = W(fbini, node) + vflux = cs(fbini, node) vfabs = abs(vflux) - flux(fbini, node) = 0.5_WP*( & - (vflux+vfabs)*Tmean1+ & - (vflux-vfabs)*Tmean2 & - ) + flux(fbini, node) = -0.5_WP*( & + (vflux+vfabs)*Tmean1+ & + (vflux-vfabs)*Tmean2 & + ) -! if (ttf0 /= 0.0_WP .or. ttfp1 /= 0.0_WP) then -! write(*,*) 'fbini, node = ', fbini, node -! write(*,*) 'flux(fbini, node) = ', flux(fbini, node) -! write(*,*) 'vflux = ', vflux -! write(*,*) 'vfabs = ', vfabs -! write(*,*) 'ttf0, ttfp1 = ', ttf0, ttfp1 -! write(*,*) 'ttf(:, node) = ', ttf(:, node) -! write(*,*) 'Tmean1, Tmean2 = ', Tmean1, Tmean2 -! write(*,*) -! end if end do !--> do fbini = 1, nfbin !$ACC END LOOP end do ! --> do node = 1, myDim_nod2D @@ -1896,7 +1885,7 @@ end subroutine adv_Ecompart_crss_spctrl_superbee ! superbee slope limiter pure elemental real(kind=WP) function slimiter_superbee(R) result(Cr) real(kind=WP), intent(in) :: R - Cr = max(0._WP, min( min(2._WP*R, 0.5_WP+R/2._WP), 2._WP )) + Cr = max( 0._WP, min(1.0_WP, 2.0_WP*R), min(2.0_WP, R) ) end function slimiter_superbee @@ -1919,6 +1908,7 @@ subroutine adv_Ecompart_flx2tra_spctrl( & div_h , & div_v , & dphit , & + vol_s , & partit , & mesh & ) @@ -1926,14 +1916,16 @@ subroutine adv_Ecompart_flx2tra_spctrl( & !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit), intent(inout), target :: partit type(t_mesh) , intent(in ), target :: mesh - real(kind=WP) , intent(in) :: flx_h( idemix2_nfbin, partit%myDim_edge2D) - real(kind=WP) , intent(in) :: flx_v( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: div_h( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: div_v( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(in) :: flx_h( idemix2_nfbin, partit%myDim_edge2D) + real(kind=WP) , intent(in) :: flx_v( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout) :: div_h( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: div_v( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) + real(kind=WP) , intent(in ) :: vol_s(partit%myDim_nod2D+partit%eDim_nod2D) !___LOCAL VARIABLES_____________________________________________________ integer :: node, edge, fbini, nfbin, ednodes(2) - real(kind=WP) :: inv_dphi(idemix2_nfbin), inv_fac1, inv_fac2 + real(kind=WP) :: inv_dphi(idemix2_nfbin) + #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" @@ -1967,25 +1959,25 @@ subroutine adv_Ecompart_flx2tra_spctrl( & !_______________________________________________________________________ ! Vertical part #ifndef ENABLE_OPENACC - !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, edge, ednodes, fbini, nfbin) - !$OMP DO + !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, edge, ednodes, fbini) + !$OMP DO #else - !$ACC PARALLEL LOOP GANG DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) + !$ACC PARALLEL LOOP GANG DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) #endif - do node=1, myDim_nod2d+eDim_nod2D + do node=1, myDim_nod2d !$ACC LOOP VECTOR do fbini=2,nfbin-1 - ! Cross-spectral divergence matching pyOM2: -(flux(k) - flux(k-1))/dphi + ! Cross-spectral divergence: (flux(fbini) - flux(fbini-1))/dphi ! flux(fbini) is at interface between fbini and fbini+1 ! flux(fbini-1) is at interface between fbini-1 and fbini - div_v(fbini,node) = div_v(fbini,node) - (flx_v(fbini,node) - flx_v(fbini-1,node)) * inv_dphi(fbini) + div_v(fbini,node) = div_v(fbini,node) + (flx_v(fbini,node)-flx_v(fbini-1,node)) * inv_dphi(fbini) end do !$ACC END LOOP end do #ifndef ENABLE_OPENACC - !$OMP END DO + !$OMP END DO #else - !$ACC END PARALLEL LOOP + !$ACC END PARALLEL LOOP #endif ! @@ -1993,34 +1985,25 @@ subroutine adv_Ecompart_flx2tra_spctrl( & !_______________________________________________________________________ ! Horizontal part #ifndef ENABLE_OPENACC - !$OMP DO + !$OMP DO #else # if !defined(DISABLE_OPENACC_ATOMICS) - !$ACC PARALLEL LOOP GANG PRIVATE(enodes, el) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) + !$ACC PARALLEL LOOP GANG PRIVATE(enodes, el) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) # else - !$ACC UPDATE SELF(dttf_h, flux_h) + !$ACC UPDATE SELF(dttf_h, flux_h) # endif #endif - do edge=1, myDim_edge2D + do edge=1, myDim_edge2D ednodes = edges(:,edge) - - -! if ((ednodes(1)==6 .or. ednodes(2) == 6) .and. partit%mype==226) then -! write(*,*) " critical edge index:", edge -! end if - - - inv_fac1 = 1.0_WP/areasvol(1,ednodes(1)) - inv_fac2 = 1.0_WP/areasvol(1,ednodes(2)) #ifndef ENABLE_OPENACC # if defined(_OPENMP) && !defined(__openmp_reproducible) - call omp_set_lock(partit%plock(ednodes(1))) + call omp_set_lock(partit%plock(ednodes(1))) # else - !$OMP ORDERED + !$OMP ORDERED # endif #else # if !defined(DISABLE_OPENACC_ATOMICS) - !$ACC LOOP VECTOR + !$ACC LOOP VECTOR # endif #endif ! @@ -2028,25 +2011,25 @@ subroutine adv_Ecompart_flx2tra_spctrl( & ! horizontal flux contribution to ednode_1 do fbini=2, nfbin-1 #if !defined(DISABLE_OPENACC_ATOMICS) - !$ACC ATOMIC UPDATE + !$ACC ATOMIC UPDATE #endif ! Horizontal divergence: flux/area (NO inv_dphi - that's only for cross-spectral!) - div_h(fbini,ednodes(1))=div_h(fbini,ednodes(1))+flx_h(fbini,edge)*inv_fac1 -! div_h(fbini,ednodes(1))=div_h(fbini,ednodes(1))-flx_h(fbini,edge)*inv_fac1 - ! - !___________________________________________________________________ - ! horizontal flux contribution to ednode_2 + div_h(fbini, ednodes(1))=div_h(fbini, ednodes(1))+flx_h(fbini, edge) + + #ifndef ENABLE_OPENACC # if defined(_OPENMP) && !defined(__openmp_reproducible) ! if there is now __openmp or __openmp_reproducible assemble horizontal ! divergence in one loop end do + + !___________________________________________________________________ call omp_unset_lock(partit%plock(ednodes(1))) call omp_set_lock (partit%plock(ednodes(2))) ! !___________________________________________________________________ - ! horizontal flux contribution to ednode_1 + ! horizontal flux contribution to ednode_2 do fbini=2, nfbin-1 # endif #else @@ -2055,12 +2038,12 @@ subroutine adv_Ecompart_flx2tra_spctrl( & # endif #endif ! Horizontal divergence: flux/area (NO inv_dphi - that's only for cross-spectral!) - div_h(fbini,ednodes(2))=div_h(fbini,ednodes(2))-flx_h(fbini,edge)*inv_fac2 -! div_h(fbini,ednodes(2))=div_h(fbini,ednodes(2))+flx_h(fbini,edge)*inv_fac2 + div_h(fbini,ednodes(2))=div_h(fbini,ednodes(2))-flx_h(fbini,edge) end do + #ifndef ENABLE_OPENACC # if defined(_OPENMP) && !defined(__openmp_reproducible) - call omp_unset_lock(partit%plock(ednodes(2))) + call omp_unset_lock(partit%plock(ednodes(2))) # else !$OMP END ORDERED # endif @@ -2070,16 +2053,35 @@ subroutine adv_Ecompart_flx2tra_spctrl( & # endif #endif end do + #ifndef ENABLE_OPENACC - !$OMP END DO - !$OMP END PARALLEL + !$OMP END DO + !$OMP END PARALLEL #else # if !defined(DISABLE_OPENACC_ATOMICS) - !$ACC END PARALLEL LOOP + !$ACC END PARALLEL LOOP # else - !$ACC UPDATE DEVICE(dttf_h) + !$ACC UPDATE DEVICE(dttf_h) # endif #endif + + ! normalize with total volume of scalar cell from top to bottom +#ifndef ENABLE_OPENACC + !$OMP PARALLEL DO COLLAPSE(2) +#else + !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) +#endif + do node=1, myDim_nod2d+eDim_nod2D + do fbini=2,nfbin-1 + div_h(fbini, node) = div_h(fbini,node)/vol_s(node) + end do + end do +#ifndef ENABLE_OPENACC + !$OMP END PARALLEL DO +#else + !$ACC END PARALLEL LOOP +#endif + end subroutine adv_Ecompart_flx2tra_spctrl @@ -2095,7 +2097,7 @@ subroutine hsintegrate_Ecompart( & , Edivh & , Edivs & , vel & - , w & + , cs & ! cross-spectral exchange rate phi_dot , forc & , tauE & , dphit & @@ -2103,113 +2105,109 @@ subroutine hsintegrate_Ecompart( & , gradxy_n & , flx_uv & , flx_cs & - , cflcs & - , edge_up_dn_tri & + , vol_s & , partit & , mesh & + , flag_AB2 & ! to 2nd order Adams-Bashfort on top , Edt & , Eadvh & , Eadvs & , Ediss & , Eforc & - , glon,glat & ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ - type(t_partit) , intent(inout), target :: partit - type(t_mesh) , intent(in ), target :: mesh - integer , intent(in ) :: ti, tim1, tip1 - character(len=*), intent(in ) :: Ename - real(kind=WP) , intent(inout) :: E( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: Edivh( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: Edivs( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(in ) :: vel( 2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) - real(kind=WP) , intent(inout) :: w( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(in ) :: forc( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(in ) :: tauE( partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: gradxy_e(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) - real(kind=WP) , intent(inout) :: gradxy_n(2, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) - real(kind=WP) , intent(inout) :: flx_uv( idemix2_nfbin, partit%myDim_edge2D) - real(kind=WP) , intent(inout) :: flx_cs( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: cflcs( idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) - integer , intent(in ) :: edge_up_dn_tri(2 , partit%myDim_edge2D) - - real(kind=WP) , intent(inout), optional:: Edt( idemix2_nfbin, partit%myDim_nod2D) - real(kind=WP) , intent(inout), optional:: Eadvh( idemix2_nfbin, partit%myDim_nod2D) - real(kind=WP) , intent(inout), optional:: Eadvs( idemix2_nfbin, partit%myDim_nod2D) - real(kind=WP) , intent(inout), optional:: Ediss( idemix2_nfbin, partit%myDim_nod2D) - real(kind=WP) , intent(inout), optional:: Eforc( idemix2_nfbin, partit%myDim_nod2D) - - real(kind=WP) , intent(in) , optional:: glon(partit%myDim_nod2D+partit%eDim_nod2D),glat(partit%myDim_nod2D+partit%eDim_nod2D) - - real(kind=WP) :: mval + type(t_partit) , intent(inout), target :: partit + type(t_mesh) , intent(in ), target :: mesh + integer , intent(in ) :: ti, tim1, tip1 + character(len=*), intent(in ) :: Ename + real(kind=WP) , intent(inout) :: E( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: Edivh( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: Edivs( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: vel( 2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) + real(kind=WP) , intent(inout) :: cs( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: forc( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: tauE( partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: gradxy_e(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) + real(kind=WP) , intent(inout) :: gradxy_n(2, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) + real(kind=WP) , intent(inout) :: flx_uv( idemix2_nfbin, partit%myDim_edge2D) + real(kind=WP) , intent(inout) :: flx_cs( idemix2_nfbin, partit%myDim_nod2D ) + real(kind=WP) , intent(in ) :: vol_s( partit%myDim_nod2D +partit%eDim_nod2D) + logical , intent(in) :: flag_AB2 + + + real(kind=WP) , intent(inout), optional:: Edt( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout), optional:: Eadvh( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout), optional:: Eadvs( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout), optional:: Ediss( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout), optional:: Eforc( idemix2_nfbin, partit%myDim_nod2D) + !___LOCAL VARIABLES_____________________________________________________ - integer :: node, fbini, nfbin + integer :: node, fbini, nfbin #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" #include "../associate_mesh_ass.h" !_______________________________________________________________________ nfbin=idemix2_nfbin + iwe2_flx_uv(:,:) = 0.0 + iwe2_flx_w( :,:) = 0.0 !_______________________________________________________________________ - ! Exchange energy at ghost nodes before advection ! Exchange all 3 time levels (minimal overhead, avoids array slicing issues) call exchange_nod_fbin(E, partit) !_______________________________________________________________________ - ! compute gradient of iwe2_E_M2 on nodes is need for + ! compute gradient of iwe2_E on nodes call tracer_gradient_elements(E(ti,:,:), gradxy_e, partit, mesh, .False.) call exchange_elem_fbin(gradxy_e, partit) call interp_e2n(gradxy_e, gradxy_n, mesh, partit, .False.) call exchange_nod_fbin(gradxy_n, partit) - + !_______________________________________________________________________ ! compute horizontal superbee advected tracer flux call adv_Ecompart_hor_spctrl_superbee( & - vel , & - E(ti,:,:) , & - gradxy_n , & - dphit , & - flx_uv , & - partit , & - mesh , & - edge_up_dn_tri , & - .True. , & ! do 2nd order in space & time - .True. & ! enforce positive definit + vel & + , E(ti,:,:) & + , gradxy_n & + , flx_uv & + , partit & + , mesh & + , .True. & ! do 2nd order in space & time + , .True. & ! enforce positive definit ) ! compute cross spectral superbee advected tracer flux call adv_Ecompart_crss_spctrl_superbee( & - w , & - E(ti,:,:) , & - dphit , & - flx_cs , & - cflcs , & - partit , & - mesh , & - .True. , & ! do 2nd order in space & time - .True. & ! enforce positive definit + cs & + , E(ti,:,:) & + , dphit & + , flx_cs & + , partit & + , mesh & + , .True. & ! do 2nd order in space & time + , .True. & ! enforce positive definit ) - + + !_______________________________________________________________________ ! compute flux divergence call adv_Ecompart_flx2tra_spctrl( & - flx_uv , & - flx_cs , & - Edivh(ti,:,:) , & - Edivs(ti,:,:) , & - dphit , & - partit , & - mesh & + flx_uv & + ,flx_cs & + ,Edivh(ti,:,:) & + ,Edivs(ti,:,:) & + ,dphit & + ,vol_s & + ,partit & + ,mesh & ) -! if (any(Edivh(ti,:,:)/=Edivh(ti,:,:))) write(*,*) " }-)))d°> found NaN in Edivh(ti,:,:)" -! if (any(Edivs(ti,:,:)/=Edivs(ti,:,:))) write(*,*) " }-)))d°> found NaN in Edivs(ti,:,:)" - + + !_______________________________________________________________________ ! Eden and Olbers 2014, eq. 2 ! integrate E_M2^(n+1) = E_M2^(n) + dt*[ - ! - div(c_uv*E_M2^n) - ! - d/dphi (dphit/dt*E_M2^n) + ! - div(c_uv*E_M2^n) --> (the minus is hidden in the flux computation) + ! - d/dphi (dphit/dt*E_M2^n) --> (the minus is hidden in the flux computation) ! + forc ! + W + T] ! @@ -2219,82 +2217,68 @@ subroutine hsintegrate_Ecompart( & ! └> this part added in wave-wave-interaction ! T_niw + W_niw = -1/tau_niw * E_niw ! --> here variable tauE is already 1/tau - do node= 1, myDim_nod2d+eDim_nod2D - do fbini=2,nfbin-1 - ! Check if this is the first timestep (previous divergence is zero) -! if (abs(Edivh(tim1, fbini, node)) < 1.0e-20_WP .and. abs(Edivs(tim1, fbini, node)) < 1.0e-20_WP) then - ! First timestep: use forward Euler to avoid Adams-Bashforth amplification - E(tip1, fbini, node) = E(ti, fbini, node) & - + dt * (+ Edivh(ti , fbini, node) & ! div(c_uv*E_M2^n) - + Edivs(ti , fbini, node) & ! d/dphi (dphit/dt*E_M2) - + forc( fbini, node) & ! forc - - tauE(node)*E( ti , fbini, node) & ! diss - ) -! else -! ! Subsequent timesteps: use Adams-Bashforth -! E(tip1, fbini, node) = E(ti, fbini, node) & -! + dt * (+ (1.5+idemix2_AB_epsilon)*Edivh(ti , fbini, node) & ! div(c_uv*E_M2^n) -! - (0.5+idemix2_AB_epsilon)*Edivh(tim1, fbini, node) & ! div(c_uv*E_M2^n) -! + (1.5+idemix2_AB_epsilon)*Edivs(ti , fbini, node) & ! d/dphi (dphit/dt*E_M2) -! - (0.5+idemix2_AB_epsilon)*Edivs(tim1, fbini, node) & ! d/dphi (dphit/dt*E_M2) -! + forc( fbini, node) & ! forc -! - tauE(node)*E( ti , fbini, node) & ! diss -! ) -! endif - - if (E(tip1, fbini, node)/=E(tip1, fbini, node) .or. E(tip1, fbini, node)<0.0_WP) then - write(*,*) " }-))))°> found negative/NaN " ,trim(Ename)," advection", E(tip1, fbini, node) - write(*,*) " tip1, fbini, node, myDim_nod2D = ", tip1, fbini, node, myDim_nod2D - write(*,*) " mype = ", mype - write(*,*) " glon, glat = ", glon(node)/rad, glat(node)/rad - write(*,*) " E(ti , fbini, node) = ", E(ti , fbini, node) - write(*,*) " E(tip1, fbini, node) = ", E(tip1, fbini, node) - write(*,*) " dt*forc = ", dt*forc(fbini, node) - write(*,*) " -dt*tau*E = ", -dt*tauE(node)*E( ti , fbini, node) - write(*,*) " dt*Edivh(t) = ", dt*Edivh(ti , fbini, node)!, dt*Edivh(tim1 , fbini, node) -! write(*,*) " dt*Edivh_AB q = ", dt*( (1.5+idemix2_AB_epsilon)*Edivh(ti , fbini, node) - (0.5+idemix2_AB_epsilon)*Edivh(tim1, fbini, node)) - write(*,*) " dt*Edivs(t) = ", dt*Edivs(ti , fbini, node)!, dt*Edivs(tim1 , fbini, node) -! write(*,*) " dt*Edivs_AB = ", dt*( (1.5+idemix2_AB_epsilon)*Edivs(ti , fbini, node) - (0.5+idemix2_AB_epsilon)*Edivs(tim1, fbini, node)) - write(*,*) -! write(*,*) " E(fbin-1,fbin,fbin+1) = ", E(ti,fbini-1, node), E(ti,fbini, node), E(ti,fbini-1, node) -! write(*,*) " W(fbin-1,fbin,fbin+1) = ", w(fbini-1, node), w(fbini, node), w(fbini-1, node) -! write(*,*) " CFLcs(fbin-1,fbin,fbin+1)= ", cflcs(fbini-1, node),cflcs(fbini, node),cflcs(fbini+1, node) -! write(*,*) -! write(*,*) " E = ", E(ti,:, node) -! write(*,*) " W = ", w(:, node), w(fbini, node), w(fbini-1, node) -! write(*,*) " CFLcs = ", cflcs(:, node) - end if - - ! ATTENTION: - ! This line ensures that the compartment energy is always numerically - ! positive, clip off negative values due to rounding error ! - ! BUT this line will also hide a lot of bugs if there are some. - ! If you suspect bugs in the code of the Energy compartment - ! integration comment this line. - E(tip1, fbini, node) = max(0.0_WP, E(tip1, fbini, node)) - end do - - !___________________________________________________________________ - ! Fill ghost cells with periodic boundary values, ensure periodic wrapping - ! in specrtal domain, - E(tip1, 1, node) = E(tip1, nfbin-1, node) ! left ghost = right interior - E(tip1, nfbin, node) = E(tip1, 2, node) ! right ghost = left interior - end do + !_______________________________________________________________________ + ! Adams-Bashforth 2nd order + implicit dissipation + if (flag_AB2) then + do node= 1, myDim_nod2d + do fbini=2,nfbin-1 + E(tip1, fbini, node) = ( E(ti, fbini, node) & + + dt * ( & + + (1.5_WP+idemix2_AB_epsilon)*Edivh(ti , fbini, node) & + - (0.5_WP+idemix2_AB_epsilon)*Edivh(tim1, fbini, node) & + + (1.5_WP+idemix2_AB_epsilon)*Edivs(ti , fbini, node) & + - (0.5_WP+idemix2_AB_epsilon)*Edivs(tim1, fbini, node) & + + forc( fbini, node) & + ) & + ) / (1.0_WP + dt*tauE(node)) + end do + E(tip1, 1, node) = E(tip1, nfbin-1, node) + E(tip1, nfbin, node) = E(tip1, 2, node) + end do + !_______________________________________________________________________ + ! Forward Euler + implicit dissipation + else + do node= 1, myDim_nod2d + do fbini=2,nfbin-1 + E(tip1, fbini, node) = ( E(ti, fbini, node) & + + dt * ( & + + Edivh(ti, fbini, node) & ! div(c_uv*E^n) + + Edivs(ti, fbini, node) & ! d/dphi (w*E^n) + + forc( fbini, node) & ! forc + ) & + ) / (1.0_WP + dt*tauE(node)) + end do + E(tip1, 1, node) = E(tip1, nfbin-1, node) + E(tip1, nfbin, node) = E(tip1, 2, node) + end do + end if !_______________________________________________________________________ ! additional diagnostics if (present(Edt)) Edt(:,:) = (E(tip1, :, 1:myDim_nod2D)-E(ti, :, 1:myDim_nod2D)) - if (present(Eadvh)) Eadvh(:,:) = ((1.5+idemix2_AB_epsilon)*Edivh(ti , :, 1:myDim_nod2D) & - - (0.5+idemix2_AB_epsilon)*Edivh(tim1, :, 1:myDim_nod2D)) + if (present(Eadvh)) then + if (flag_AB2) then + Eadvh(:,:) = ((1.5+idemix2_AB_epsilon)*Edivh(ti , :, 1:myDim_nod2D) & + - (0.5+idemix2_AB_epsilon)*Edivh(tim1, :, 1:myDim_nod2D)) + else + Eadvh(:,:) = Edivh(ti, :, 1:myDim_nod2D) + end if + end if + + if (present(Eadvs)) then + if (flag_AB2) then + Eadvs(:,:) = ((1.5+idemix2_AB_epsilon)*Edivs(ti , :, 1:myDim_nod2D) & + - (0.5+idemix2_AB_epsilon)*Edivs(tim1, :, 1:myDim_nod2D)) + else + Eadvs(:,:) = Edivs(ti, :, 1:myDim_nod2D) + end if + end if - if (present(Eadvs)) Eadvs(:,:) = ((1.5+idemix2_AB_epsilon)*Edivs(ti , :, 1:myDim_nod2D) & - - (0.5+idemix2_AB_epsilon)*Edivs(tim1, :, 1:myDim_nod2D)) - if (present(Ediss)) then do node= 1, myDim_nod2d - Ediss(:,node) = - tauE(node)*E( ti , :, node) + Ediss(:,node) = - tauE(node)*E(tip1, :, node) end do end if @@ -2303,7 +2287,6 @@ subroutine hsintegrate_Ecompart( & end subroutine hsintegrate_Ecompart - ! ! !___________________________________________________________________________ @@ -2360,6 +2343,127 @@ end subroutine compute_vol_wcell + ! + ! + !___________________________________________________________________________ + ! compute volume of scalar cell from bottom to top + ! ~~~~~~~~~o zbar_1~~~~~~~~~~ + ! | + ! x Z_1 + ! | + ! o zbar_2 + ! | + ! x Z_2 + ! | + ! o zbar_3 + ! : + ! : + ! : + ! ---------o zbar_n---------- + ! /////////////////////////// + subroutine compute_vol_nodB2T_fix(vol_nodB2T, mesh, partit) + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_partit) , intent(inout), target :: partit + type(t_mesh) , intent(in ), target :: mesh + real(kind=WP) , intent(inout) :: vol_nodB2T(partit%myDim_nod2D+partit%eDim_nod2D) + !___LOCAL VARIABLES_____________________________________________________ + integer :: node, elem, nz, nln, uln, elnodes(3) + real(kind=WP) :: lcl_sumvol, glb_sumvol, vol +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + vol_nodB2T = 0.0_WP + lcl_sumvol = 0.0_WP + do node = 1, myDim_nod2D + nln = nlevels_nod2D(node)-1 + uln = ulevels_nod2D(node) + do nz=uln,nln + lcl_sumvol = lcl_sumvol + areasvol(nz,node)*abs(zbar(nz)-zbar(nz+1)) + vol_nodB2T(node) = vol_nodB2T(node) + areasvol(nz,node)*abs(zbar(nz)-zbar(nz+1)) + end do + end do !-->do node = 1,node_size + call MPI_Allreduce(lcl_sumvol, glb_sumvol, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + if (partit%mype == 0) then + write(*,*) ' debug: vol_node_fix: ', glb_sumvol + end if + call exchange_nod(vol_nodB2T, partit) + + lcl_sumvol = 0.0_WP + do elem = 1, myDim_elem2D + ! Nodes are uniquely partitioned (e.g., via METIS) — each node belongs + ! to exactly one rank Elements are then distributed so that each rank + ! has all elements touching its owned nodes — but boundary elements + ! necessarily appear on multiple ranks (they share vertices across partitions) + elnodes=mesh%elem2D_nodes(:,elem) + if (elnodes(1) > myDim_nod2D) cycle + nln = nlevels(elem)-1 + uln = ulevels(elem) + do nz=uln,nln + lcl_sumvol = lcl_sumvol + elem_area(elem)*abs(zbar(nz)-zbar(nz+1)) + end do + end do !-->do node = 1,node_size + call MPI_Allreduce(lcl_sumvol, glb_sumvol, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + if (partit%mype == 0) then + write(*,*) ' debug: vol_elem_fix: ', glb_sumvol + end if + + end subroutine compute_vol_nodB2T_fix + + + + ! + ! + !___________________________________________________________________________ + ! compute volume of scalar cell from bottom to top + ! ~~~~~~~~~o zbar_1~~~~~~~~~~ + ! | + ! x Z_1 + ! | + ! o zbar_2 -------+ + ! | | + ! x Z_2 |--------> hnode(2, node) + ! | | + ! o zbar_3--------+ + ! : + ! : + ! : + ! ---------o zbar_n---------- + ! /////////////////////////// + subroutine compute_vol_nodB2T_hnode(vol_nodB2T, mesh, partit) + implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ + type(t_partit) , intent(inout), target :: partit + type(t_mesh) , intent(in ), target :: mesh + real(kind=WP) , intent(inout) :: vol_nodB2T(partit%myDim_nod2D+partit%eDim_nod2D) + !___LOCAL VARIABLES_____________________________________________________ + integer :: node, elem, nz, nln, uln +! real(kind=WP) :: lcl_sumvol, glb_sumvol, vol +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + vol_nodB2T = 0.0_WP + ! lcl_sumvol = 0.0_WP + do node = 1, myDim_nod2D + nln = nlevels_nod2D(node)-1 + uln = ulevels_nod2D(node) + do nz=uln,nln + ! lcl_sumvol = lcl_sumvol + areasvol(nz,node)*hnode(nz,node) + vol_nodB2T(node) = vol_nodB2T(node) + areasvol(nz,node)*hnode(nz,node) + end do + end do !-->do node = 1,node_size + ! call MPI_Allreduce(lcl_sumvol, glb_sumvol, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + ! if (partit%mype == 0) then + ! write(*,*) ' debug: vol_node_hnode: ', glb_sumvol + ! end if + call exchange_nod(vol_nodB2T, partit) + + end subroutine compute_vol_nodB2T_hnode + + + ! ! !___________________________________________________________________________ @@ -2411,6 +2515,9 @@ subroutine compute_hdiff_Eiw( & ! calculate horizontal diffusion term div( grad(Eiw*v0) * tau_h*v0) do edge=1,myDim_edge2D !___________________________________________________________________ + ! ednode ... vertices that form the edge + ednodes = edges(:,edge) + ! deltaX1,deltaY1 ... cross edge dx and dy for the two elements ! that contribute to the edge ! o @@ -2429,8 +2536,6 @@ subroutine compute_hdiff_Eiw( & ! dx1 = edge_cross_dxdy(1,edge) dy1 = edge_cross_dxdy(2,edge) - ! ednode ... vertices that form the edgeiwe_Thdi - ednodes = edges(:,edge) ! el ... elements that contribute to edge edel = edge_tri(:,edge) ! elnodes1 ... nodes that contribute to element el(1) @@ -2639,4 +2744,352 @@ subroutine compute_hdiff_Eiw( & end do end subroutine compute_hdiff_Eiw + + + ! + ! + !___________________________________________________________________________ + ! Check if velocity field is divergence-free using gradient_vec operator + subroutine check_Ecompart_div_uv(vel_uv, div_uv, partit, mesh, compartment_name) + implicit none + type(t_partit), intent(inout), target :: partit + type(t_mesh), intent(in), target :: mesh + real(kind=WP), intent(in) :: vel_uv(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) + real(kind=WP), intent(inout) :: div_uv(idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) + character(len=*), intent(in) :: compartment_name + + integer :: elem, fbini, j, neighbor_elem + real(kind=WP) :: local_div_sum, global_div_sum, global_div_max + real(kind=WP) :: u_neighbor(idemix2_nfbin), v_neighbor(idemix2_nfbin) + +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + ! Compute divergence of velocity field using gradient_vec operator + ! gradient_vec(1:3, elem) are coefficients for ∂/∂x + ! gradient_vec(4:6, elem) are coefficients for ∂/∂y + do elem = 1, myDim_elem2D + + ! Initialize divergence arrays + div_uv(:, elem) = 0.0_WP + + do j = 1, 3 + neighbor_elem = mesh%elem_neighbors(j, elem) + if (neighbor_elem > 0) then + u_neighbor(:) = vel_uv(1, :, neighbor_elem) + v_neighbor(:) = vel_uv(2, :, neighbor_elem) + else + u_neighbor(:) = vel_uv(1, :, elem) + v_neighbor(:) = vel_uv(2, :, elem) + end if + + do fbini = 2, idemix2_nfbin-1 + ! Compute Total divergence + ! Compute gradients using gradient_vec coefficients + ! ∂u/∂x = Σ(gradient_vec(1:3, elem) * u_neighbor) + ! ∂v/∂y = Σ(gradient_vec(4:6, elem) * v_neighbor) + div_uv(fbini, elem) = div_uv(fbini, elem) & + + (mesh%gradient_vec(j , elem)*u_neighbor(fbini)) & + + (mesh%gradient_vec(j+3, elem)*v_neighbor(fbini)) + end do + end do + end do + + end subroutine check_Ecompart_div_uv + + + + ! + ! + !___________________________________________________________________________ + ! Check flux conservation: sum of all divergences weighted by area should be zero + subroutine check_flux_conservation(div_h, div_s, ti, dphit, vol_s, partit, mesh, compartment_name) + implicit none + type(t_partit), intent(inout), target :: partit + type(t_mesh), intent(in), target :: mesh + real(kind=WP), intent(in) :: div_h(3, idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: div_s(3, idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + integer, intent(in) :: ti + real(kind=WP), intent(in) :: dphit(idemix2_nfbin) + real(kind=WP), intent(in) :: vol_s(partit%myDim_nod2D+partit%eDim_nod2D) + character(len=*), intent(in) :: compartment_name + + integer :: node, fbini, lcl_nedge, glb_nedge + real(kind=WP) :: lcl_divh_sum, lcl_divs_sum + real(kind=WP) :: glb_divh_sum, glb_divs_sum + +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + ! Compute local sum: div * area * dphi + ! For a closed domain with no sources/sinks, this should sum to zero + lcl_divh_sum = 0.0_WP + do node = 1, myDim_nod2D + eDim_nod2D ! Full extended domain: telescoping holds locally per rank + do fbini = 2, idemix2_nfbin-1 ! Exclude ghost bins + lcl_divh_sum = lcl_divh_sum + div_h(ti, fbini, node)*vol_s(node) + end do + end do +! write(*,*) lcl_divh_sum, mype + + lcl_divs_sum = 0.0_WP + do node = 1, myDim_nod2D ! Full extended domain: telescoping holds locally per rank + do fbini = 2, idemix2_nfbin-1 ! Exclude ghost bins + lcl_divs_sum = lcl_divs_sum + div_s(ti, fbini, node)*dphit(fbini) + end do + end do + + ! Sum across all MPI ranks + glb_divh_sum = 0.0_WP + glb_divs_sum = 0.0_WP + call MPI_Allreduce(lcl_divh_sum, glb_divh_sum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + call MPI_Allreduce(lcl_divs_sum, glb_divs_sum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + + if (mype == 0) then + write(*,*) ' debug: flux total conservation check (',trim(compartment_name),'):',& + ' Σ(div_h*vols) = ', glb_divh_sum, & + ', Σ(div_s*dphi) = ', glb_divs_sum + end if + + end subroutine check_flux_conservation + + + + ! + ! + !___________________________________________________________________________ + ! Compute and print global total NIW energy for conservation check + subroutine check_global_energy(Ecompart, ti, dphit, vol_s, forc, tauE, partit, mesh, compartment_name) + implicit none + type(t_partit), intent(inout), target :: partit + type(t_mesh), intent(in), target :: mesh + real(kind=WP), intent(in) :: Ecompart(3, idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: vol_s(partit%myDim_nod2D+partit%eDim_nod2D) + integer, intent(in) :: ti + real(kind=WP), intent(in) :: dphit(idemix2_nfbin) + real(kind=WP), intent(in) :: forc(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: tauE(partit%myDim_nod2D+partit%eDim_nod2D) + character(len=*), intent(in) :: compartment_name + + integer :: node, fbini + real(kind=WP) :: lcl_energy, lcl_vol, glb_energy, glb_vol + real(kind=WP) :: lcl_forc, glb_forc, lcl_diss, glb_diss + real(kind=WP) :: lcl_maxE, glb_maxE, lcl_minE, glb_minE + +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + lcl_energy = 0.0_WP + lcl_vol = 0.0_WP + lcl_forc = 0.0_WP + lcl_diss = 0.0_WP + lcl_maxE = -1.0e33 + lcl_minE = 1.0e33 + do node = 1, myDim_nod2D ! Only owned nodes + lcl_vol = lcl_vol + vol_s(node) + do fbini = 2, idemix2_nfbin-1 ! Exclude ghost bins + lcl_energy = lcl_energy + Ecompart(ti, fbini, node) * dphit(fbini) * vol_s(node) + lcl_forc = lcl_forc + forc(fbini, node) * dphit(fbini) * vol_s(node) + lcl_diss = lcl_diss + tauE(node) * Ecompart(ti, fbini, node) * dphit(fbini) * vol_s(node) + lcl_maxE = max(lcl_maxE, Ecompart(ti, fbini, node)) + lcl_minE = min(lcl_minE, Ecompart(ti, fbini, node)) + end do + end do + + ! Sum across all MPI ranks + glb_energy = 0.0_WP + glb_vol = 0.0_WP + glb_forc = 0.0_WP + glb_diss = 0.0_WP + call MPI_Allreduce(lcl_energy, glb_energy, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + call MPI_Allreduce(lcl_vol , glb_vol , 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + call MPI_Allreduce(lcl_forc , glb_forc , 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + call MPI_Allreduce(lcl_diss , glb_diss , 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + call MPI_Allreduce(lcl_minE , glb_minE , 1, MPI_DOUBLE_PRECISION, MPI_MIN, MPI_COMM_FESOM, MPIerr) + call MPI_Allreduce(lcl_maxE , glb_maxE , 1, MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_FESOM, MPIerr) + + + ! Print on rank 0 + if (mype == 0) then + write(*,*) ' debug: global Σ(E_',trim(compartment_name),'*dphi*vols) = ', glb_energy, ' J', & + ', global min(E_',trim(compartment_name),') = ', glb_minE, & + ', global max(E_',trim(compartment_name),') = ', glb_maxE + write(*,*) ' debug: global Σ(forc_',trim(compartment_name),'*dphi*vols) = ', glb_forc, ' W', & + ', global Σ(tau*E_',trim(compartment_name),'*dphi*vols) = ', glb_diss, ' W', & + ', global forc/diss = ', glb_forc/glb_diss, ' W' + end if + + end subroutine check_global_energy + + + ! + !___________________________________________________________________________ + ! Compute and print maximum CFL numbers for horizontal and cross-spectral advection + subroutine check_max_cfl(vel, cs, dphit, partit, mesh, compartment_name) + implicit none + type(t_partit), intent(inout), target :: partit + type(t_mesh), intent(in), target :: mesh + real(kind=WP), intent(in) :: vel(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) + real(kind=WP), intent(in) :: cs(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: dphit(idemix2_nfbin) + character(len=*), intent(in) :: compartment_name + + integer :: edge, fbini, nfbin, node, el(2), el2, ednodes(2) + real(kind=WP) :: dx1, dy1, dx2, dy2, dxdy12(2), edlen, n_x, n_y, n_len + real(kind=WP) :: u1, u2, v1, v2, Ue, CFL_h, CFL_cs + real(kind=WP) :: lcl_cfl_h, glb_cfl_h, lcl_cfl_cs, glb_cfl_cs + +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + nfbin = idemix2_nfbin + lcl_cfl_h = 0.0_WP + lcl_cfl_cs = 0.0_WP + + ! Max horizontal CFL over all edges + do edge = 1, myDim_edge2D + ednodes = edges(:,edge) + el = edge_tri(:,edge) + + dx1 = edge_cross_dxdy(1,edge) + dy1 = edge_cross_dxdy(2,edge) + dxdy12 = edge_dxdy(:,edge)*r_earth + + el2 = el(1) + dx2 = 0.0_WP + dy2 = 0.0_WP + if (el(2) > 0) then + el2 = el(2) + dx2 = edge_cross_dxdy(3,edge) + dy2 = edge_cross_dxdy(4,edge) + dxdy12(1) = dxdy12(1) * (elem_cos(el(1)) + elem_cos(el2)) * 0.5_WP + n_x = ( dy1 + (-dy2))/2 + n_y = ((-dx1) + dx2 )/2 + else + dxdy12(1) = dxdy12(1) * elem_cos(el(1)) + n_x = dy1 + n_y = -dx1 + end if + edlen = sqrt(dxdy12(1)**2 + dxdy12(2)**2) + n_len = sqrt(n_x**2 + n_y**2) + if (n_len > 0.0_WP) then + n_x = n_x / n_len + n_y = n_y / n_len + end if + + do fbini = 2, nfbin-1 + u1 = vel(1, fbini, el(1)) + v1 = vel(2, fbini, el(1)) + u2 = vel(1, fbini, el2) + v2 = vel(2, fbini, el2) + Ue = sqrt((0.5_WP*(u1+u2)*n_x)**2 + (0.5_WP*(v1+v2)*n_y)**2) + CFL_h = Ue * dt / edlen + lcl_cfl_h = max(lcl_cfl_h, CFL_h) + end do + end do + + ! Max cross-spectral CFL over all nodes and bins + do node = 1, myDim_nod2D + do fbini = 2, nfbin-1 + CFL_cs = abs(cs(fbini, node)) * dt / dphit(fbini) + lcl_cfl_cs = max(lcl_cfl_cs, CFL_cs) + end do + end do + + ! Global max across MPI ranks + glb_cfl_h = 0.0_WP + glb_cfl_cs = 0.0_WP + call MPI_Allreduce(lcl_cfl_h , glb_cfl_h , 1, MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_FESOM, MPIerr) + call MPI_Allreduce(lcl_cfl_cs, glb_cfl_cs, 1, MPI_DOUBLE_PRECISION, MPI_MAX, MPI_COMM_FESOM, MPIerr) + + if (mype == 0) then + write(*,*) ' debug: CFL_max_horizontal(',trim(compartment_name),') = ', glb_cfl_h, & + ', CFL_max_cross_spectral(',trim(compartment_name),') = ', glb_cfl_cs +! write(*,*) ' debug: dt_max_FE(',trim(compartment_name),') = ', dt/max(glb_cfl_h, glb_cfl_cs), ' s', & +! ', dt_max_AB2(',trim(compartment_name),') = ', 0.5_WP*dt/max(glb_cfl_h, glb_cfl_cs), ' s' + end if + + end subroutine check_max_cfl + + +! !=========================================================================== +! ! Compute velocity flux divergence consistent with the edge-based Superbee +! ! flux scheme. For tracer h=1, the Superbee flux reduces to -vflux (since +! ! gradients are zero for a constant field). This gives the numerical velocity +! ! divergence as seen by the flux operator. +! ! +! ! Used for compatible transport: E(n+1) = [E(n)+dt*Edivh] / [1+dt*div_vel] +! ! which preserves constant fields exactly while maintaining conservation. +! subroutine compute_vel_div_consistent(vel, div_vel, partit, mesh) +! implicit none +! type(t_partit), intent(inout), target :: partit +! type(t_mesh), intent(in), target :: mesh +! real(kind=WP), intent(in) :: vel(2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) +! real(kind=WP), intent(inout) :: div_vel(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) +! +! integer :: edge, fbini, nfbin, node, el(2), el2, ednodes(2) +! real(kind=WP) :: dx1, dy1, dx2, dy2, u1, v1, u2, v2, vflux +! +! #include "../associate_part_def.h" +! #include "../associate_mesh_def.h" +! #include "../associate_part_ass.h" +! #include "../associate_mesh_ass.h" +! +! nfbin = idemix2_nfbin +! div_vel = 0.0_WP +! +! ! Edge loop: compute vflux using SAME geometry as Superbee routine +! do edge = 1, myDim_edge2D +! ednodes = edges(:, edge) +! el = edge_tri(:, edge) +! +! dx1 = edge_cross_dxdy(1, edge) +! dy1 = edge_cross_dxdy(2, edge) +! +! dx2 = 0.0_WP +! dy2 = 0.0_WP +! el2 = el(1) +! if (el(2) > 0) then +! el2 = el(2) +! dx2 = edge_cross_dxdy(3, edge) +! dy2 = edge_cross_dxdy(4, edge) +! end if +! +! do fbini = 2, nfbin-1 +! u1 = vel(1, fbini, el(1)) +! v1 = vel(2, fbini, el(1)) +! u2 = vel(1, fbini, el2) +! v2 = vel(2, fbini, el2) +! +! vflux = (-v1*dx1 + u1*dy1) + (v2*dx2 - u2*dy2) +! +! ! For tracer h=1: flux_h1 = -vflux +! ! Assembly matches Superbee: div(node1) += flux, div(node2) -= flux +! div_vel(fbini, ednodes(1)) = div_vel(fbini, ednodes(1)) - vflux +! div_vel(fbini, ednodes(2)) = div_vel(fbini, ednodes(2)) + vflux +! end do +! end do +! +! ! Assemble halo contributions to owner (same as for div_h) +! call assemble_nod2D_fbin(div_vel, partit) +! ! Distribute complete values to halos +! call exchange_nod_fbin(div_vel, partit) +! ! Normalize by area (same as for div_h) +! do node = 1, myDim_nod2D + eDim_nod2D +! do fbini = 2, nfbin-1 +! div_vel(fbini, node) = div_vel(fbini, node) / areasvol(1, node) +! end do +! end do +! +! end subroutine compute_vel_div_consistent + + end module g_cvmix_idemix2 + diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 728ad5ece..f7aa87591 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1330,9 +1330,9 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream( elem2D , myDim_elem2D , 'iwe2_fbot' , 'bottom forcing' , 'm^3/s^3', iwe2_fbot_e(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_fsrf' , 'surface forcing' , 'm^3/s^3', iwe2_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_cn' , 'baroclinic velocity' , 'm/s' , iwe2_cn(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_e' , 'baroclinic velocity elem' , 'm/s' , iwe2_cn_e(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_gradx', 'gradx baroclinic velocity' , '1/s' , iwe2_cn_gradx(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_grady', 'grady baroclinic velocity' , '1/s' , iwe2_cn_grady(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + ! call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_e' , 'baroclinic velocity elem' , 'm/s' , iwe2_cn_e(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + ! call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_gradx', 'gradx baroclinic velocity' , '1/s' , iwe2_cn_gradx(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + ! call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_grady', 'grady baroclinic velocity' , '1/s' , iwe2_cn_grady(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (idemix2_enable_M2) then @@ -1340,7 +1340,6 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_tau' , 'M2 dissipation timescale' , 's' , iwe2_M2_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_forc' , 'M2 forcing' , 'm^3/s^3/rad', iwe2_fM2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_w' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_w_e' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w_e(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_u' , 'M2 zonal propag.' , 'm/s' , iwe2_M2_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_v' , 'M2 merid. propag.' , 'm/s' , iwe2_M2_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2' , 'M2 wave energy' , 'm^2/s^2' , iwe2_E_M2( iwe2_taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1352,6 +1351,8 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advs' , 'EM2 spectral advection' , 'm^2/s^3' , iwe2_E_M2_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_diss' , 'EM2 dissipation' , 'm^2/s^3' , iwe2_E_M2_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_forc' , 'EM2 forcing tendency' , 'm^2/s^3' , iwe2_E_M2_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + ! call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_div_uv' , ' divergence of M2 group vel.' , '1/s' , iwe2_M2_div_uv(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if if (idemix2_enable_niw) then @@ -1359,7 +1360,6 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_niw_tau' , 'niw dissipation timescale' , 's' , iwe2_niw_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_forc' , 'niw forcing' , 'm^3/s^3/rad', iwe2_fniw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_w' , 'niw cross. spectr. propag.' , 'rad/s' , iwe2_niw_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_w_e' , 'niw cross. spectr. propag.' , 'rad/s' , iwe2_niw_w_e(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_u' , 'niw zonal propag.' , 'm/s' , iwe2_niw_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_v' , 'niw merid. propag.' , 'm/s' , iwe2_niw_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw' , 'niw wave energy' , 'm^2/s^2' , iwe2_E_niw( iwe2_taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1371,6 +1371,8 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advs' , 'Eniw spectral advection' , 'm^2/s^3' , iwe2_E_niw_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_diss' , 'Eniw dissipation' , 'm^2/s^3' , iwe2_E_niw_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_forc' , 'Eniw forcing tendency' , 'm^2/s^3' , iwe2_E_niw_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + ! call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_div_uv' , 'divergence of niw group vel.' , '1/s' , iwe2_niw_div_uv(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if if (idemix2_enable_M2 .or. idemix2_enable_niw) then From 2b37652ada5f6cbb416aa3d1bf680aac6622160f Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 27 May 2026 14:26:03 +0200 Subject: [PATCH 28/63] fix some problems in idemix and idemix2, add some more idemix2 variables --- src/cvmix_driver/cvmix_idemix2.F90 | 131 +++---- src/cvmix_driver/gen_modules_cvmix_idemix.F90 | 7 +- .../gen_modules_cvmix_idemix2.F90 | 343 ++++++++++++------ src/io_meandata.F90 | 44 ++- 4 files changed, 316 insertions(+), 209 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 761127e9c..89c7f97fd 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -1030,24 +1030,30 @@ end subroutine compute_vdiff_vdiss_Eiw ! Integrate vertical part of internal wave energy idemix equation, solve vertical ! diffusion an dissipation implicitly over the water column. Keep in mind Eiw lives ! on the full depth levels -subroutine compute_Eiw_waveinteract( & - nlev , & - nfbin , & - dzw , & - dphi , & - dt , & - E_iw_old , & - E_iw_new , & - E_M2_old , & - E_M2_new , & - E_M2_struct , & - alpha_M2_c , & - tau_M2 , & - E_niw_old , & - E_niw_new , & - E_niw_struct , & - tau_niw , & - idemix2_const_userdef & +subroutine compute_Eiw_waveinteract( & + nlev & + , nfbin & + , dzw & + , dphi & + , dt & + , flag_posdef & + , E_iw_old & + , E_iw_new & + , E_M2_old & + , E_M2_new & + , E_M2_struct & + , alpha_M2_c & + , tau_M2 & + , E_niw_old & + , E_niw_new & + , E_niw_struct & + , tau_niw & + , idemix2_const_userdef & + , E_iw_dt & + , E_iw_diss_M2 & + , E_iw_diss_niw & + , E_M2_dt & + , E_M2_diss_wwi & ) !___Input/Output____________________________________________________________ type(idemix2_type), intent(in ), optional, target :: idemix2_const_userdef @@ -1056,6 +1062,7 @@ subroutine compute_Eiw_waveinteract( & real(cvmix_r8) , intent(in ) :: dzw(nlev-1) ! --> layer thickness real(cvmix_r8) , intent(in ) :: dphi(nfbin) real(cvmix_r8) , intent(in ) :: dt + logical , intent(in ) :: flag_posdef real(cvmix_r8) , intent(in ) :: E_iw_old(nlev) real(cvmix_r8) , intent(inout) :: E_iw_new(nlev) real(cvmix_r8) , intent(in ), optional :: E_M2_old(nfbin) @@ -1066,11 +1073,19 @@ subroutine compute_Eiw_waveinteract( & real(cvmix_r8) , intent(in ), optional :: E_niw_old(nfbin) real(cvmix_r8) , intent(inout), optional :: E_niw_new(nfbin) real(cvmix_r8) , intent(in ), optional :: E_niw_struct(nfbin) - real(cvmix_r8) , optional :: tau_niw + real(cvmix_r8) , intent(in ), optional :: tau_niw + + ! optional diagnostics + real(cvmix_r8) , intent(inout), optional :: E_iw_dt(nlev) + real(cvmix_r8) , intent(inout), optional :: E_iw_diss_M2(nlev) + real(cvmix_r8) , intent(inout), optional :: E_iw_diss_niw(nlev) + real(cvmix_r8) , intent(inout), optional :: E_M2_dt(nfbin) + real(cvmix_r8) , intent(inout), optional :: E_M2_diss_wwi(nfbin) !___Local___________________________________________________________________ integer :: nz, fbini - real(cvmix_r8) :: vint, sint, aM2c, M2_diss, fmin, small=1.0e-12_cvmix_r8 + real(cvmix_r8) :: vint, sint, aM2c, fmin, small=1.0e-12_cvmix_r8 + real(cvmix_r8), dimension(:) :: M2_diss(nfbin), IW_diss(nlev) type(idemix2_type), pointer :: idemix2_const_in ! do pointer into save variable or into user defined input variable @@ -1098,45 +1113,39 @@ subroutine compute_Eiw_waveinteract( & sint = sint + E_M2_old(fbini)*dphi(fbini) end do + ! initialise M2 WWI dissipation + M2_diss = 0.0_cvmix_r8 + ! update M2 energy: interaction of M2 and continuum aM2c = alpha_M2_c aM2c = max(0.0_cvmix_r8,min(aM2c,1./max(small,dt*vint))) ! FP 2020 aM2c = max(0.0_cvmix_r8,min(aM2c,1./max(small,dt*sint))) + do fbini = 2, nfbin-1 - M2_diss = aM2c*vint*E_M2_old(fbini) - M2_diss = min(M2_diss, E_M2_new(fbini)/max(small,dt)) - E_M2_new(fbini) = E_M2_new(fbini)-dt*M2_diss - E_M2_new(fbini) = max(0.0_cvmix_r8, E_M2_new(fbini)) -! if (E_M2_new(fbini)/=E_M2_new(fbini) .or. E_M2_new(fbini)<0.0_cvmix_r8) then -! write(*,*) " }-))))°> found negative/NaN E_M2_new from WWI M2", E_M2_new(fbini) -! write(*,*) "fbini = ", fbini -! write(*,*) "E_M2_new(fbini) = ", E_M2_new(fbini) -! write(*,*) "E_M2_old(fbini) = ", E_M2_old(fbini) -! write(*,*) "M2_diss = ", -dt*M2_diss -! write(*,*) "aM2c = ", aM2c -! write(*,*) "vint = ", vint -! end if - end do + M2_diss(fbini) = aM2c*vint*E_M2_old(fbini) + M2_diss(fbini) = min(M2_diss(fbini), E_M2_new(fbini)/max(small,dt)) + E_M2_new(fbini) = E_M2_new(fbini)-dt*M2_diss(fbini) + E_M2_new(fbini) = merge(max(0.0_cvmix_r8, E_M2_new(fbini)), E_M2_new(fbini), flag_posdef) + end do - ! update E_iw from E_M2 + ! optional M2 WWI diagnostic + if (present(E_M2_dt)) E_M2_dt(:) = E_M2_dt(:) - dt*M2_diss(:) + if (present(E_M2_diss_wwi)) E_M2_diss_wwi(:) = -dt*M2_diss(:) + + ! update E_iw from E_M2 through wave-wave-interaction + IW_diss(:) = 0.0_cvmix_r8 do nz = 1, nlev fmin = min( 0.5_cvmix_r8/dt,aM2c*vint ) ! flux limiter - E_iw_new(nz) = E_iw_new(nz) & - + dt * tau_M2* sint * E_M2_struct(nz) & - + dt * fmin * sint * E_M2_struct(nz) - E_iw_new(nz) = max(0.0_cvmix_r8, E_iw_new(nz)) -! if (E_iw_new(nz)/=E_iw_new(nz) .or. E_iw_new(nz)<0.0_cvmix_r8) then -! write(*,*) " }-))))°> found negative/NaN Eiw_new from WWI M2", E_iw_new(nz) -! write(*,*) "nz = ", nz -! write(*,*) "E_iw_new(nz) = ", E_iw_new(nz) -! write(*,*) "E_M2_new = ", minval(E_M2_new), maxval(E_M2_new) -! write(*,*) "E_M2_old = ", minval(E_M2_old), maxval(E_M2_old) -! write(*,*) "tau_M2 = ", tau_M2 -! write(*,*) "fmin = ", fmin -! write(*,*) "sint = ", sint -! write(*,*) "E_M2_struct(nz) = ", E_M2_struct(nz) -! end if + IW_diss(nz) = dt * tau_M2* sint * E_M2_struct(nz) & + + dt * fmin * sint * E_M2_struct(nz) + E_iw_new(nz) = E_iw_new(nz) + IW_diss(nz) + E_iw_new(nz) = merge(max(0.0_cvmix_r8, E_iw_new(nz)), E_iw_new(nz), flag_posdef) end do + + ! optional E_iw diagnostic + if (present(E_iw_dt)) E_iw_dt = E_iw_dt + IW_diss + if (present(E_iw_diss_M2)) E_iw_diss_M2 = IW_diss + end if !___________________________________________________________________________ @@ -1147,20 +1156,18 @@ subroutine compute_Eiw_waveinteract( & sint = sint + E_niw_old(fbini)*dphi(fbini) end do - ! update E_iw from E_niw + ! update E_iw from E_niw through wave-wave-interaction + IW_diss(:) = 0.0_cvmix_r8 do nz = 1, nlev - E_iw_new(nz) = E_iw_new(nz) & - + dt * tau_niw * sint * E_niw_struct(nz) - E_iw_new(nz) = max(0.0_cvmix_r8, E_iw_new(nz)) -! if (E_iw_new(nz)/=E_iw_new(nz) .or. E_iw_new(nz)<0.0_cvmix_r8 ) then -! write(*,*) " }-))))°> found negative/NaN Eiw_new from WWI NIW", E_iw_new(nz) -! write(*,*) "nz = ", nz -! write(*,*) "E_iw_new(nz) = ", E_iw_new(nz) -! write(*,*) "tau_niw = ", tau_niw -! write(*,*) "sint = ", sint -! write(*,*) "E_niw_struct(nz)= ", E_niw_struct(nz) -! end if + IW_diss(nz) = dt * tau_niw * sint * E_niw_struct(nz) + E_iw_new(nz) = E_iw_new(nz) + IW_diss(nz) + E_iw_new(nz) = merge(max(0.0_cvmix_r8, E_iw_new(nz)), E_iw_new(nz), flag_posdef) end do + + ! optional E_iw diagnostic + if (present(E_iw_dt)) E_iw_dt = E_iw_dt + IW_diss + if (present(E_iw_diss_niw)) E_iw_diss_niw = IW_diss + end if end subroutine compute_Eiw_waveinteract diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix.F90 index 615d1ae51..2c32e9a80 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix.F90 @@ -133,7 +133,7 @@ subroutine init_cvmix_idemix(partit, mesh) !_______________________________________________________________________ if(mype==0) then write(*,*) '____________________________________________________________' - write(*,*) ' --> initialise IDEMIX' + write(*,*) ' --> initialise IDEMIX', mype write(*,*) end if @@ -249,8 +249,8 @@ subroutine init_cvmix_idemix(partit, mesh) write(*,*) ' --> check your namelist.cvmix, idemix_surforc_file & ' write(*,*) ' idemix_botforc_file' write(*,*) '____________________________________________________________________' + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if !_______________________________________________________________________ @@ -310,8 +310,9 @@ subroutine init_cvmix_idemix(partit, mesh) write(*,*) ' --> check your namelist.cvmix, idemix_surforc_file & ' write(*,*) ' idemix_botforc_file' write(*,*) '____________________________________________________________________' + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if - call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) + end if !_______________________________________________________________________ diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 1ce5f02ce..4c0756a18 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -31,7 +31,7 @@ module g_cvmix_idemix2 !___________________________________________________________________________ ! module calls from FESOM - use g_config , only: dt, flag_debug + use g_config , only: dt, flag_debug, logfile_outfreq use o_param use MOD_MESH USE MOD_PARTIT @@ -173,40 +173,55 @@ module g_cvmix_idemix2 ! CVMIX-IDEMIX variables real(kind=WP), allocatable, dimension(:) :: iwe2_phit, iwe2_phiu, iwe2_dphit, iwe2_dphiu - ! M2 related global variables + ! + ! --- M2 related global variables --- real(kind=WP) :: iwe2_omega_M2 real(kind=WP), allocatable, dimension(:,:,:):: iwe2_M2_uv, iwe2_E_M2, iwe2_E_M2_divh, iwe2_E_M2_divs real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_w, iwe2_fM2, iwe2_E_M2_struct real(kind=WP), allocatable, dimension(:) :: w_M2_e, iwe2_alpha_M2_c, iwe2_M2_tau - real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_M2_dt, iwe2_E_M2_advh, iwe2_E_M2_advs, iwe2_E_M2_diss, iwe2_E_M2_forc - real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_div_uv - - ! niw related global variables + + ! optional diagnostic + real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_M2_dt , & + iwe2_E_M2_advh, iwe2_E_M2_advs , & + iwe2_E_M2_diss, iwe2_E_M2_diss_wwi, & + iwe2_E_M2_forc + + + ! --- niw related global variables --- real(kind=WP), allocatable, dimension(:) :: iwe2_omega_niw real(kind=WP), allocatable, dimension(:,:,:):: iwe2_niw_uv, iwe2_E_niw, iwe2_E_niw_divh, iwe2_E_niw_divs real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_w, iwe2_fniw, iwe2_E_niw_struct real(kind=WP), allocatable, dimension(:) :: w_niw_e, iwe2_niw_tau - real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_niw_dt, iwe2_E_niw_advh, iwe2_E_niw_advs, iwe2_E_niw_diss, iwe2_E_niw_forc - real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_div_uv - ! general idemix variable + ! optional diagnostic + real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_niw_dt , & + iwe2_E_niw_advh, iwe2_E_niw_advs , & + iwe2_E_niw_diss, & + iwe2_E_niw_forc + + ! --- Eiw - internal wave energy related variables --- + real(kind=WP), allocatable, dimension(:,:,:):: iwe2_E_iw + real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_iw_diss + real(kind=WP), allocatable, dimension(:) :: iwe_E_iw_vint + + ! optional diagnostic + real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_iw_dt, iwe2_E_iw_fbot, & + iwe2_E_iw_vdif, iwe2_E_iw_hdif + real(kind=WP), allocatable, dimension(:) :: iwe2_E_iw_fsrf + real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_iw_diss_M2, iwe2_E_iw_diss_niw + + real(kind=WP), allocatable, dimension(:,:) :: iwe2_Av + + ! --- general idemix variable --- real(kind=WP), allocatable, dimension(:) :: iwe2_cn real(kind=WP), allocatable, dimension(:,:) :: iwe2_c0, iwe2_v0, iwe2_alpha_c - ! forcing realted variables + ! --- forcing realted variables --- real(kind=WP), allocatable, dimension(:) :: iwe2_topo_hrms, iwe2_topo_hlam, iwe2_topo_dist real(kind=WP), allocatable, dimension(:) :: iwe2_fbot_e, iwe2_fleew, iwe2_fsrf real(kind=WP), allocatable, dimension(:,:) :: iwe2_fbot - ! Eiw - internal wave energy related variables - real(kind=WP), allocatable, dimension(:,:,:):: iwe2_E_iw - real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_iw_diss, iwe2_E_iw_dt, iwe2_E_iw_fbot, & - iwe2_E_iw_vdif, iwe2_E_iw_hdif - real(kind=WP), allocatable, dimension(:) :: iwe2_E_iw_fsrf, iwe_E_iw_vint - - real(kind=WP), allocatable, dimension(:,:) :: iwe2_Av - - ! support variables + ! --- support variables --- real(kind=WP), allocatable, dimension(:) :: vol_nodB2T real(kind=WP), allocatable, dimension(:,:) :: vol_wcelli integer , allocatable, dimension(:,:) :: edge_up_dn_tri @@ -341,7 +356,10 @@ subroutine init_cvmix_idemix2(partit, mesh) ! initialise Eiw - internal wave energy variables ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) allocate(iwe2_E_iw( 3, nl, node_size)) - allocate(iwe2_E_iw_diss(nl, node_size), iwe2_E_iw_dt(nl, node_size), iwe2_E_iw_fbot(nl, node_size)) + allocate( iwe2_E_iw_diss(nl, node_size) & + , iwe2_E_iw_dt( nl, node_size) & + , iwe2_E_iw_fbot(nl, node_size) & + ) allocate(iwe2_E_iw_vdif(nl, node_size), iwe2_E_iw_hdif(nl, node_size)) allocate(iwe2_E_iw_fsrf(node_size)) iwe2_E_iw( :,:,:)= 0.0_WP @@ -356,6 +374,10 @@ subroutine init_cvmix_idemix2(partit, mesh) ! initialise M2 variables if (idemix2_enable_M2) then + ! dissipation of E_iw through E_M2 + allocate( iwe2_E_iw_diss_M2(nl, node_size)) + iwe2_E_iw_diss_M2(:,:)= 0.0_WP + ! M2 energy dissipation allocate(iwe2_alpha_M2_c(node_size)) iwe2_alpha_M2_c(:) = 0.0_WP @@ -375,9 +397,6 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_M2_uv(:,:,:) = 0.0_WP iwe2_M2_w(:,:) = 0.0_WP - allocate(iwe2_M2_div_uv( nfbin,elem_size)) - iwe2_M2_div_uv = 0.0_WP - ! M2 forcing allocate(iwe2_fM2(nfbin, node_size)) iwe2_fM2(:,:) = 0.0_WP @@ -397,22 +416,28 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_M2_struct(:,:) = 0.0_WP ! diagnostic for M2 spectral energy advection - allocate( iwe2_E_M2_dt( nfbin, myDim_nod2D) & - , iwe2_E_M2_advh(nfbin, myDim_nod2D) & - , iwe2_E_M2_advs(nfbin, myDim_nod2D) & - , iwe2_E_M2_diss(nfbin, myDim_nod2D) & - , iwe2_E_M2_forc(nfbin, myDim_nod2D) & + allocate( iwe2_E_M2_dt( nfbin, myDim_nod2D) & ! total change in E_M2 + , iwe2_E_M2_advh( nfbin, myDim_nod2D) & + , iwe2_E_M2_advs( nfbin, myDim_nod2D) & + , iwe2_E_M2_diss( nfbin, myDim_nod2D) & + , iwe2_E_M2_diss_wwi(nfbin, myDim_nod2D) & + , iwe2_E_M2_forc( nfbin, myDim_nod2D) & ) - iwe2_E_M2_dt( :,:) = 0.0_WP - iwe2_E_M2_advh(:,:) = 0.0_WP - iwe2_E_M2_advs(:,:) = 0.0_WP - iwe2_E_M2_diss(:,:) = 0.0_WP - iwe2_E_M2_forc(:,:) = 0.0_WP + iwe2_E_M2_dt( :,:) = 0.0_WP + iwe2_E_M2_advh( :,:) = 0.0_WP + iwe2_E_M2_advs( :,:) = 0.0_WP + iwe2_E_M2_diss( :,:) = 0.0_WP + iwe2_E_M2_diss_wwi(:,:) = 0.0_WP + iwe2_E_M2_forc( :,:) = 0.0_WP end if ! initialise niw variables if (idemix2_enable_niw) then + ! dissipation of E_iw through E_M2 + allocate( iwe2_E_iw_diss_niw(nl, node_size)) + iwe2_E_iw_diss_niw(:,:)= 0.0_WP + ! niw frequency allocate(iwe2_omega_niw(node_size)) iwe2_omega_niw(:) = 0.0_WP @@ -432,18 +457,15 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_niw_uv(:,:,:) = 0.0_WP iwe2_niw_w(:,:) = 0.0_WP - allocate(iwe2_niw_div_uv( nfbin,elem_size)) - iwe2_niw_div_uv = 0.0_WP - ! niw forcing allocate(iwe2_fniw(nfbin, node_size)) iwe2_fniw(:,:) = 0.0_WP ! niw wave energy, and divergence of niw wave energy ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) - allocate( iwe2_E_niw( 3, nfbin, node_size) & - , iwe2_E_niw_divh(3, nfbin, node_size) & - , iwe2_E_niw_divs(3, nfbin, node_size) & + allocate( iwe2_E_niw( 3, nfbin, node_size) & + , iwe2_E_niw_divh(3, nfbin, node_size) & + , iwe2_E_niw_divs(3, nfbin, node_size) & ) iwe2_E_niw( :,:,:)= 0.0_WP iwe2_E_niw_divh( :,:,:)= 0.0_WP @@ -454,17 +476,17 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_niw_struct(:,:) = 0.0_WP ! diagnostic for niw spectral energy advection - allocate( iwe2_E_niw_dt( nfbin, myDim_nod2D) & - , iwe2_E_niw_advh(nfbin, myDim_nod2D) & - , iwe2_E_niw_advs(nfbin, myDim_nod2D) & - , iwe2_E_niw_diss(nfbin, myDim_nod2D) & - , iwe2_E_niw_forc(nfbin, myDim_nod2D) & + allocate( iwe2_E_niw_dt( nfbin, myDim_nod2D) & + , iwe2_E_niw_advh( nfbin, myDim_nod2D) & + , iwe2_E_niw_advs( nfbin, myDim_nod2D) & + , iwe2_E_niw_diss( nfbin, myDim_nod2D) & + , iwe2_E_niw_forc( nfbin, myDim_nod2D) & ) - iwe2_E_niw_dt( :,:) = 0.0_WP - iwe2_E_niw_advh(:,:) = 0.0_WP - iwe2_E_niw_advs(:,:) = 0.0_WP - iwe2_E_niw_diss(:,:) = 0.0_WP - iwe2_E_niw_forc(:,:) = 0.0_WP + iwe2_E_niw_dt( :,:) = 0.0_WP + iwe2_E_niw_advh( :,:) = 0.0_WP + iwe2_E_niw_advs( :,:) = 0.0_WP + iwe2_E_niw_diss( :,:) = 0.0_WP + iwe2_E_niw_forc( :,:) = 0.0_WP end if @@ -576,9 +598,10 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) '____________________________________________________________________' print *, achar(27)//'[0m' write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if end if - if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + t1=MPI_Wtime() if (mype==0) write(*,*) ' │ └> elapsed time:', t1-t0 end if ! --> if (idemix2_enable_M2) then @@ -638,9 +661,10 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) '____________________________________________________________________' print *, achar(27)//'[0m' write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if end if - if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + ! NIWs are super-inertial (ω_niw > |f|), which is essential for their propagation as internal waves. ! The factor 1.05 ensures the frequency is 5% above the local inertial frequency. @@ -721,9 +745,9 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) '____________________________________________________________________' print *, achar(27)//'[0m' write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if end if - if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) t1=MPI_Wtime() if (mype==0) write(*,*) ' │ └> elapsed time:', t1-t0 end if !--> if (idemix2_enable_bot) then @@ -753,9 +777,9 @@ subroutine init_cvmix_idemix2(partit, mesh) ! write(*,*) '____________________________________________________________________' ! print *, achar(27)//'[0m' ! write(*,*) +! call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) ! end if ! end if -! if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) ! end if ! --> if (idemix2_enable_leew) then !_______________________________________________________________________ @@ -781,9 +805,9 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) '____________________________________________________________________' print *, achar(27)//'[0m' write(*,*) + call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if end if - if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) ! topo_hlam (Topographic Wavelength), Definition: Characteristic horizontal length scale of topographic features. ! Units: Meters (m), Role: Represents the dominant wavelength of seafloor roughness. Used to normalize the topographic forcing. @@ -805,8 +829,7 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) call par_ex(partit%MPI_COMM_FESOM, partit%mype, 0) end if - end if - if (.not. file_exist) call par_ex(partit%MPI_COMM_FESOM, partit%mype) + end if ! In the M2 tidal and NIW energy calculations: ! --> fxc = topo_hrms(i,j)**2 * 2*pi / (1d-12 + topo_lam(i,j)) @@ -887,8 +910,9 @@ end subroutine init_cvmix_idemix2 ! !=========================================================================== ! calculate IDEMIX2 internal wave energy and its dissipation - subroutine calc_cvmix_idemix2(partit, mesh) + subroutine calc_cvmix_idemix2(istep, partit, mesh) implicit none + integer, intent(in) :: istep type(t_mesh), intent(in), target :: mesh type(t_partit), intent(inout), target :: partit integer :: node, elem, edge, node_size, elem_size, k, fbini, nfbin, nodeH_size, elemH_size @@ -898,6 +922,10 @@ subroutine calc_cvmix_idemix2(partit, mesh) real(kind=WP) :: cn, cn_e, cn_gradx_e, cn_grady_e, omega_niw_e logical :: topo_shelf=.False. logical :: debug=.false. + ! Timing variables + real(kind=WP) :: t_start, t_end, t0, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10 + real(kind=WP) :: time_params, time_groupvel, time_M2_integ, time_niw_integ + real(kind=WP) :: time_Eiw_vdiff, time_Eiw_hdiff, time_waveint, time_Kv_Av, time_total #include "../associate_part_def.h" #include "../associate_mesh_def.h" @@ -908,6 +936,11 @@ subroutine calc_cvmix_idemix2(partit, mesh) elem_size = myDim_elem2D elemH_size = myDim_elem2D+eDim_elem2D nfbin = idemix2_nfbin + + !_______________________________________________________________________ + ! Start total timing + t_start = MPI_Wtime() + !_______________________________________________________________________ ! do tau timestepping indices shift otaum1= iwe2_taum1 @@ -926,6 +959,8 @@ subroutine calc_cvmix_idemix2(partit, mesh) ! call compute_vol_nodB2T_hnode(vol_nodB2T, mesh, partit) !_______________________________________________________________________ + ! 1. Compute IDEMIX2 parameters (cn, alpha_c, v0, c0, tau, struct functions) + t0 = MPI_Wtime() do node=1, myDim_nod2D+eDim_nod2D !___________________________________________________________________ ! re-initialse cross spectral velocites, for later accumulation through @@ -1102,11 +1137,12 @@ subroutine calc_cvmix_idemix2(partit, mesh) end if end do ! --> do node=1, myDim_nod2D+eDim_nod2D - - + t1 = MPI_Wtime() + time_params = t1 - t0 !_______________________________________________________________________ - ! 5th. compute idemix2 group velocites for M2 an NIW + ! 2. Compute idemix2 group velocites for M2 an NIW + t1 = MPI_Wtime() do elem = 1, myDim_elem2D nln = nlevels(elem)-1 uln = ulevels(elem) @@ -1218,7 +1254,9 @@ subroutine calc_cvmix_idemix2(partit, mesh) end if ! --> at the end we still need to normalize iwe2_M2_w and iwe2_niw_w ! with the scalararea! - end do ! --> do elem = 1, myDim_elem2D + end do ! --> do elem = 1, myDim_elem2D + t2 = MPI_Wtime() + time_groupvel = t2 - t1 ! finalize elem2node averaging of iwe2_M2_w and iwe2_niw_w ! cross spectral exachange has to be related to nodes, since general advection @@ -1241,10 +1279,11 @@ subroutine calc_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ - ! 6th. horizontal spectral integrate energy compartment E_M2^(n+1) and + ! 3. Horizontal spectral integrate energy compartment E_M2^(n+1) and ! E_niw^(n+1) equation. ! dE/dt = -div(vec_u * E) - tau*E + Forc ! E^(n+1) = E^n + dt*( -div(vec_u^n*E^n) - tau*E^n + Forc^n) + t3 = MPI_Wtime() if (idemix2_enable_M2) then call hsintegrate_Ecompart( & iwe2_taum1, iwe2_tau, iwe2_taup1 & @@ -1273,10 +1312,13 @@ subroutine calc_cvmix_idemix2(partit, mesh) ) ! Compute global total NIW energy for conservation check - call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') -! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'M2') - end if + ! call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') + ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'M2') + end if + t4 = MPI_Wtime() + time_M2_integ = t4 - t3 + t4 = MPI_Wtime() if (idemix2_enable_niw) then call hsintegrate_Ecompart( & iwe2_taum1, iwe2_tau, iwe2_taup1 & @@ -1305,15 +1347,15 @@ subroutine calc_cvmix_idemix2(partit, mesh) ) ! Compute global total NIW energy for conservation check - call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') -! call check_max_cfl(iwe2_niw_uv, iwe2_niw_w, iwe2_dphit, partit, mesh, 'niw') -! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'niw') - end if - - + ! call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') + ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'niw') + end if + t5 = MPI_Wtime() + time_niw_integ = t5 - t4 !_______________________________________________________________________ - ! 7th. Integrate IDEMIX equation vertical, solve vertical diffusion and + ! 4. Integrate IDEMIX equation vertical, solve vertical diffusion and + t6 = MPI_Wtime() ! dissipation part implicitly ! Eiw^(t+1) = Eiw^(t) + dt*[ d/dz( c_0 * tau_v * d/dz(c_0*E_iw))^(t+1) ! - alpha_c*Eiw^(t+1) @@ -1338,8 +1380,16 @@ subroutine calc_cvmix_idemix2(partit, mesh) , Eiw_bot = iwe2_E_iw_fbot( uln:nln , node) & ! optional: diagnostic ) end do ! --> do node = 1, myDim_nod2D + t7 = MPI_Wtime() + time_Eiw_vdiff = t7 - t6 - ! 8th. add lateral diffusion term (see. Olbers D., Eden C., 2013, A Global Model + !_______________________________________________________________________ + ! Exchange E_iw after vertical diffusion - needed for horizontal diffusion gradients + call exchange_nod(iwe2_E_iw, partit) + + !_______________________________________________________________________ + ! 5. add lateral diffusion term (see. Olbers D., Eden C., 2013, A Global Model + t7 = MPI_Wtime() ! for the Diapycnal Diffusivity Induced Internal Gravity Waves...) ! Eiw^(t+1) = Eiw^(t+1) + div_h( v_0 * tau_h * grad_h(v_0*E_iw^(t)) ) if (idemix2_enable_hor_diffusion .or. idemix2_enable_hor_diff_iter) then @@ -1361,7 +1411,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ - ! 9th. add tendency due to lateral diffusion with iterative method in case of + ! 6. add tendency due to lateral diffusion with iterative method in case of ! high resolution if (idemix2_enable_hor_diff_iter) then do iter=1, idemix2_hor_diff_niter @@ -1376,14 +1426,15 @@ subroutine calc_cvmix_idemix2(partit, mesh) , Eiw_hdif = iwe2_E_iw_hdif( :, :) & ! optional: diagnostic ) end do - end if - - + end if + t8 = MPI_Wtime() + time_Eiw_hdiff = t8 - t7 !_______________________________________________________________________ - ! 10th. compute wave-wave interaction + ! 7. compute wave-wave interaction + t8 = MPI_Wtime() if (idemix2_enable_M2 .or. idemix2_enable_niw) then - do node = 1, myDim_nod2D+eDim_nod2D + do node = 1, myDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) !_______________________________________________________________ @@ -1394,6 +1445,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) , dzw = hnode( uln:nln-1, node) & , dphi = iwe2_dphit & , dt = dt & + , flag_posdef = .True. & , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & @@ -1405,6 +1457,11 @@ subroutine calc_cvmix_idemix2(partit, mesh) , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & , E_niw_struct = iwe2_E_niw_struct( : , node) & , tau_niw = iwe2_niw_tau( node) & + , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic + , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & ! optional: diagnostic + , E_iw_diss_niw= iwe2_E_iw_diss_niw( : , node) & ! optional: diagnostic + , E_M2_dt = iwe2_E_M2_dt( : , node) & ! optional: diagnostic + , E_M2_diss_wwi= iwe2_E_M2_diss_wwi( : , node) & ! optional: diagnostic ) elseif (idemix2_enable_M2) then call cvmix_idemix2_compute_Eiw_waveinteract( & @@ -1413,6 +1470,7 @@ subroutine calc_cvmix_idemix2(partit, mesh) , dzw = hnode( uln:nln-1, node) & , dphi = iwe2_dphit & , dt = dt & + , flag_posdef = .True. & , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & @@ -1420,6 +1478,10 @@ subroutine calc_cvmix_idemix2(partit, mesh) , E_M2_struct = iwe2_E_M2_struct( : , node) & , alpha_M2_c = iwe2_alpha_M2_c( node) & , tau_M2 = iwe2_M2_tau( node) & + , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic + , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & ! optional: diagnostic + , E_M2_dt = iwe2_E_M2_dt( : , node) & ! optional: diagnostic + , E_M2_diss_wwi= iwe2_E_M2_diss_wwi( : , node) & ! optional: diagnostic ) elseif (idemix2_enable_niw) then call cvmix_idemix2_compute_Eiw_waveinteract( & @@ -1428,27 +1490,31 @@ subroutine calc_cvmix_idemix2(partit, mesh) , dzw = hnode( uln:nln-1, node) & , dphi = iwe2_dphit & , dt = dt & + , flag_posdef = .True. & , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & , E_niw_struct = iwe2_E_niw_struct( : , node) & , tau_niw = iwe2_niw_tau( node) & + , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic + , E_iw_diss_niw= iwe2_E_iw_diss_niw( : , node) & ! optional: diagnostic ) end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then end do ! --> for node = 1, myDim_nod2D - end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then - - + end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then + t9 = MPI_Wtime() + time_waveint = t9 - t8 !_______________________________________________________________________ - ! 11th. write IDEMIX2 diffusivities and viscositie to FESOM only when IDEMIX2 is + ! 8. write IDEMIX2 diffusivities and viscositie to FESOM only when IDEMIX2 is + t9 = MPI_Wtime() ! used alone --> mostly for debuging --> otherwise TKE Av and Kv are use if(mix_scheme_nmb==7) then !___________________________________________________________________ ! write out diffusivity --> convert from elem to vertices - do node=1, myDim_nod2D+eDim_nod2D + do node=1, myDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) !_______________________________________________________________ @@ -1461,10 +1527,12 @@ subroutine calc_cvmix_idemix2(partit, mesh) , KappaM = iwe2_Av( uln:nln, node) & ) end do - + call exchange_nod(iwe2_Av, partit) + call exchange_nod(Kv , partit) + !___________________________________________________________________ ! more idemix2 viscosity from vertices to elements - do elem=1,myDim_elem2D + do elem=1,myDim_elem2D+eDim_elem2D uln = ulevels(elem) nln = nlevels(elem) elnodes = elem2d_nodes(:,elem) @@ -1472,9 +1540,32 @@ subroutine calc_cvmix_idemix2(partit, mesh) Av(nz, elem) = sum(iwe2_Av(nz, elnodes))/3.0_WP end do end do - call exchange_elem(Av, partit) - call exchange_nod(Kv , partit) - end if + + end if + t10 = MPI_Wtime() + time_Kv_Av = t10 - t9 + + !_______________________________________________________________________ + ! Timing report + t_end = MPI_Wtime() + time_total = t_end - t_start + + if (mype==0 .and. mod(istep, logfile_outfreq)==0) then + write(*,*) + write(*,'(A)') ' ___IDEMIX2 EXECUTION TIMES_____________________________' + write(*,'(A, ES10.3, A, F6.2, A)') ' Params (cn,tau,struct) : ', time_params, ' s (', 100.0*time_params/time_total, '%)' + write(*,'(A, ES10.3, A, F6.2, A)') ' Group velocities (u,v,w) : ', time_groupvel, ' s (', 100.0*time_groupvel/time_total, '%)' + write(*,'(A, ES10.3, A, F6.2, A)') ' M2 spectral integration : ', time_M2_integ, ' s (', 100.0*time_M2_integ/time_total, '%)' + write(*,'(A, ES10.3, A, F6.2, A)') ' NIW spectral integration : ', time_niw_integ, ' s (', 100.0*time_niw_integ/time_total, '%)' + write(*,'(A, ES10.3, A, F6.2, A)') ' Eiw vertical diffusion : ', time_Eiw_vdiff, ' s (', 100.0*time_Eiw_vdiff/time_total, '%)' + write(*,'(A, ES10.3, A, F6.2, A)') ' Eiw horizontal diffusion : ', time_Eiw_hdiff, ' s (', 100.0*time_Eiw_hdiff/time_total, '%)' + write(*,'(A, ES10.3, A, F6.2, A)') ' Wave-wave interaction : ', time_waveint, ' s (', 100.0*time_waveint/time_total, '%)' + write(*,'(A, ES10.3, A, F6.2, A)') ' Kv/Av output : ', time_Kv_Av, ' s (', 100.0*time_Kv_Av/time_total, '%)' + write(*,'(A)') ' _______________________________________' + write(*,'(A, ES10.3,A)') ' IDEMIX2 TOTAL time : ', time_total, ' s' + write(*,*) + write(*,*) + end if end subroutine calc_cvmix_idemix2 @@ -2384,30 +2475,30 @@ subroutine compute_vol_nodB2T_fix(vol_nodB2T, mesh, partit) vol_nodB2T(node) = vol_nodB2T(node) + areasvol(nz,node)*abs(zbar(nz)-zbar(nz+1)) end do end do !-->do node = 1,node_size - call MPI_Allreduce(lcl_sumvol, glb_sumvol, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) - if (partit%mype == 0) then - write(*,*) ' debug: vol_node_fix: ', glb_sumvol - end if + ! call MPI_Allreduce(lcl_sumvol, glb_sumvol, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + ! if (partit%mype == 0) then + ! write(*,*) ' debug: vol_node_fix: ', glb_sumvol + ! end if call exchange_nod(vol_nodB2T, partit) - lcl_sumvol = 0.0_WP - do elem = 1, myDim_elem2D - ! Nodes are uniquely partitioned (e.g., via METIS) — each node belongs - ! to exactly one rank Elements are then distributed so that each rank - ! has all elements touching its owned nodes — but boundary elements - ! necessarily appear on multiple ranks (they share vertices across partitions) - elnodes=mesh%elem2D_nodes(:,elem) - if (elnodes(1) > myDim_nod2D) cycle - nln = nlevels(elem)-1 - uln = ulevels(elem) - do nz=uln,nln - lcl_sumvol = lcl_sumvol + elem_area(elem)*abs(zbar(nz)-zbar(nz+1)) - end do - end do !-->do node = 1,node_size - call MPI_Allreduce(lcl_sumvol, glb_sumvol, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) - if (partit%mype == 0) then - write(*,*) ' debug: vol_elem_fix: ', glb_sumvol - end if + ! lcl_sumvol = 0.0_WP + ! do elem = 1, myDim_elem2D + ! ! Nodes are uniquely partitioned (e.g., via METIS) — each node belongs + ! ! to exactly one rank Elements are then distributed so that each rank + ! ! has all elements touching its owned nodes — but boundary elements + ! ! necessarily appear on multiple ranks (they share vertices across partitions) + ! elnodes=mesh%elem2D_nodes(:,elem) + ! if (elnodes(1) > myDim_nod2D) cycle + ! nln = nlevels(elem)-1 + ! uln = ulevels(elem) + ! do nz=uln,nln + ! lcl_sumvol = lcl_sumvol + elem_area(elem)*abs(zbar(nz)-zbar(nz+1)) + ! end do + ! end do !-->do node = 1,node_size + ! call MPI_Allreduce(lcl_sumvol, glb_sumvol, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + ! if (partit%mype == 0) then + ! write(*,*) ' debug: vol_elem_fix: ', glb_sumvol + ! end if end subroutine compute_vol_nodB2T_fix @@ -2733,15 +2824,25 @@ subroutine compute_hdiff_Eiw( & end do !-->do edge=1,myDim_edge2D !_______________________________________________________________________ - ! add to total change in Eiw - do node = 1, myDim_nod2D - nu1 = ulevels_nod2D(node) - nl1 = nlevels_nod2D(node) - do nz = nu1, nl1 - Eiw_hdif(nz, node) = Eiw_hdif(nz, node) + (Eiw(nz, node)-Eiw_old(nz, node))/dt - Eiw_dt(nz, node) = Eiw_dt(nz, node) + (Eiw(nz, node)-Eiw_old(nz, node))/dt - end do - end do + ! add to total change in Eiw --> optional diagnsotic + if (present(Eiw_dt) .or. present(Eiw_hdif)) then + do node = 1, myDim_nod2D + nu1 = ulevels_nod2D(node) + nl1 = nlevels_nod2D(node) + + if (present(Eiw_dt)) then + do nz = nu1, nl1 + Eiw_dt(nz, node) = Eiw_dt(nz, node) + (Eiw(nz, node)-Eiw_old(nz, node))/dt + end do + end if + + if (present(Eiw_hdif)) then + do nz = nu1, nl1 + Eiw_hdif(nz, node) = (Eiw(nz, node)-Eiw_old(nz, node)) + end do + end if + end do + end if end subroutine compute_hdiff_Eiw @@ -2921,7 +3022,7 @@ subroutine check_global_energy(Ecompart, ti, dphit, vol_s, forc, tauE, partit, m ', global max(E_',trim(compartment_name),') = ', glb_maxE write(*,*) ' debug: global Σ(forc_',trim(compartment_name),'*dphi*vols) = ', glb_forc, ' W', & ', global Σ(tau*E_',trim(compartment_name),'*dphi*vols) = ', glb_diss, ' W', & - ', global forc/diss = ', glb_forc/glb_diss, ' W' + ', global forc_',trim(compartment_name),'/diss_',trim(compartment_name),' = ', glb_forc/glb_diss, ' W' end if end subroutine check_global_energy diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index f7aa87591..0d57d3767 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1318,24 +1318,22 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) CASE ('IDEMIX2 ') if (mod(mix_scheme_nmb,10)==7) then call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw' , 'internal wave energy ' , 'm^2/s^2', iwe2_E_iw(iwe2_taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_dt' , 'Eiw total production ' , 'm^2/s^3', iwe2_E_iw_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_diss', 'Eiw production from dissipation', 'm^2/s^3', iwe2_E_iw_diss( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_hdif', 'Eiw production from hor. diff.' , 'm^2/s^3', iwe2_E_iw_hdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_vdif', 'Eiw production from ver. diff.' , 'm^2/s^3', iwe2_E_iw_vdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream( nod2d , myDim_nod2D , 'iwe2_Eiw_fsrf', 'Eiw production from srf. forc.' , 'm^2/s^3', iwe2_E_iw_fsrf( :) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_fbot', 'Eiw production from bot. forc.' , 'm^2/s^3', iwe2_E_iw_fbot( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_c0' , 'Eiw vertical group velocity' , 'm/s' , iwe2_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_v0' , 'Eiw horizontal group velocity' , 'm/s' , iwe2_v0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_alpha_c' , 'Eiw dissipation coefficien' , 'none' , iwe2_alpha_c(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( elem2D , myDim_elem2D , 'iwe2_fbot' , 'bottom forcing' , 'm^3/s^3', iwe2_fbot_e(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_fsrf' , 'surface forcing' , 'm^3/s^3', iwe2_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_cn' , 'baroclinic velocity' , 'm/s' , iwe2_cn(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - ! call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_e' , 'baroclinic velocity elem' , 'm/s' , iwe2_cn_e(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - ! call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_gradx', 'gradx baroclinic velocity' , '1/s' , iwe2_cn_gradx(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - ! call def_stream( elem2D , myDim_elem2D , 'iwe2_cn_grady', 'grady baroclinic velocity' , '1/s' , iwe2_cn_grady(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - + ! optional diagnostic + if (allocated(iwe2_E_iw_dt )) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_dt' , 'Eiw total production ' , 'm^2/s^3', iwe2_E_iw_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_hdif)) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_hdif', 'Eiw production from hor. diff.' , 'm^2/s^3', iwe2_E_iw_hdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_vdif)) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_vdif', 'Eiw production from ver. diff.' , 'm^2/s^3', iwe2_E_iw_vdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_fsrf)) call def_stream( nod2d , myDim_nod2D , 'iwe2_Eiw_fsrf', 'Eiw production from srf. forc.' , 'm^2/s^3', iwe2_E_iw_fsrf( :) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_fbot)) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_fbot', 'Eiw production from bot. forc.' , 'm^2/s^3', iwe2_E_iw_fbot( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (idemix2_enable_M2) then + call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_alphac' , 'M2 energy dissipation' , 'none' , iwe2_alpha_M2_c(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_tau' , 'M2 dissipation timescale' , 's' , iwe2_M2_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_forc' , 'M2 forcing' , 'm^3/s^3/rad', iwe2_fM2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1346,13 +1344,13 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divh' , 'EM2 horiz wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divh(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divs' , 'EM2 crss spctr wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divs(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Em2_strct' , 'EM2 structure function energy' , 'm^2/s^2' , iwe2_E_M2_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_dt' , 'EM2 total tendency' , 'm^2/s^3' , iwe2_E_M2_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advh' , 'EM2 horizontal advection' , 'm^2/s^3' , iwe2_E_M2_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advs' , 'EM2 spectral advection' , 'm^2/s^3' , iwe2_E_M2_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_diss' , 'EM2 dissipation' , 'm^2/s^3' , iwe2_E_M2_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_forc' , 'EM2 forcing tendency' , 'm^2/s^3' , iwe2_E_M2_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - ! call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_div_uv' , ' divergence of M2 group vel.' , '1/s' , iwe2_M2_div_uv(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - + ! optional diagnostic + if (allocated(iwe2_E_M2_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_dt' , 'EM2 total tendency' , 'm^2/s^3' , iwe2_E_M2_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advh' , 'EM2 horizontal advection' , 'm^2/s^3' , iwe2_E_M2_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advs' , 'EM2 spectral advection' , 'm^2/s^3' , iwe2_E_M2_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_diss )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_diss' , 'EM2 dissipation' , 'm^2/s^3' , iwe2_E_M2_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_forc )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_forc' , 'EM2 forcing tendency' , 'm^2/s^3' , iwe2_E_M2_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_diss_M2)) call def_stream((/nl ,nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eiw_dissM2' , 'Eiw dissipation through M2 WWI' , 'm^2/s^3' , iwe2_E_iw_diss_M2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) end if if (idemix2_enable_niw) then @@ -1366,13 +1364,13 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divh' , 'Eniw horz wave energy diverg.' , 'm^2/s^2' , iwe2_E_niw_divh(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divs' , 'Eniw crss spctr wave energy diverg.', 'm^2/s^2' , iwe2_E_niw_divs(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eniw_strct' , 'Eniw structure function energy' , 'm^2/s^2' , iwe2_E_niw_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_dt' , 'Eniw total tendency' , 'm^2/s^3' , iwe2_E_niw_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advh' , 'Eniw horizontal advection' , 'm^2/s^3' , iwe2_E_niw_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advs' , 'Eniw spectral advection' , 'm^2/s^3' , iwe2_E_niw_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_diss' , 'Eniw dissipation' , 'm^2/s^3' , iwe2_E_niw_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_forc' , 'Eniw forcing tendency' , 'm^2/s^3' , iwe2_E_niw_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - ! call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_div_uv' , 'divergence of niw group vel.' , '1/s' , iwe2_niw_div_uv(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - + ! optional diagnostic + if (allocated(iwe2_E_niw_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_dt' , 'Eniw total tendency' , 'm^2/s^3' , iwe2_E_niw_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advh' , 'Eniw horizontal advection' , 'm^2/s^3' , iwe2_E_niw_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advs' , 'Eniw spectral advection' , 'm^2/s^3' , iwe2_E_niw_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_diss )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_diss' , 'Eniw dissipation' , 'm^2/s^3' , iwe2_E_niw_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_forc )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_forc' , 'Eniw forcing tendency' , 'm^2/s^3' , iwe2_E_niw_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_diss_niw)) call def_stream((/nl ,nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eiw_dissniw', 'Eiw dissipation through niw WWI' , 'm^2/s^3' , iwe2_E_iw_diss_niw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) end if if (idemix2_enable_M2 .or. idemix2_enable_niw) then From 83e868b603babf8214b876b2aeaebe80d80f7bae Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 27 May 2026 14:26:45 +0200 Subject: [PATCH 29/63] add percentage column to wcl log file information --- src/ice_setup_step.F90 | 14 +++++++------- src/oce_ale.F90 | 28 ++++++++++++++-------------- 2 files changed, 21 insertions(+), 21 deletions(-) diff --git a/src/ice_setup_step.F90 b/src/ice_setup_step.F90 index fd6684d17..6821125fb 100755 --- a/src/ice_setup_step.F90 +++ b/src/ice_setup_step.F90 @@ -338,16 +338,16 @@ subroutine ice_timestep(step, ice, partit, mesh) if(mod(step,logfile_outfreq)==0 .and. mype==0) then write(*,*) '___ICE STEP EXECUTION TIMES____________________________' #if defined (__icepack) - write(*,"(A, ES10.3)") ' Ice Dyn. :', time_evp - write(*,"(A, ES10.3)") ' Ice Advect. :', time_advec - write(*,"(A, ES10.3)") ' Ice Thermodyn. :', time_therm + write(*,"(A, ES10.3, A, F6.2, A)") ' Ice Dyn. :', time_evp, ' (', 100.0*time_evp/(t3-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' Ice Advect. :', time_advec,' (', 100.0*time_advec/(t3-t0),'%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' Ice Thermodyn. :', time_therm,' (', 100.0*time_therm/(t3-t0),'%)' #else - write(*,"(A, ES10.3)") ' Ice Dyn. :', t1-t0 - write(*,"(A, ES10.3)") ' Ice Advect. :', t2-t1 - write(*,"(A, ES10.3)") ' Ice Thermodyn. :', t3-t2 + write(*,"(A, ES10.3, A, F6.2, A)") ' Ice Dyn. :', t1-t0, ' (', 100.0*(t1-t0)/(t3-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' Ice Advect. :', t2-t1, ' (', 100.0*(t2-t1)/(t3-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' Ice Thermodyn. :', t3-t2, ' (', 100.0*(t3-t2)/(t3-t0), '%)' #endif /* (__icepack) */ write(*,*) ' _______________________________' - write(*,"(A, ES10.3)") ' Ice TOTAL :', t3-t0 + write(*,"(A, ES10.3)") ' Ice TOTAL :', t3-t0 write(*,*) endif end subroutine ice_timestep diff --git a/src/oce_ale.F90 b/src/oce_ale.F90 index 1e6614a6a..aff103f39 100644 --- a/src/oce_ale.F90 +++ b/src/oce_ale.F90 @@ -3443,8 +3443,7 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) call calc_cvmix_idemix(partit, mesh) elseif (mod(mix_scheme_nmb,10)==7) then if (flag_debug .and. mype==0) print *, achar(27)//'[36m'//' --> call calc_cvmix_idemix2'//achar(27)//'[0m' - ! if (flag_debug .and. mype==0) print *, achar(27)//'[31m'//' --> call calc_cvmix_idemix2'//achar(27)//'[0m' - call calc_cvmix_idemix2(partit, mesh) + call calc_cvmix_idemix2(n, partit, mesh) end if #endif @@ -3859,22 +3858,23 @@ subroutine oce_timestep_ale(n, ice, dynamics, tracers, partit, mesh) rtime_oce_solvetra = rtime_oce_solvetra + (t9-t8) rtime_tot = rtime_tot + (t11-t0)-(t11-t10) if(mod(n,logfile_outfreq)==0 .and. mype==0) then + write(*,*) write(*,*) '___ALE OCEAN STEP EXECUTION TIMES______________________' - write(*,"(A, ES10.3)") ' Oce. Press, Dens.:', t1-t0 - write(*,"(A, ES10.3)") ' Oce. Mixing :', t2-t1 - write(*,"(A, ES10.3)") ' Oce. Dynamics :', t3-t2 - write(*,"(A, ES10.3)") ' Oce. Update Vel. :', t5-t4 - write(*,"(A, ES10.3)") ' Oce. Fer-GM. :', t7-t6 + write(*,"(A, ES10.3, A, F6.2, A)") ' Oce. Press, Dens.:', t1-t0, ' (', 100.0*(t1-t0)/(t11-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' Oce. Mixing :', t2-t1, ' (', 100.0*(t2-t1)/(t11-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' Oce. Dynamics :', t3-t2, ' (', 100.0*(t3-t2)/(t11-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' Oce. Update Vel. :', t5-t4, ' (', 100.0*(t5-t4)/(t11-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' Oce. Fer-GM. :', t7-t6, ' (', 100.0*(t7-t6)/(t11-t0), '%)' write(*,*) ' _______________________________' - write(*,"(A, ES10.3)") ' ALE-Solve SSH :', t4-t3 - write(*,"(A, ES10.3)") ' ALE-Calc. hbar :', t6-t5 - write(*,"(A, ES10.3)") ' ALE-Update+W :', t8-t7 - write(*,"(A, ES10.3)") ' ALE-Solve Tracer :', t9-t8 - write(*,"(A, ES10.3)") ' ALE-Update hnode :', t10-t9 + write(*,"(A, ES10.3, A, F6.2, A)") ' ALE-Solve SSH :', t4-t3, ' (', 100.0*(t4-t3)/(t11-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' ALE-Calc. hbar :', t6-t5, ' (', 100.0*(t6-t5)/(t11-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' ALE-Update+W :', t8-t7, ' (', 100.0*(t8-t7)/(t11-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' ALE-Solve Tracer :', t9-t8, ' (', 100.0*(t9-t8)/(t11-t0), '%)' + write(*,"(A, ES10.3, A, F6.2, A)") ' ALE-Update hnode :', t10-t9, ' (', 100.0*(t10-t9)/(t11-t0), '%)' write(*,*) ' _______________________________' - write(*,"(A, ES10.3)") ' check for blowup :', t11-t10 + write(*,"(A, ES10.3, A, F6.2, A)") ' check for blowup :', t11-t10, ' (', 100.0*(t11-t10)/(t11-t0), '%)' write(*,*) ' _______________________________' - write(*,"(A, ES10.3)") ' Oce. TOTAL :', t11-t0 + write(*,"(A, ES10.3)") ' Oce. TOTAL :', t11-t0 write(*,*) write(*,*) end if From b065b6cad958037c3463b47c706b024024f8a49c Mon Sep 17 00:00:00 2001 From: Patrick Scholz Date: Tue, 2 Jun 2026 15:25:49 +0200 Subject: [PATCH 30/63] fix non-energy-conserving reflective coastal BC causing NIW runaway MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The reflective BC in apply_reflect_bc_spctrl was only adding the reflected flux to the mirror bin kk at the interior node, without subtracting the same amount from the source bin fbini. This created free energy on every reflection: energy that would have left in fbini stayed (flux zeroed) AND new energy was added to kk (reflect_src injection), giving +2*outflux/vol net gain per coast edge per timestep. For normal coast nodes this was masked by subsequent advection, but for fully isolated ocean nodes (all edges coast-directed) there was no escape path and energy accumulated without bound after ~60 model days. Fix: add an equal and opposite sink term alongside the existing source: reflect_src(kk, n_int) += sgn * outflux ! gain in mirror bin reflect_src(fbini, n_int) -= sgn * outflux ! loss in source bin Net change at n_int per reflection is now zero — energy is redistributed fbini->kk only. The Edivh injection loop is unchanged; it picks up both signs naturally. Additionally: - Add iwe2_is_reflect_node mask (built once in init_reflect_bc) so the Edivh injection loop skips non-coast-adjacent nodes via cycle - Add separate iwe2_M2_reflect_src / iwe2_niw_reflect_src diagnostic arrays (allocated and registered for I/O only when idemix2_diag_Ecompart is enabled) to capture per-compartment reflect_src for output --- .../gen_modules_cvmix_idemix2.F90 | 1039 ++++++++++++----- src/io_meandata.F90 | 64 +- 2 files changed, 818 insertions(+), 285 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 4c0756a18..72a2078d5 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -134,6 +134,12 @@ module g_cvmix_idemix2 ! total global Energy input that should be conserved if 0.0 no conservation is applied real(kind=WP) :: idemix2_botforc_Etot = 0.0_WP ! units W + !___________________________________________________________________________ + ! switch on extended diagnostic + logical :: idemix2_diag_Ecompart = .false. + logical :: idemix2_diag_Eiw = .false. + logical :: idemix2_diag_WWI = .false. + ! !___________________________________________________________________________ ! ! enable lee wave source of internal wave energy in IDEMIX2, ! ! Lee Wave Generation: Generated when mean flow encounters topography Energy @@ -167,7 +173,8 @@ module g_cvmix_idemix2 ! idemix2_enable_leew, idemix2_leewforc_file, idemix2_leewforc_vname, & idemix2_enable_bot , idemix2_botforc_file , idemix2_botforc_vname , & idemix2_hrmsforc_file, idemix2_hrmsforc_vname, & - idemix2_hlamforc_file, idemix2_hlamforc_vname + idemix2_hlamforc_file, idemix2_hlamforc_vname, & + idemix2_diag_Ecompart, idemix2_diag_Eiw, idemix2_diag_WWI !___________________________________________________________________________ ! CVMIX-IDEMIX variables @@ -229,7 +236,25 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,:,:):: iwe2_gradxy_e, iwe2_gradxy_n real(kind=WP), allocatable, dimension(:,: ):: iwe2_flx_uv, iwe2_flx_w integer :: iwe2_taum1=1, iwe2_tau=2, iwe2_taup1=3, otaum1 - + + ! reflective coastal BC: for each edge touching exactly one coast node, + ! iwe2_bc_reflect_bin stores the mirror spectral bin (0 = edge not flagged), + ! iwe2_bc_reflect_sgn = +1 if ednodes(1) is the coast node, -1 if ednodes(2) is. + integer , allocatable, dimension(:) :: iwe2_bc_reflect_bin + integer , allocatable, dimension(:) :: iwe2_bc_reflect_sgn + ! per-timestep scratch: blocked coast flux accumulated per (mirror bin, interior node), + ! filled by apply_reflect_bc_spctrl, applied to Edivh in hsintegrate_Ecompart + real(kind=WP), allocatable, dimension(:,:) :: iwe2_reflect_src + ! persistent per-compartment copies of iwe2_reflect_src for I/O output + real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_reflect_src + real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_reflect_src + ! mask: .true. for own nodes that are interior to at least one coast edge + logical, allocatable, dimension(:) :: iwe2_is_reflect_node + ! compact list of own-node indices that have at least one coast edge; + ! used to restrict the Edivh reflect_src injection to coast-adjacent nodes only + integer, allocatable, dimension(:) :: iwe2_reflect_nodes + integer :: iwe2_n_reflect_nodes + ! real(kind=WP), allocatable, dimension(:) :: iwe2_cn_e, iwe2_cn_gradx, iwe2_cn_grady ! load variables from CVMix list @@ -252,7 +277,7 @@ subroutine init_cvmix_idemix2(partit, mesh) character(len=cvmix_strlen) :: nmlfile logical :: file_exist=.False. - integer :: node_size, elem_size, elem, node, nfbin, & + integer :: node_size, elem_size, elem, node, nfbin, & fbin_i, elnodes(3), nzmax real(kind=WP) :: loc_Etot=0.0_WP, glb_Etot=0.0_WP real(kind=WP) :: t0, t1 @@ -342,13 +367,6 @@ subroutine init_cvmix_idemix2(partit, mesh) allocate(iwe2_cn(node_size)) iwe2_cn(:) = 0.0_WP -! allocate(iwe2_cn_e(elem_size)) -! allocate(iwe2_cn_gradx(elem_size)) -! allocate(iwe2_cn_grady(elem_size)) -! iwe2_cn_e(:) = 0.0_WP -! iwe2_cn_gradx(:) = 0.0_WP -! iwe2_cn_grady(:) = 0.0_WP - ! Eiw 3d enery dissipation coefficient allocate(iwe2_alpha_c(nl,node_size)) iwe2_alpha_c(:,:) = 0.0_WP @@ -356,52 +374,54 @@ subroutine init_cvmix_idemix2(partit, mesh) ! initialise Eiw - internal wave energy variables ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) allocate(iwe2_E_iw( 3, nl, node_size)) - allocate( iwe2_E_iw_diss(nl, node_size) & - , iwe2_E_iw_dt( nl, node_size) & - , iwe2_E_iw_fbot(nl, node_size) & - ) - allocate(iwe2_E_iw_vdif(nl, node_size), iwe2_E_iw_hdif(nl, node_size)) - allocate(iwe2_E_iw_fsrf(node_size)) iwe2_E_iw( :,:,:)= 0.0_WP - ! Eiw production terms: - iwe2_E_iw_dt( :,:)= 0.0_WP ! total Eiw production + allocate(iwe2_E_iw_diss(nl, node_size)) iwe2_E_iw_diss( :,:)= 0.0_WP ! Eiw production from disspation - iwe2_E_iw_fbot( :,:)= 0.0_WP ! Eiw production from bottom forcing - iwe2_E_iw_hdif( :,:)= 0.0_WP ! Eiw production from horizontal diffusion - iwe2_E_iw_vdif( :,:)= 0.0_WP ! Eiw production from vertical diffusion - iwe2_E_iw_fsrf( :)= 0.0_WP ! Eiw production from surface forcing - ! initialise M2 variables - if (idemix2_enable_M2) then - ! dissipation of E_iw through E_M2 - allocate( iwe2_E_iw_diss_M2(nl, node_size)) - iwe2_E_iw_diss_M2(:,:)= 0.0_WP + ! Diagnostics + if (idemix2_diag_Eiw) then + allocate( iwe2_E_iw_fbot(nl, node_size) & + , iwe2_E_iw_vdif(nl, node_size) & + , iwe2_E_iw_hdif(nl, node_size) & + , iwe2_E_iw_fsrf( node_size) & + ) + iwe2_E_iw_fbot( :,:)= 0.0_WP + iwe2_E_iw_hdif( :,:)= 0.0_WP + iwe2_E_iw_vdif( :,:)= 0.0_WP + iwe2_E_iw_fsrf( :)= 0.0_WP + end if + if (idemix2_diag_Eiw .or. idemix2_diag_WWI) then + allocate( iwe2_E_iw_dt( nl, node_size)) + iwe2_E_iw_dt( :,:)= 0.0_WP + end if + ! initialise M2 variables + if (idemix2_enable_M2) then ! M2 energy dissipation allocate(iwe2_alpha_M2_c(node_size)) iwe2_alpha_M2_c(:) = 0.0_WP - - ! M2 dissipation timescale + + ! M2 dissipation timescale allocate(iwe2_M2_tau(node_size)) iwe2_M2_tau(:) = 0.0_WP - - ! M2 cross spectral propagation at elements + + ! M2 cross spectral propagation at elements allocate(w_M2_e(nfbin)) w_M2_e(:) = 0.0_WP - + ! M2 zonal/merid group velocity, and cross spectral propagation ! at vertices allocate(iwe2_M2_uv(2, nfbin,elem_size)) allocate(iwe2_M2_w( nfbin,node_size)) iwe2_M2_uv(:,:,:) = 0.0_WP iwe2_M2_w(:,:) = 0.0_WP - + ! M2 forcing allocate(iwe2_fM2(nfbin, node_size)) iwe2_fM2(:,:) = 0.0_WP - - ! M2 wave energy, and divergence of M2 wave energy + + ! M2 wave energy, and divergence of M2 wave energy ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) allocate( iwe2_E_M2( 3, nfbin, node_size) & , iwe2_E_M2_divh(3, nfbin, node_size) & @@ -410,58 +430,65 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_M2( :,:,:)= 0.0_WP iwe2_E_M2_divh( :,:,:)= 0.0_WP iwe2_E_M2_divs( :,:,:)= 0.0_WP - - ! structure function for M2 energy + + ! structure function for M2 energy allocate(iwe2_E_M2_struct(nl, node_size)) iwe2_E_M2_struct(:,:) = 0.0_WP + + ! Diagnostics + if (idemix2_diag_Ecompart) then + ! diagnostic for M2 spectral energy advection + allocate( iwe2_E_M2_advh(nfbin, myDim_nod2D) & + , iwe2_E_M2_advs(nfbin, myDim_nod2D) & + , iwe2_E_M2_diss(nfbin, myDim_nod2D) & + , iwe2_E_M2_forc(nfbin, myDim_nod2D) ) + iwe2_E_M2_advh(:,:) = 0.0_WP + iwe2_E_M2_advs(:,:) = 0.0_WP + iwe2_E_M2_diss(:,:) = 0.0_WP + iwe2_E_M2_forc(:,:) = 0.0_WP + end if - ! diagnostic for M2 spectral energy advection - allocate( iwe2_E_M2_dt( nfbin, myDim_nod2D) & ! total change in E_M2 - , iwe2_E_M2_advh( nfbin, myDim_nod2D) & - , iwe2_E_M2_advs( nfbin, myDim_nod2D) & - , iwe2_E_M2_diss( nfbin, myDim_nod2D) & - , iwe2_E_M2_diss_wwi(nfbin, myDim_nod2D) & - , iwe2_E_M2_forc( nfbin, myDim_nod2D) & - ) - iwe2_E_M2_dt( :,:) = 0.0_WP - iwe2_E_M2_advh( :,:) = 0.0_WP - iwe2_E_M2_advs( :,:) = 0.0_WP - iwe2_E_M2_diss( :,:) = 0.0_WP - iwe2_E_M2_diss_wwi(:,:) = 0.0_WP - iwe2_E_M2_forc( :,:) = 0.0_WP - - end if - - ! initialise niw variables - if (idemix2_enable_niw) then - ! dissipation of E_iw through E_M2 - allocate( iwe2_E_iw_diss_niw(nl, node_size)) - iwe2_E_iw_diss_niw(:,:)= 0.0_WP + if (idemix2_diag_Ecompart .or. idemix2_diag_WWI) then + ! diagnostic for M2 spectral energy advection + allocate( iwe2_E_M2_dt( nfbin, myDim_nod2D) ) + iwe2_E_M2_dt( :,:) = 0.0_WP + end if + if (idemix2_diag_WWI) then + ! diagnostic for M2 wave-wave interaction + allocate( iwe2_E_iw_diss_M2( nl , node_size ) & + , iwe2_E_M2_diss_wwi(nfbin, myDim_nod2D) ) + iwe2_E_iw_diss_M2( :,:) = 0.0_WP + iwe2_E_M2_diss_wwi(:,:) = 0.0_WP + end if + end if + + ! initialise niw variables + if (idemix2_enable_niw) then ! niw frequency allocate(iwe2_omega_niw(node_size)) iwe2_omega_niw(:) = 0.0_WP - - ! niw dissipation timescale + + ! niw dissipation timescale allocate(iwe2_niw_tau(node_size)) iwe2_niw_tau(:) = 0.0_WP - - ! niw cross spectral propagation at elements + + ! niw cross spectral propagation at elements allocate(w_niw_e(nfbin)) w_niw_e(:) = 0.0_WP - + ! niw zonal/merid group velocity, and cross spectral propagation ! at vertices allocate(iwe2_niw_uv(2, nfbin,elem_size)) allocate(iwe2_niw_w( nfbin,node_size)) iwe2_niw_uv(:,:,:) = 0.0_WP iwe2_niw_w(:,:) = 0.0_WP - + ! niw forcing allocate(iwe2_fniw(nfbin, node_size)) iwe2_fniw(:,:) = 0.0_WP - - ! niw wave energy, and divergence of niw wave energy + + ! niw wave energy, and divergence of niw wave energy ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) allocate( iwe2_E_niw( 3, nfbin, node_size) & , iwe2_E_niw_divh(3, nfbin, node_size) & @@ -470,24 +497,36 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_niw( :,:,:)= 0.0_WP iwe2_E_niw_divh( :,:,:)= 0.0_WP iwe2_E_niw_divs( :,:,:)= 0.0_WP - - ! structure function for niw energy + + ! structure function for niw energy allocate(iwe2_E_niw_struct(nl, node_size)) iwe2_E_niw_struct(:,:) = 0.0_WP - - ! diagnostic for niw spectral energy advection - allocate( iwe2_E_niw_dt( nfbin, myDim_nod2D) & - , iwe2_E_niw_advh( nfbin, myDim_nod2D) & - , iwe2_E_niw_advs( nfbin, myDim_nod2D) & - , iwe2_E_niw_diss( nfbin, myDim_nod2D) & - , iwe2_E_niw_forc( nfbin, myDim_nod2D) & - ) - iwe2_E_niw_dt( :,:) = 0.0_WP - iwe2_E_niw_advh( :,:) = 0.0_WP - iwe2_E_niw_advs( :,:) = 0.0_WP - iwe2_E_niw_diss( :,:) = 0.0_WP - iwe2_E_niw_forc( :,:) = 0.0_WP + + ! Diagnostics + if (idemix2_diag_Ecompart) then + ! diagnostic for niw spectral energy advection + allocate( iwe2_E_niw_advh(nfbin, myDim_nod2D) & + , iwe2_E_niw_advs(nfbin, myDim_nod2D) & + , iwe2_E_niw_diss(nfbin, myDim_nod2D) & + , iwe2_E_niw_forc(nfbin, myDim_nod2D) ) + iwe2_E_niw_dt( :,:) = 0.0_WP + iwe2_E_niw_advh(:,:) = 0.0_WP + iwe2_E_niw_advs(:,:) = 0.0_WP + iwe2_E_niw_diss(:,:) = 0.0_WP + iwe2_E_niw_forc(:,:) = 0.0_WP + end if + + if (idemix2_diag_Ecompart .or. idemix2_diag_WWI) then + ! diagnostic for niw spectral energy advection + allocate( iwe2_E_niw_dt( nfbin, myDim_nod2D)) + iwe2_E_niw_dt( :,:) = 0.0_WP + end if + if (idemix2_diag_WWI) then + ! diagnostic for niw wave-wave interaction + allocate( iwe2_E_iw_diss_niw(nl, node_size) ) + iwe2_E_iw_diss_niw(:,:) = 0.0_WP + end if end if ! allocate 1d Spectral space coordinates @@ -502,13 +541,15 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_dphiu(:) = 0.0_WP ! internal wave related vertical viscosity and diffusivity - allocate(iwe2_Av(nl,elem_size)) - iwe2_Av(:,:) = 0.0_WP - + if(mix_scheme_nmb==7) then + allocate(iwe2_Av(nl,elem_size)) + iwe2_Av(:,:) = 0.0_WP + endif + ! forcing fields, M2 tidal forcing (spectral) and NIW forcing (spectral) allocate( iwe2_fbot_e( myDim_elem2D) & , iwe2_fbot(nl, node_size) & - , iwe2_fsrf( node_size) & + , iwe2_fsrf( node_size) & ! , iwe2_fleew( myDim_elem2D) & ) iwe2_fbot_e(:) = 0.0_WP @@ -562,7 +603,11 @@ subroutine init_cvmix_idemix2(partit, mesh) end do !_______________________________________________________________________ - ! read idemix M2 forcing from cfsr data --> file + ! pre-compute reflective coastal BC lookup tables + call init_reflect_bc(partit, mesh) + + !_______________________________________________________________________ + ! read idemix M2 forcing from cfsr data --> file if (idemix2_enable_M2) then t0=MPI_Wtime() ! omega_M2 is fixed, as the M2 tidal forcing is independent of the local inertial frequency. @@ -654,8 +699,9 @@ subroutine init_cvmix_idemix2(partit, mesh) if (mype==0) then print *, achar(27)//'[33m' write(*,*) '____________________________________________________________________' - write(*,*) ' ERROR: IDEMIX2 NIW forcing file not found! Cant apply IDEMIX2' - write(*,*) ' vertical mixing parameterisation! ' + write(*,*) ' ERROR: IDEMIX2 NIW/Srf. forcing file not found! ' + write(*,*) ' Required for srf. energy input even when idemix2_enable_niw=.false.!' + write(*,*) ' Cant apply IDEMIX2 vertical mixing parameterisation! ' write(*,*) ' ├> file: ', trim(idemix2_niwforc_file) write(*,*) ' └> check: namelist.cvmix, idemix2_niwforc_file & ' write(*,*) '____________________________________________________________________' @@ -902,15 +948,187 @@ subroutine init_cvmix_idemix2(partit, mesh) if (partit%mype==0) write(*,*) end subroutine init_cvmix_idemix2 - - - + + + + ! + ! + ! + !=========================================================================== + ! pre-compute reflective coastal BC lookup tables iwe2_bc_reflect_bin and + ! iwe2_bc_reflect_sgn. Must be called after iwe2_phit is initialised. + ! + ! SETUP (pre-computed once in init_reflect_bc) + ! ───────────────────────────────────────────── + ! LAND │ n_coast ──────edge────── n_int + ! │ sgn=+1 (interior) + ! │ + ! │ iwe2_bc_reflect_bin(edge) = kk (mirror spectral bin) + ! │ iwe2_bc_reflect_sgn(edge) = +1 (coast = ednodes(1)) + subroutine init_reflect_bc(partit, mesh) + implicit none + type(t_mesh), intent(in), target :: mesh + type(t_partit), intent(in), target :: partit + + integer :: edge, n1, n2, n_int, node, kk_bc, fbinj, nfbin + real(kind=WP) :: lon1, lat1, lon2, lat2, lat_mean + real(kind=WP) :: edge_dx, edge_dy, phi_mirror, dist, dist_min + logical, allocatable :: is_coast_node(:) +#include "../associate_part_def.h" +#include "../associate_mesh_def.h" +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + nfbin = idemix2_nfbin + + allocate(iwe2_bc_reflect_bin(myDim_edge2D)) + allocate(iwe2_bc_reflect_sgn(myDim_edge2D)) + allocate(iwe2_reflect_src(idemix2_nfbin, myDim_nod2D)) + if (idemix2_diag_Ecompart) then + allocate(iwe2_M2_reflect_src (idemix2_nfbin, myDim_nod2D)) + allocate(iwe2_niw_reflect_src(idemix2_nfbin, myDim_nod2D)) + end if + allocate(is_coast_node(myDim_nod2D+eDim_nod2D)) + + ! > iwe2_bc_reflect_bin(edge) stores the MIRROR SPECTRAL BIN for a flagged + ! coast edge. 0 = edge not flagged, BC skipped. + ! + ! > HOW IT IS COMPUTED (init_reflect_bc) + ! For each edge with exactly one coast node: + ! 1. Compute direction FROM coast node BACK INTO the ocean: + ! edge_dx = (lon_interior - lon_coast) * cos(lat_mean) + ! edge_dy = lat_interior - lat_coast + ! 2. phi_mirror = atan2(edge_dy, edge_dx) mapped to [0, 2*pi) + ! 3. kk = interior bin (2..nfbin-1) with angle closest to phi_mirror + ! 4. iwe2_bc_reflect_bin(edge) = kk + ! + ! > HOW IT IS USED (apply_reflect_bc_spctrl): + ! ALL toward-coast bins at this edge (any fbini where sgn*flux > 0) + ! are blocked and their energy reflected into the SAME single bin kk: + ! reflect_src(kk, n_int) += sgn * outflux (for all toward-coast fbini) + ! One kk per edge — an approximation based on the edge-normal geometry. + iwe2_bc_reflect_bin(:) = 0 + + ! > iwe2_bc_reflect_sgn(edge) encodes WHICH of the two edge nodes is the coast + ! node, and from that, WHICH flux sign means "toward coast". Each edge has + ! two endpoint nodes: edges(1, edge) and edges(2, edge). The sign convention + ! in the FV scheme is: + ! flux(fbini, edge) > 0 = transport from edges(2) -> edges(1) + ! flux(fbini, edge) < 0 = transport from edges(1) -> edges(2) + ! sgn = +1 --> coast node = edges(1, edge) + ! interior = edges(2, edge) + ! flux toward coast when: flux > 0 + ! sgn = -1 --> coast node = edges(2, edge) + ! interior = edges(1, edge) + ! flux toward coast when: flux < 0 + ! + ! > The single condition: + ! sgn * flux(fbini, edge) > 0 + ! + ! > captures both cases -- it is true whenever the flux is directed toward + ! whichever node is the coast node, regardless of edge orientation. + ! It also determines the interior node n_int: + ! n_int = merge(edges(2, edge), edges(1, edge), sgn == +1) + ! And the reflected energy magnitude is always: + ! sgn * outflux = |outflux| > 0 + ! + ! in both orientations (positive for sgn=+1 with outflux>0, + ! positive for sgn=-1 with outflux<0). + iwe2_bc_reflect_sgn(:) = 0 + + ! > iwe2_reflect_src is a 2D scratch array (nfbin, nod2D) used to implement + ! reflective boundary conditions at coastlines for horizontal NIW energy advection. + ! 1. During apply_reflect_bc_spctrl: + ! For every coast-adjacent edge flagged in iwe2_bc_reflect_bin, any flux + ! directed toward the coast node is zeroed out and the blocked energy is + ! accumulated into iwe2_reflect_src(kk, n_int) at the interior node (n_int), + ! with the sign corrected so energy is conserved. + ! 2. After advection in hsintegrate_Ecompart: + ! The accumulated blocked flux is re-injected as a divergence source + ! Edivh += iwe2_reflect_src / vol_s, effectively bouncing the energy back + ! into the interior in bin kk (the mirror/reflected propagation direction). + ! + ! > In short: it is a flux-blocking + re-injection buffer that prevents NIW energy + ! from leaking into land, redirecting it instead into the spectrally mirrored + ! propagation direction at the last ocean node. + iwe2_reflect_src(:,:) = 0.0_WP + if (idemix2_diag_Ecompart) then + iwe2_M2_reflect_src (:,:) = 0.0_WP + iwe2_niw_reflect_src(:,:) = 0.0_WP + end if + + ! a node is a coast node if it belongs to at least one boundary edge + is_coast_node(:) = .false. + do edge = 1, myDim_edge2D + if (edge_tri(2, edge) == 0) then + is_coast_node(edges(1, edge)) = .true. + is_coast_node(edges(2, edge)) = .true. + end if + end do + + do edge = 1, myDim_edge2D + if (edge_tri(2, edge) == 0) cycle ! skip coast-parallel boundary edges + n1 = edges(1, edge) + n2 = edges(2, edge) + ! only process edges with exactly one coast node + if (is_coast_node(n1) .eqv. is_coast_node(n2)) cycle + + ! geographic coordinates of the two nodes (lon/lat in radians) + lon1 = geo_coord_nod2D(1, n1); lat1 = geo_coord_nod2D(2, n1) + lon2 = geo_coord_nod2D(1, n2); lat2 = geo_coord_nod2D(2, n2) + lat_mean = 0.5_WP*(lat1 + lat2) + + ! edge direction FROM coast node BACK TO interior node (the reflection direction) + if (is_coast_node(n2)) then + ! coast = n2, interior = n1: reflect direction is n2 -> n1 + edge_dx = (lon1 - lon2) * cos(lat_mean) + edge_dy = lat1 - lat2 + iwe2_bc_reflect_sgn(edge) = -1 ! negative flux = transport n1->n2 = INTO coast + else + ! coast = n1, interior = n2: reflect direction is n1 -> n2 + edge_dx = (lon2 - lon1) * cos(lat_mean) + edge_dy = lat2 - lat1 + iwe2_bc_reflect_sgn(edge) = +1 ! positive flux = transport n2->n1 = INTO coast + end if + + ! mirror angle = direction away from coast, mapped to [0, 2*pi) + phi_mirror = atan2(edge_dy, edge_dx) + if (phi_mirror < 0.0_WP) phi_mirror = phi_mirror + 2.0_WP*pi + + ! find nearest interior spectral bin (skip ghost cells 1 and nfbin) + kk_bc = 2 + dist_min = (iwe2_phit(2) - phi_mirror)**2 + do fbinj = 3, nfbin-1 + dist = (iwe2_phit(fbinj) - phi_mirror)**2 + if (dist < dist_min) then + dist_min = dist + kk_bc = fbinj + end if + end do + iwe2_bc_reflect_bin(edge) = kk_bc + end do + + ! create logical array if node is a reflected boudnary node + allocate(iwe2_is_reflect_node(myDim_nod2D)) + iwe2_is_reflect_node(:) = .false. + do edge = 1, myDim_edge2D + if (iwe2_bc_reflect_bin(edge) == 0) cycle + n_int = merge(edges(2,edge), edges(1,edge), iwe2_bc_reflect_sgn(edge) == +1) + if (n_int <= myDim_nod2D) iwe2_is_reflect_node(n_int) = .true. + end do + + deallocate(is_coast_node) + + if (mype==0) write(*,*) ' ├> IDEMIX2 reflective coastal BC lookup table built' + end subroutine init_reflect_bc + + + ! ! ! !=========================================================================== ! calculate IDEMIX2 internal wave energy and its dissipation - subroutine calc_cvmix_idemix2(istep, partit, mesh) + subroutine calc_cvmix_idemix2(istep, partit, mesh) implicit none integer, intent(in) :: istep type(t_mesh), intent(in), target :: mesh @@ -1284,35 +1502,57 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! dE/dt = -div(vec_u * E) - tau*E + Forc ! E^(n+1) = E^n + dt*( -div(vec_u^n*E^n) - tau*E^n + Forc^n) t3 = MPI_Wtime() - if (idemix2_enable_M2) then - call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & - , 'M2' & - , iwe2_E_M2 & - , iwe2_E_M2_divh & - , iwe2_E_M2_divs & - , iwe2_M2_uv & - , iwe2_M2_w & - , iwe2_fM2 & - , iwe2_M2_tau & - , iwe2_dphit & - , iwe2_gradxy_e & - , iwe2_gradxy_n & - , iwe2_flx_uv & - , iwe2_flx_w & - , vol_nodB2T & - , partit & - , mesh & - , .True. & ! flag_AB2, do 2nd order adams-bashfort in time - , iwe2_E_M2_dt & ! optional: diagnostic - , iwe2_E_M2_advh & ! optional: diagnostic - , iwe2_E_M2_advs & ! optional: diagnostic - , iwe2_E_M2_diss & ! optional: diagnostic - , iwe2_E_M2_forc & ! optional: diagnostic - ) - + if (idemix2_enable_M2) then + if (idemix2_diag_Ecompart) then + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & + , 'M2' & + , iwe2_E_M2 & + , iwe2_E_M2_divh & + , iwe2_E_M2_divs & + , iwe2_M2_uv & + , iwe2_M2_w & + , iwe2_fM2 & + , iwe2_M2_tau & + , iwe2_dphit & + , iwe2_gradxy_e & + , iwe2_gradxy_n & + , iwe2_flx_uv & + , iwe2_flx_w & + , vol_nodB2T & + , partit & + , mesh & + , .True. & ! flag_AB2, do 2nd order adams-bashfort in time + , iwe2_E_M2_dt & ! optional: diagnostic + , iwe2_E_M2_advh & ! optional: diagnostic + , iwe2_E_M2_advs & ! optional: diagnostic + , iwe2_E_M2_diss & ! optional: diagnostic + , iwe2_E_M2_forc & ! optional: diagnostic + ) + else + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & + , 'M2' & + , iwe2_E_M2 & + , iwe2_E_M2_divh & + , iwe2_E_M2_divs & + , iwe2_M2_uv & + , iwe2_M2_w & + , iwe2_fM2 & + , iwe2_M2_tau & + , iwe2_dphit & + , iwe2_gradxy_e & + , iwe2_gradxy_n & + , iwe2_flx_uv & + , iwe2_flx_w & + , vol_nodB2T & + , partit & + , mesh & + , .True. & ! flag_AB2, do 2nd order adams-bashfort in time + ) + end if ! Compute global total NIW energy for conservation check - ! call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') + call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'M2') end if t4 = MPI_Wtime() @@ -1320,34 +1560,57 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) t4 = MPI_Wtime() if (idemix2_enable_niw) then + ! create complete Ecomaprt diagnostic + if (idemix2_diag_Ecompart) then + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & + , 'NIW' & + , iwe2_E_niw & + , iwe2_E_niw_divh & + , iwe2_E_niw_divs & + , iwe2_niw_uv & + , iwe2_niw_w & + , iwe2_fniw & + , iwe2_niw_tau & + , iwe2_dphit & + , iwe2_gradxy_e & + , iwe2_gradxy_n & + , iwe2_flx_uv & + , iwe2_flx_w & + , vol_nodB2T & + , partit & + , mesh & + , .True. & ! flag_AB2, do 2nd order adams-bashfort in time + , iwe2_E_niw_dt & ! optional: diagnostic + , iwe2_E_niw_advh & ! optional: diagnostic + , iwe2_E_niw_advs & ! optional: diagnostic + , iwe2_E_niw_diss & ! optional: diagnostic + , iwe2_E_niw_forc & ! optional: diagnostic + ) + else call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & - , 'NIW' & - , iwe2_E_niw & - , iwe2_E_niw_divh & - , iwe2_E_niw_divs & - , iwe2_niw_uv & - , iwe2_niw_w & - , iwe2_fniw & - , iwe2_niw_tau & - , iwe2_dphit & - , iwe2_gradxy_e & - , iwe2_gradxy_n & - , iwe2_flx_uv & - , iwe2_flx_w & - , vol_nodB2T & - , partit & - , mesh & - , .True. & ! flag_AB2, do 2nd order adams-bashfort in time - , iwe2_E_niw_dt & ! optional: diagnostic - , iwe2_E_niw_advh & ! optional: diagnostic - , iwe2_E_niw_advs & ! optional: diagnostic - , iwe2_E_niw_diss & ! optional: diagnostic - , iwe2_E_niw_forc & ! optional: diagnostic - ) - + iwe2_taum1, iwe2_tau, iwe2_taup1 & + , 'NIW' & + , iwe2_E_niw & + , iwe2_E_niw_divh & + , iwe2_E_niw_divs & + , iwe2_niw_uv & + , iwe2_niw_w & + , iwe2_fniw & + , iwe2_niw_tau & + , iwe2_dphit & + , iwe2_gradxy_e & + , iwe2_gradxy_n & + , iwe2_flx_uv & + , iwe2_flx_w & + , vol_nodB2T & + , partit & + , mesh & + , .True. & ! flag_AB2, do 2nd order adams-bashfort in time + ) + end if ! Compute global total NIW energy for conservation check - ! call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') + call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'niw') end if t5 = MPI_Wtime() @@ -1363,22 +1626,37 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) do node = 1, myDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) - call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & - nlev = nln-uln+1 & - , dzw = hnode( uln:nln-1, node) & - , dt = dt & - , c0 = iwe2_c0( uln:nln , node) & - , alpha_c = iwe2_alpha_c( uln:nln , node) & - , fsrf = iwe2_fsrf( node) & - , fbot = iwe2_fbot( uln:nln , node) & - , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & - , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & - , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & - , Eiw_dt = iwe2_E_iw_dt( uln:nln , node) & ! optional: diagnostic - , Eiw_vdif = iwe2_E_iw_vdif( uln:nln , node) & ! optional: diagnostic - , Eiw_srf = iwe2_E_iw_fsrf( node) & ! optional: diagnostic - , Eiw_bot = iwe2_E_iw_fbot( uln:nln , node) & ! optional: diagnostic + if (idemix2_diag_Eiw) then + call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & + nlev = nln-uln+1 & + , dzw = hnode( uln:nln-1, node) & + , dt = dt & + , c0 = iwe2_c0( uln:nln , node) & + , alpha_c = iwe2_alpha_c( uln:nln , node) & + , fsrf = iwe2_fsrf( node) & + , fbot = iwe2_fbot( uln:nln , node) & + , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & + , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & + , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & + , Eiw_dt = iwe2_E_iw_dt( uln:nln , node) & ! optional: diagnostic + , Eiw_vdif = iwe2_E_iw_vdif( uln:nln , node) & ! optional: diagnostic + , Eiw_srf = iwe2_E_iw_fsrf( node) & ! optional: diagnostic + , Eiw_bot = iwe2_E_iw_fbot( uln:nln , node) & ! optional: diagnostic ) + else + call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & + nlev = nln-uln+1 & + , dzw = hnode( uln:nln-1, node) & + , dt = dt & + , c0 = iwe2_c0( uln:nln , node) & + , alpha_c = iwe2_alpha_c( uln:nln , node) & + , fsrf = iwe2_fsrf( node) & + , fbot = iwe2_fbot( uln:nln , node) & + , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & + , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & + , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & + ) + end if end do ! --> do node = 1, myDim_nod2D t7 = MPI_Wtime() time_Eiw_vdiff = t7 - t6 @@ -1392,20 +1670,31 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) t7 = MPI_Wtime() ! for the Diapycnal Diffusivity Induced Internal Gravity Waves...) ! Eiw^(t+1) = Eiw^(t+1) + div_h( v_0 * tau_h * grad_h(v_0*E_iw^(t)) ) - if (idemix2_enable_hor_diffusion .or. idemix2_enable_hor_diff_iter) then + if ((idemix2_enable_hor_diffusion .or. idemix2_enable_hor_diff_iter) .and. idemix2_diag_Eiw) then iwe2_E_iw_hdif = 0.0_WP end if if (idemix2_enable_hor_diffusion) then - call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_tau , :, :) & - , iwe2_E_iw(iwe2_taup1, :, :) & - , iwe2_v0 & - , 1 & - , partit & - , mesh & - , Eiw_dt = iwe2_E_iw_dt( :, :) & ! optional: diagnostic - , Eiw_hdif = iwe2_E_iw_hdif( :, :) & ! optional: diagnostic - ) + if (idemix2_diag_Eiw) then + call compute_hdiff_Eiw( & + iwe2_E_iw(iwe2_tau , :, :) & + , iwe2_E_iw(iwe2_taup1, :, :) & + , iwe2_v0 & + , 1 & + , partit & + , mesh & + , Eiw_dt = iwe2_E_iw_dt & + , Eiw_hdif = iwe2_E_iw_hdif & + ) + else + call compute_hdiff_Eiw( & + iwe2_E_iw(iwe2_tau , :, :) & + , iwe2_E_iw(iwe2_taup1, :, :) & + , iwe2_v0 & + , 1 & + , partit & + , mesh & + ) + end if end if @@ -1415,16 +1704,27 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! high resolution if (idemix2_enable_hor_diff_iter) then do iter=1, idemix2_hor_diff_niter - call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_taup1, :, :) & - , iwe2_E_iw(iwe2_taup1, :, :) & - , iwe2_v0 & - , idemix2_hor_diff_niter & - , partit & - , mesh & - , Eiw_dt = iwe2_E_iw_dt( :, :) & ! optional: diagnostic - , Eiw_hdif = iwe2_E_iw_hdif( :, :) & ! optional: diagnostic - ) + if (idemix2_diag_Eiw) then + call compute_hdiff_Eiw( & + iwe2_E_iw(iwe2_taup1, :, :) & + , iwe2_E_iw(iwe2_taup1, :, :) & + , iwe2_v0 & + , idemix2_hor_diff_niter & + , partit & + , mesh & + , Eiw_dt = iwe2_E_iw_dt & + , Eiw_hdif = iwe2_E_iw_hdif & + ) + else + call compute_hdiff_Eiw( & + iwe2_E_iw(iwe2_taup1, :, :) & + , iwe2_E_iw(iwe2_taup1, :, :) & + , iwe2_v0 & + , idemix2_hor_diff_niter & + , partit & + , mesh & + ) + end if end do end if t8 = MPI_Wtime() @@ -1438,68 +1738,126 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) !_______________________________________________________________ - if (idemix2_enable_M2 .and. idemix2_enable_niw) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , flag_posdef = .True. & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & - , E_M2_struct = iwe2_E_M2_struct( : , node) & - , alpha_M2_c = iwe2_alpha_M2_c( node) & - , tau_M2 = iwe2_M2_tau( node) & - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & - , E_niw_struct = iwe2_E_niw_struct( : , node) & - , tau_niw = iwe2_niw_tau( node) & - , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic - , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & ! optional: diagnostic - , E_iw_diss_niw= iwe2_E_iw_diss_niw( : , node) & ! optional: diagnostic - , E_M2_dt = iwe2_E_M2_dt( : , node) & ! optional: diagnostic - , E_M2_diss_wwi= iwe2_E_M2_diss_wwi( : , node) & ! optional: diagnostic - ) + if (idemix2_enable_M2 .and. idemix2_enable_niw) then + if (idemix2_diag_WWI) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , flag_posdef = .True. & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & + , E_M2_struct = iwe2_E_M2_struct( : , node) & + , alpha_M2_c = iwe2_alpha_M2_c( node) & + , tau_M2 = iwe2_M2_tau( node) & + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & + , E_niw_struct = iwe2_E_niw_struct( : , node) & + , tau_niw = iwe2_niw_tau( node) & + , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic + , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & ! optional: diagnostic + , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & ! optional: diagnostic + , E_M2_dt = iwe2_E_M2_dt( : , node) & ! optional: diagnostic + , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & ! optional: diagnostic + ) + else + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , flag_posdef = .True. & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & + , E_M2_struct = iwe2_E_M2_struct( : , node) & + , alpha_M2_c = iwe2_alpha_M2_c( node) & + , tau_M2 = iwe2_M2_tau( node) & + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & + , E_niw_struct = iwe2_E_niw_struct( : , node) & + , tau_niw = iwe2_niw_tau( node) & + ) + end if + elseif (idemix2_enable_M2) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , flag_posdef = .True. & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & - , E_M2_struct = iwe2_E_M2_struct( : , node) & - , alpha_M2_c = iwe2_alpha_M2_c( node) & - , tau_M2 = iwe2_M2_tau( node) & - , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic - , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & ! optional: diagnostic - , E_M2_dt = iwe2_E_M2_dt( : , node) & ! optional: diagnostic - , E_M2_diss_wwi= iwe2_E_M2_diss_wwi( : , node) & ! optional: diagnostic - ) + if (idemix2_diag_WWI) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , flag_posdef = .True. & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & + , E_M2_struct = iwe2_E_M2_struct( : , node) & + , alpha_M2_c = iwe2_alpha_M2_c( node) & + , tau_M2 = iwe2_M2_tau( node) & + , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic + , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & ! optional: diagnostic + , E_M2_dt = iwe2_E_M2_dt( : , node) & ! optional: diagnostic + , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & ! optional: diagnostic + ) + else + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , flag_posdef = .True. & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & + , E_M2_struct = iwe2_E_M2_struct( : , node) & + , alpha_M2_c = iwe2_alpha_M2_c( node) & + , tau_M2 = iwe2_M2_tau( node) & + ) + end if elseif (idemix2_enable_niw) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , flag_posdef = .True. & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & - , E_niw_struct = iwe2_E_niw_struct( : , node) & - , tau_niw = iwe2_niw_tau( node) & - , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic - , E_iw_diss_niw= iwe2_E_iw_diss_niw( : , node) & ! optional: diagnostic - ) + if (idemix2_diag_WWI) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , flag_posdef = .True. & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & + , E_niw_struct = iwe2_E_niw_struct( : , node) & + , tau_niw = iwe2_niw_tau( node) & + , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic + , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & ! optional: diagnostic + ) + else + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & + , nfbin = idemix2_nfbin & + , dzw = hnode( uln:nln-1, node) & + , dphi = iwe2_dphit & + , dt = dt & + , flag_posdef = .True. & + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & + , E_niw_struct = iwe2_E_niw_struct( : , node) & + , tau_niw = iwe2_niw_tau( node) & + ) + end if end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then end do ! --> for node = 1, myDim_nod2D end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then @@ -1829,9 +2187,146 @@ subroutine adv_Ecompart_hor_spctrl_superbee( & !$OMP END DO !$OMP END PARALLEL end subroutine adv_Ecompart_hor_spctrl_superbee - - - + + + + ! + ! + !___________________________________________________________________________ + ! reflective coastal boundary condition for horizontal spectral energy flux + ! + ! For every interior edge touching exactly one coast node, any flux directed + ! TOWARD that coast node is blocked and re-injected at the same edge into the + ! mirror spectral bin (bin whose propagation angle points back into the ocean). + ! This conserves total energy: the divergence seen by adv_Ecompart_flx2tra_spctrl + ! has zero net flux at coastal edges. + ! + ! Sign convention (matches adv_Ecompart_flx2tra_spctrl): + ! flux > 0 -> transport from ednodes(2) to ednodes(1) + ! flux < 0 -> transport from ednodes(1) to ednodes(2) + ! + ! iwe2_bc_reflect_sgn(edge) = +1 when ednodes(1) is the coast node + ! = -1 when ednodes(2) is the coast node + ! Transport is INTO the coast when sgn * flux > 0. + !___________________________________________________________________________ + ! + ! EACH TIMESTEP — 4 steps + ! ──────────────────────── + ! + ! STEP 1 │ adv_Ecompart_hor_spctrl_superbee + ! │ + ! │ Computes flux(fbini, edge) for all bins. + ! │ In bin fbini, wave energy at n_int propagates toward coast: + ! │ + ! │ n_coast <━━━━━━━━━━━━━━ n_int + ! │ flux(fbini) > 0 + ! │ (positive = toward n_coast) + ! │ + ! │ Superbee enforces positivity on its own fluxes here. + ! + ! STEP 2 │ apply_reflect_bc_spctrl + ! │ + ! │ For each flagged edge where sgn * flux(fbini) > 0: + ! │ + ! │ flux(fbini, edge) = 0 <- coast-directed flux blocked + ! │ reflect_src(kk, n_int) += sgn * outflux <- energy saved for n_int + ! │ + ! │ n_coast ................ n_int + ! │ flux = 0 (blocked) reflect_src(kk) = |outflux| + ! │ + ! │ Coast node is NEVER written to. + ! │ sgn * outflux = |outflux| > 0 regardless of edge orientation. + ! + ! STEP 3 │ adv_Ecompart_flx2tra_spctrl + ! │ + ! │ Accumulates flux divergence into Edivh, divides by vol_s. + ! │ Bin fbini flux was zeroed -> n_int keeps its energy in fbini, + ! │ n_coast gets nothing. + ! │ + ! │ Edivh(fbini, n_int) = 0 (no export toward coast) + ! │ Edivh(fbini, n_coast)= 0 (nothing received) + ! + ! STEP 4 │ inject reflect_src into Edivh (in hsintegrate_Ecompart) + ! │ + ! │ Edivh(kk, n_int) += reflect_src(kk, n_int) / vol_s(n_int) + ! │ + ! │ Energy appears as a SOURCE at n_int in the mirror bin kk -- + ! │ the reflected wave now propagates AWAY from the coast: + ! │ + ! │ n_coast n_int ━━━━━━━━━━━━> + ! │ bin kk (away from coast) + ! + ! ENERGY BALANCE + ! ────────────── + ! n_coast : gained 0 (fbini blocked) + 0 (not in kk path) = 0 (unchanged) + ! n_int : gained 0 in fbini (blocked) + ! gained |outflux|/vol_s in kk (reflect_src) + ! net total = 0 -> spectral redistribution only (conserved) + ! fbini --> energy blocked at coast, stays at n_int + ! kk <-- same energy re-injected at n_int in mirror direction + ! + subroutine apply_reflect_bc_spctrl(flux, partit, mesh) + implicit none + type(t_partit), intent(inout), target :: partit + type(t_mesh) , intent(in ), target :: mesh + real(kind=WP) , intent(inout) :: flux(idemix2_nfbin, partit%myDim_edge2D) + + integer :: edge, fbini, kk, nfbin, sgn, n_int + real(kind=WP) :: outflux +#include "../associate_part_def.h" +#include "../associate_mesh_def.h"1 +#include "../associate_part_ass.h" +#include "../associate_mesh_ass.h" + + nfbin = idemix2_nfbin + + ! Reset scratch; will be divided by vol_s and added to Edivh in + ! hsintegrate_Ecompart after adv_Ecompart_flx2tra_spctrl. + iwe2_reflect_src(:,:) = 0.0_WP + + ! Zero every coast-directed flux so no energy reaches the coast node. + ! For each blocked flux in bin fbini, accumulate two terms into reflect_src: + ! +sgn*outflux in mirror bin kk (energy gained in reflected direction) + ! -sgn*outflux in source bin fbini (energy lost from incident direction) + ! Net: energy is redistributed fbini→kk at n_int with zero total change. + ! Applied to Edivh after adv_Ecompart_flx2tra_spctrl in hsintegrate_Ecompart. +!$OMP PARALLEL DO PRIVATE(edge, fbini, kk, sgn, n_int, outflux) + do edge = 1, myDim_edge2D + kk = iwe2_bc_reflect_bin(edge) + ! edge is not connected to coast + if (kk == 0) cycle + + ! sgn = +1 --> coast node = edges(1, edge) + ! interior = edges(2, edge) + ! sgn = -1 --> coast node = edges(2, edge) + ! interior = edges(1, edge) + sgn = iwe2_bc_reflect_sgn(edge) + + ! which one is interior coastal edge node + n_int = merge(edges(2, edge), edges(1, edge), sgn == +1) + + do fbini = 2, nfbin-1 + outflux = flux(fbini, edge) + if (sgn * outflux > 0.0_WP) then + ! block flux towards coast by setting to zero + flux(fbini, edge) = 0.0_WP + if (n_int <= myDim_nod2D) then +!$OMP ATOMIC + ! put energy in edge mirror spectral bin + iwe2_reflect_src(kk, n_int) = iwe2_reflect_src(kk, n_int) + sgn * outflux +!$OMP ATOMIC + ! take energy from actual spectral bin + iwe2_reflect_src(fbini, n_int) = iwe2_reflect_src(fbini, n_int) - sgn * outflux + end if + end if + end do ! --> do fbini = 2, nfbin-1 + end do ! --> do edge = 1, myDim_edge2D +!$OMP END PARALLEL DO + + end subroutine apply_reflect_bc_spctrl + + + ! ! !___________________________________________________________________________ @@ -2227,7 +2722,6 @@ subroutine hsintegrate_Ecompart( & real(kind=WP) , intent(in ) :: vol_s( partit%myDim_nod2D +partit%eDim_nod2D) logical , intent(in) :: flag_AB2 - real(kind=WP) , intent(inout), optional:: Edt( idemix2_nfbin, partit%myDim_nod2D) real(kind=WP) , intent(inout), optional:: Eadvh( idemix2_nfbin, partit%myDim_nod2D) real(kind=WP) , intent(inout), optional:: Eadvs( idemix2_nfbin, partit%myDim_nod2D) @@ -2269,8 +2763,19 @@ subroutine hsintegrate_Ecompart( & , .True. & ! enforce positive definit ) - ! compute cross spectral superbee advected tracer flux - call adv_Ecompart_crss_spctrl_superbee( & + ! apply reflective coastal BC: redirect coast-directed fluxes into mirror bins + call apply_reflect_bc_spctrl(flx_uv, partit, mesh) + if (idemix2_diag_Ecompart) then + if (Ename == 'M2') then + iwe2_M2_reflect_src (:,:) = iwe2_reflect_src(:,:) + else + iwe2_niw_reflect_src(:,:) = iwe2_reflect_src(:,:) + end if + end if + + !_______________________________________________________________________ + ! compute cross spectral superbee advected tracer flux + call adv_Ecompart_crss_spctrl_superbee( & cs & , E(ti,:,:) & , dphit & @@ -2294,7 +2799,19 @@ subroutine hsintegrate_Ecompart( & ,mesh & ) - !_______________________________________________________________________ + !_______________________________________________________________________ + ! inject blocked coast fluxes as source at interior nodes in mirror bin +!$OMP PARALLEL DO PRIVATE(node, fbini) + do node = 1, myDim_nod2D + if (.not. iwe2_is_reflect_node(node)) cycle + do fbini = 2, nfbin-1 + Edivh(ti, fbini, node) = Edivh(ti, fbini, node) & + + iwe2_reflect_src(fbini, node) / vol_s(node) + end do + end do +!$OMP END PARALLEL DO + + !_______________________________________________________________________ ! Eden and Olbers 2014, eq. 2 ! integrate E_M2^(n+1) = E_M2^(n) + dt*[ ! - div(c_uv*E_M2^n) --> (the minus is hidden in the flux computation) @@ -2348,33 +2865,33 @@ subroutine hsintegrate_Ecompart( & !_______________________________________________________________________ ! additional diagnostics if (present(Edt)) Edt(:,:) = (E(tip1, :, 1:myDim_nod2D)-E(ti, :, 1:myDim_nod2D)) - + if (present(Eadvh)) then if (flag_AB2) then Eadvh(:,:) = ((1.5+idemix2_AB_epsilon)*Edivh(ti , :, 1:myDim_nod2D) & - - (0.5+idemix2_AB_epsilon)*Edivh(tim1, :, 1:myDim_nod2D)) + - (0.5+idemix2_AB_epsilon)*Edivh(tim1, :, 1:myDim_nod2D)) else Eadvh(:,:) = Edivh(ti, :, 1:myDim_nod2D) end if end if - + if (present(Eadvs)) then if (flag_AB2) then Eadvs(:,:) = ((1.5+idemix2_AB_epsilon)*Edivs(ti , :, 1:myDim_nod2D) & - - (0.5+idemix2_AB_epsilon)*Edivs(tim1, :, 1:myDim_nod2D)) + - (0.5+idemix2_AB_epsilon)*Edivs(tim1, :, 1:myDim_nod2D)) else Eadvs(:,:) = Edivs(ti, :, 1:myDim_nod2D) end if end if - + if (present(Ediss)) then do node= 1, myDim_nod2d Ediss(:,node) = - tauE(node)*E(tip1, :, node) end do end if - + if (present(Eforc)) Eforc(:,:) = forc(:, 1:myDim_nod2D) - + end subroutine hsintegrate_Ecompart @@ -2829,20 +3346,22 @@ subroutine compute_hdiff_Eiw( & do node = 1, myDim_nod2D nu1 = ulevels_nod2D(node) nl1 = nlevels_nod2D(node) - + if (present(Eiw_dt)) then do nz = nu1, nl1 Eiw_dt(nz, node) = Eiw_dt(nz, node) + (Eiw(nz, node)-Eiw_old(nz, node))/dt end do end if - + if (present(Eiw_hdif)) then do nz = nu1, nl1 - Eiw_hdif(nz, node) = (Eiw(nz, node)-Eiw_old(nz, node)) + Eiw_hdif(nz, node) = Eiw_hdif(nz, node)+(Eiw(nz, node)-Eiw_old(nz, node)) end do end if + end do end if + end subroutine compute_hdiff_Eiw diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 0d57d3767..aad01e656 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1326,31 +1326,40 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_fsrf' , 'surface forcing' , 'm^3/s^3', iwe2_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_cn' , 'baroclinic velocity' , 'm/s' , iwe2_cn(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) ! optional diagnostic - if (allocated(iwe2_E_iw_dt )) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_dt' , 'Eiw total production ' , 'm^2/s^3', iwe2_E_iw_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_iw_hdif)) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_hdif', 'Eiw production from hor. diff.' , 'm^2/s^3', iwe2_E_iw_hdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_iw_vdif)) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_vdif', 'Eiw production from ver. diff.' , 'm^2/s^3', iwe2_E_iw_vdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_iw_fsrf)) call def_stream( nod2d , myDim_nod2D , 'iwe2_Eiw_fsrf', 'Eiw production from srf. forc.' , 'm^2/s^3', iwe2_E_iw_fsrf( :) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_iw_fbot)) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_fbot', 'Eiw production from bot. forc.' , 'm^2/s^3', iwe2_E_iw_fbot( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (idemix2_diag_Eiw) then + if (allocated(iwe2_E_iw_dt )) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_dt' , 'Eiw total production ' , 'm^2/s^3', iwe2_E_iw_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_hdif)) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_hdif', 'Eiw production from hor. diff.' , 'm^2/s^3', iwe2_E_iw_hdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_vdif)) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_vdif', 'Eiw production from ver. diff.' , 'm^2/s^3', iwe2_E_iw_vdif( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_fsrf)) call def_stream( nod2d , myDim_nod2D , 'iwe2_Eiw_fsrf', 'Eiw production from srf. forc.' , 'm^2/s^3', iwe2_E_iw_fsrf( :) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_iw_fbot)) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_fbot', 'Eiw production from bot. forc.' , 'm^2/s^3', iwe2_E_iw_fbot( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if if (idemix2_enable_M2) then - call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_alphac' , 'M2 energy dissipation' , 'none' , iwe2_alpha_M2_c(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream( nod2d , myDim_nod2D , 'iwe2_M2_tau' , 'M2 dissipation timescale' , 's' , iwe2_M2_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_forc' , 'M2 forcing' , 'm^3/s^3/rad', iwe2_fM2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_M2_w' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_u' , 'M2 zonal propag.' , 'm/s' , iwe2_M2_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_M2_v' , 'M2 merid. propag.' , 'm/s' , iwe2_M2_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_m2_alphac' , 'M2 energy dissipation' , 'none' , iwe2_alpha_M2_c(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_m2_tau' , 'M2 dissipation timescale' , 's' , iwe2_M2_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_m2_forc' , 'M2 forcing' , 'm^3/s^3/rad', iwe2_fM2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_m2_w' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_m2_u' , 'M2 zonal propag.' , 'm/s' , iwe2_M2_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_m2_v' , 'M2 merid. propag.' , 'm/s' , iwe2_M2_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2' , 'M2 wave energy' , 'm^2/s^2' , iwe2_E_M2( iwe2_taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divh' , 'EM2 horiz wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divh(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divs' , 'EM2 crss spctr wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divs(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Em2_strct' , 'EM2 structure function energy' , 'm^2/s^2' , iwe2_E_M2_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - ! optional diagnostic - if (allocated(iwe2_E_M2_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_dt' , 'EM2 total tendency' , 'm^2/s^3' , iwe2_E_M2_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_M2_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advh' , 'EM2 horizontal advection' , 'm^2/s^3' , iwe2_E_M2_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_M2_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advs' , 'EM2 spectral advection' , 'm^2/s^3' , iwe2_E_M2_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_M2_diss )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_diss' , 'EM2 dissipation' , 'm^2/s^3' , iwe2_E_M2_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_M2_forc )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_forc' , 'EM2 forcing tendency' , 'm^2/s^3' , iwe2_E_M2_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_iw_diss_M2)) call def_stream((/nl ,nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eiw_dissM2' , 'Eiw dissipation through M2 WWI' , 'm^2/s^3' , iwe2_E_iw_diss_M2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + ! optional diagnostic + if (idemix2_diag_Ecompart) then + if (allocated(iwe2_M2_reflect_src )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_reflsrc' , 'M2 coast-reflect. accumulated flux' , 'm^4/s^3' , iwe2_M2_reflect_src(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_dt' , 'EM2 total tendency' , 'm^2/s^3' , iwe2_E_M2_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advh' , 'EM2 horizontal advection' , 'm^2/s^3' , iwe2_E_M2_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advs' , 'EM2 spectral advection' , 'm^2/s^3' , iwe2_E_M2_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_diss )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_diss' , 'EM2 dissipation' , 'm^2/s^3' , iwe2_E_M2_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_forc )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_forc' , 'EM2 forcing tendency' , 'm^2/s^3' , iwe2_E_M2_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + + end if + if (idemix2_diag_WWI) then + if (allocated(iwe2_E_iw_diss_M2)) call def_stream((/nl ,nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eiw_dissM2' , 'Eiw dissipation through M2 WWI' , 'm^2/s^3' , iwe2_E_iw_diss_M2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_diss_wwi))call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_dissWWI', 'EM2 dissipation through Eiw' , 'm^2/s^3' , iwe2_E_M2_diss_wwi(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if end if if (idemix2_enable_niw) then @@ -1364,13 +1373,18 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divh' , 'Eniw horz wave energy diverg.' , 'm^2/s^2' , iwe2_E_niw_divh(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divs' , 'Eniw crss spctr wave energy diverg.', 'm^2/s^2' , iwe2_E_niw_divs(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eniw_strct' , 'Eniw structure function energy' , 'm^2/s^2' , iwe2_E_niw_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - ! optional diagnostic - if (allocated(iwe2_E_niw_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_dt' , 'Eniw total tendency' , 'm^2/s^3' , iwe2_E_niw_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_niw_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advh' , 'Eniw horizontal advection' , 'm^2/s^3' , iwe2_E_niw_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_niw_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advs' , 'Eniw spectral advection' , 'm^2/s^3' , iwe2_E_niw_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_niw_diss )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_diss' , 'Eniw dissipation' , 'm^2/s^3' , iwe2_E_niw_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_niw_forc )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_forc' , 'Eniw forcing tendency' , 'm^2/s^3' , iwe2_E_niw_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_iw_diss_niw)) call def_stream((/nl ,nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eiw_dissniw', 'Eiw dissipation through niw WWI' , 'm^2/s^3' , iwe2_E_iw_diss_niw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + ! optional diagnostic + if (idemix2_diag_Ecompart) then + if (allocated(iwe2_niw_reflect_src)) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_reflsrc', 'niw coast-reflect. accumulated flux', 'm^4/s^3' , iwe2_niw_reflect_src(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_dt' , 'Eniw total tendency' , 'm^2/s^3' , iwe2_E_niw_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advh' , 'Eniw horizontal advection' , 'm^2/s^3' , iwe2_E_niw_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advs' , 'Eniw spectral advection' , 'm^2/s^3' , iwe2_E_niw_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_diss )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_diss' , 'Eniw dissipation' , 'm^2/s^3' , iwe2_E_niw_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_forc )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_forc' , 'Eniw forcing tendency' , 'm^2/s^3' , iwe2_E_niw_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if + if (idemix2_diag_WWI) then + if (allocated(iwe2_E_iw_diss_niw)) call def_stream((/nl ,nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eiw_dissniw', 'Eiw dissipation through niw WWI' , 'm^2/s^3' , iwe2_E_iw_diss_niw(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + end if end if if (idemix2_enable_M2 .or. idemix2_enable_niw) then From 11fca451300afb6000ae407eca05812efb8c78d3 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 2 Jun 2026 15:28:16 +0200 Subject: [PATCH 31/63] add improved time scaling diagnostics --- src/fesom_module.F90 | 255 ++++++++++++++++++++++++------------- src/gen_modules_config.F90 | 2 +- src/ice_setup_step.F90 | 5 +- 3 files changed, 172 insertions(+), 90 deletions(-) diff --git a/src/fesom_module.F90 b/src/fesom_module.F90 index ab9b7498a..8052b042b 100755 --- a/src/fesom_module.F90 +++ b/src/fesom_module.F90 @@ -65,14 +65,25 @@ module fesom_main_storage_module integer :: which_readr ! read which restart files (0=netcdf, 1=core dump,2=dtype) integer :: total_nsteps integer, pointer :: mype, npes, MPIerr, MPI_COMM_FESOM, MPI_COMM_WORLD, MPI_COMM_FESOM_IB - real(kind=WP) :: t0, t1, t2, t3, t4, t5, t6, t7, t8, t0_ice, t1_ice, t0_frc, t1_frc - real(kind=WP) :: rtime_fullice, rtime_write_restart, rtime_write_means, rtime_compute_diag, rtime_read_forcing + real(kind=WP) :: t0, t1, t2, t3, t4, t5, t6, t7, t8 + real(kind=WP) :: t_start , t_end + real(kind=WP) :: t_iceb_s , t_iceb_e , rtime_iceb_full, t_iceb_s0, t_iceb_e0, t_iceb_s1, t_iceb_e1 + real(kind=WP) :: t_ice_s , t_ice_e , rtime_ice_full + real(kind=WP) :: t_ice_o2iflx_s , rtime_ice_o2iflx + real(kind=WP) :: t_ice_rfrc_s , rtime_ice_readforc + real(kind=WP) :: t_ice_step_s , rtime_ice_step, rtime_ice_step_evp, rtime_ice_adv, rtime_ice_therm + real(kind=WP) :: t_ice_oflx_s , rtime_ice_oflx + real(kind=WP) :: t_oce_s , t_oce_e , rtime_oce_full + real(kind=WP) :: t_diag_s , t_diag_e , rtime_compute_diag + real(kind=WP) :: t_io_s , t_io_e , rtime_write_means + real(kind=WP) :: t_rstart_s, t_rstart_e, rtime_write_restart + real(kind=real32) :: rtime_setup_mesh, rtime_setup_ocean, rtime_setup_forcing real(kind=real32) :: rtime_setup_ice, rtime_setup_other, rtime_setup_restart real(kind=real32) :: runtime_alltimesteps #if defined (__recom) - real(kind=WP) :: t0_recom, t1_recom - real(kind=real32) :: rtime_setup_recom, rtime_compute_recom + real(kind=WP) :: t_recom_s, t_recom_e, rtime_compute_recom + real(kind=real32) :: rtime_setup_recom #endif type(t_mesh) mesh @@ -296,9 +307,9 @@ subroutine fesom_init(fesom_total_nsteps) ! recom setup #if defined (__recom) if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call recom_init'//achar(27)//'[0m' - f%t0_recom=MPI_Wtime() + f%t_recom_s=MPI_Wtime() call recom_init(f%tracers, f%partit, f%mesh) ! adjust values for recom tracers (derived type "t_tracer") - f%t1_recom=MPI_Wtime() + f%t_recom_e=MPI_Wtime() if (f%mype==0) write(*,*) 'RECOM recom_init... complete' #endif @@ -405,7 +416,7 @@ subroutine fesom_init(fesom_total_nsteps) f%rtime_setup_other = real((f%t8 - f%t7) + (f%t6 - f%t5) ,real32) #if defined (__recom) - f%rtime_setup_recom = real( f%t1_recom - f%t0_recom ,real32) + f%rtime_setup_recom = real( f%t_recom_s - f%t_recom_e ,real32) #endif write(*,*) '==========================================' @@ -464,11 +475,16 @@ subroutine fesom_init(fesom_total_nsteps) ! if (f%mype==10) write(,) f%mesh1%ssh_stiff%values-f%mesh%ssh_stiff%value ! Initialize timers - f%rtime_fullice = 0._WP + f%rtime_oce_full = 0._WP + f%rtime_ice_full = 0._WP + f%rtime_ice_o2iflx = 0._WP + f%rtime_ice_readforc = 0._WP + f%rtime_ice_step = 0._WP + f%rtime_ice_oflx = 0._WP + f%rtime_write_restart = 0._WP f%rtime_write_means = 0._WP f%rtime_compute_diag = 0._WP - f%rtime_read_forcing = 0._WP #if defined (__recom) f%rtime_compute_recom = 0._WP #endif @@ -555,8 +571,8 @@ subroutine fesom_runloop(current_nsteps) call MPI_Barrier(f%MPI_COMM_FESOM, f%MPIERR) if (f%mype==0) then write(*,*) 'FESOM start iteration after the barrier...' - f%t0 = MPI_Wtime() endif + f%t_start = MPI_Wtime() if(f%mype==0) then write(*,*) print *, achar(27)//'[32m' //'____________________________________________________________'//achar(27)//'[0m' @@ -573,6 +589,7 @@ subroutine fesom_runloop(current_nsteps) do n=nstart, ntotal if (use_icebergs) then + f%t_iceb_s0 = MPI_Wtime() !n_ib = n u_wind_ib = u_wind v_wind_ib = v_wind @@ -622,6 +639,7 @@ subroutine fesom_runloop(current_nsteps) ! ----------------------------------------------------------------------------------- ! LA asyncronous coupling not included in this FESOM version, yet!! ! + f%t_iceb_e0 = MPI_Wtime() end if if (use_global_tides) then @@ -644,21 +662,25 @@ subroutine fesom_runloop(current_nsteps) ! -------------- ! LA icebergs: 2023-05-17 if (use_icebergs .and. mod(n - 1, steps_per_ib_step)==0) then + f%t_iceb_s = MPI_Wtime() if (f%mype==0) write(*,*) '*** step n=',n !t1_icb = MPI_Wtime() call iceberg_calculation(f%ice,f%mesh,f%partit,f%dynamics,n) + f%t_iceb_e = MPI_Wtime() end if ! -------------- + !___model sea-ice step__________________________________________________ - f%t1 = MPI_Wtime() if(use_ice) then + f%t_ice_s = MPI_Wtime() !___compute fluxes from ocean to ice________________________________ if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call ocean2ice(n)'//achar(27)//'[0m' + f%t_ice_o2iflx_s = MPI_Wtime() call ocean2ice(f%ice, f%dynamics, f%tracers, f%partit, f%mesh) !___compute update of atmospheric forcing____________________________ if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call update_atm_forcing(n)'//achar(27)//'[0m' - f%t0_frc = MPI_Wtime() + f%t_ice_rfrc_s = MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_start("update_atm_forcing") #endif @@ -666,7 +688,7 @@ subroutine fesom_runloop(current_nsteps) #if defined (FESOM_PROFILING) call fesom_profiler_end("update_atm_forcing") #endif - f%t1_frc = MPI_Wtime() + f%t_ice_step_s = MPI_Wtime() !___compute ice step________________________________________________ if (f%ice%ice_steps_since_upd>=f%ice%ice_ave_steps-1) then f%ice%ice_update=.true. @@ -685,26 +707,29 @@ subroutine fesom_runloop(current_nsteps) call fesom_profiler_end("ice_timestep") #endif endif - + !___compute fluxes to the ocean: heat, freshwater, momentum_________ if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call oce_fluxes_mom...'//achar(27)//'[0m' + f%t_ice_oflx_s = MPI_Wtime() call oce_fluxes_mom(f%ice, f%dynamics, f%partit, f%mesh) ! momentum only call oce_fluxes(f%ice, f%dynamics, f%tracers, f%partit, f%mesh) + f%t_ice_e = MPI_Wtime() end if + call before_oce_step(f%dynamics, f%tracers, f%partit, f%mesh) ! prepare the things if required - f%t2 = MPI_Wtime() - + !___now recom____________________________________________________ #if defined (__recom) if (f%mype==0 .and. n==1) print *, achar(27)//'[46' //'_____________________________________________________________'//achar(27)//'[0m' if (f%mype==0 .and. n==1) print *, achar(27)//'[46;1m'//' --> call REcoM '//achar(27)//'[0m' - f%t0_recom = MPI_Wtime() + f%t_recom_s = MPI_Wtime() call recom(f%ice, f%dynamics, f%tracers, f%partit, f%mesh) - f%t1_recom = MPI_Wtime() + f%t_recom_e = MPI_Wtime() #endif !___model ocean step____________________________________________________ if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call oce_timestep_ale'//achar(27)//'[0m' + f%t_oce_s = MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_start("oce_timestep_ale") #endif @@ -720,10 +745,11 @@ subroutine fesom_runloop(current_nsteps) end if end do end if ! use_transit - - f%t3 = MPI_Wtime() + f%t_oce_e = MPI_Wtime() + !___compute energy diagnostics..._______________________________________ if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call compute_diagnostics(1)'//achar(27)//'[0m' + f%t_diag_s = MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_start("compute_diagnostics") #endif @@ -731,10 +757,11 @@ subroutine fesom_runloop(current_nsteps) #if defined (FESOM_PROFILING) call fesom_profiler_end("compute_diagnostics") #endif - - f%t4 = MPI_Wtime() + f%t_diag_e = MPI_Wtime() + !___prepare output______________________________________________________ if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call output (n)'//achar(27)//'[0m' + f%t_io_s = MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_start("output") #endif @@ -742,14 +769,19 @@ subroutine fesom_runloop(current_nsteps) #if defined (FESOM_PROFILING) call fesom_profiler_end("output") #endif - + f%t_io_e = MPI_Wtime() + ! LA icebergs: 2023-05-17 if (use_icebergs .and. mod(n, steps_per_ib_step)==0.0) then + f%t_iceb_s1 = MPI_Wtime() call reset_ib_fluxes + f%t_iceb_e1 = MPI_Wtime() end if !-------------------------- - f%t5 = MPI_Wtime() + !___prepare restart_____________________________________________________ + if (flag_debug .and. f%mype==0) print *, achar(27)//'[34m'//' --> call write_initial_conditions(n,...)'//achar(27)//'[0m' + f%t_rstart_s = MPI_Wtime() #if defined (FESOM_PROFILING) call fesom_profiler_start("restart") #endif @@ -757,18 +789,10 @@ subroutine fesom_runloop(current_nsteps) #if defined (FESOM_PROFILING) call fesom_profiler_end("restart") #endif - f%t6 = MPI_Wtime() + f%t_rstart_e = MPI_Wtime() - f%rtime_fullice = f%rtime_fullice + f%t2 - f%t1 - f%rtime_compute_diag = f%rtime_compute_diag + f%t4 - f%t3 - f%rtime_write_means = f%rtime_write_means + f%t5 - f%t4 - f%rtime_write_restart = f%rtime_write_restart + f%t6 - f%t5 - f%rtime_read_forcing = f%rtime_read_forcing + f%t1_frc - f%t0_frc -#if defined (__recom) - f%rtime_compute_recom = f%rtime_compute_recom + f%t1_recom - f%t0_recom -#endif - -! Transient tracers: update of input values between restarts + ! ______________________________________________________________________ + ! Transient tracers: update of input values between restarts if(use_transit .and. anthro_transit .and. (daynew == ndpyr) .and. (timenew==86400.)) then ti_transit = ti_transit + 1 if (f%mype==0) then @@ -785,6 +809,30 @@ subroutine fesom_runloop(current_nsteps) end if endif + !_______________________________________________________________________ + ! accumulate for mean wall-clock time of sub components + if (use_ice) then + f%rtime_ice_full = f%rtime_ice_full + f%t_ice_e - f%t_ice_s + f%rtime_ice_o2iflx = f%rtime_ice_o2iflx + f%t_ice_rfrc_s - f%t_ice_o2iflx_s + f%rtime_ice_readforc = f%rtime_ice_readforc + f%t_ice_step_s - f%t_ice_rfrc_s + f%rtime_ice_step = f%rtime_ice_step + f%t_ice_oflx_s - f%t_ice_step_s + f%rtime_ice_oflx = f%rtime_ice_oflx + f%t_ice_e - f%t_ice_oflx_s + end if + + f%rtime_oce_full = f%rtime_oce_full + f%t_oce_e - f%t_oce_s + + if (use_icebergs) then + f%rtime_iceb_full = f%rtime_iceb_full + f%t_iceb_e-f%t_iceb_s + f%t_iceb_e0-f%t_iceb_s0 + f%t_iceb_e1-f%t_iceb_s1 + end if + + f%rtime_compute_diag = f%rtime_compute_diag + f%t_diag_e - f%t_diag_s + f%rtime_write_means = f%rtime_write_means + f%t_io_e - f%t_io_s + f%rtime_write_restart = f%rtime_write_restart + f%t_rstart_e - f%t_rstart_s + +#if defined (__recom) + f%rtime_compute_recom = f%rtime_compute_recom + f%t_recom_s - f%t_recom_e +#endif + end do !call cray_acc_set_debug_global_level(3) f%from_nstep = f%from_nstep+current_nsteps @@ -805,8 +853,9 @@ subroutine fesom_finalize() use mpp_io #endif ! EO parameters - real(kind=real32) :: mean_rtime(16), max_rtime(16), min_rtime(16) - integer :: tr_num + integer :: tr_num, n_rtime=22 + real(kind=real32), allocatable :: mean_rtime(:), max_rtime(:), min_rtime(:) + allocate(mean_rtime(n_rtime), max_rtime(n_rtime), min_rtime(n_rtime)) ! Start finalization profiling #if defined (FESOM_PROFILING) @@ -869,13 +918,16 @@ subroutine fesom_finalize() !$ACC EXIT DATA DELETE (f%partit%eDim_nod2D, f%partit%myDim_edge2D) !$ACC EXIT DATA DELETE (f%partit%myDim_elem2D, f%partit%myDim_nod2D, f%partit%myList_edge2D) !$ACC EXIT DATA DELETE (f%mesh, f%partit, f) + f%t_end = MPI_Wtime() + f%runtime_alltimesteps = real(f%t_end-f%t_start,real32) if (f%mype==0) then - f%t1 = MPI_Wtime() - f%runtime_alltimesteps = real(f%t1-f%t0,real32) write(*,*) 'FESOM Run is finished, updating clock' endif - mean_rtime(1) = rtime_oce + + !___________________________________________________________________________ + ! ocean step timeing + mean_rtime(1) = f%rtime_oce_full mean_rtime(2) = rtime_oce_presdens mean_rtime(3) = rtime_oce_mixing mean_rtime(4) = rtime_oce_dyn @@ -883,31 +935,51 @@ subroutine fesom_finalize() mean_rtime(6) = rtime_oce_solvessh mean_rtime(7) = rtime_oce_GMRedi mean_rtime(8) = rtime_oce_solvetra - mean_rtime(9) = rtime_ice - mean_rtime(10) = rtime_tot - mean_rtime(11) = f%rtime_fullice - f%rtime_read_forcing - mean_rtime(12) = f%rtime_compute_diag - mean_rtime(13) = f%rtime_write_means - mean_rtime(14) = f%rtime_write_restart - mean_rtime(15) = f%rtime_read_forcing + + ! ice step timeing + mean_rtime(9) = f%rtime_ice_full + mean_rtime(10) = f%rtime_ice_o2iflx + mean_rtime(11) = f%rtime_ice_readforc + mean_rtime(12) = f%rtime_ice_step + mean_rtime(13) = rtime_ice_evp + mean_rtime(14) = rtime_ice_adv + mean_rtime(15) = rtime_ice_therm + mean_rtime(16) = f%rtime_ice_oflx + + ! total ice+ocean step timeing + mean_rtime(17) = f%rtime_oce_full + f%rtime_ice_full + + ! diag, mean I/O, restart timing + mean_rtime(18) = f%rtime_compute_diag + mean_rtime(19) = f%rtime_write_means + mean_rtime(20) = f%rtime_write_restart + + ! total runtime + mean_rtime(21) = f%runtime_alltimesteps + #if defined (__recom) - mean_rtime(16) = f%rtime_compute_recom + ! recom timing + mean_rtime(n_rtime) = f%rtime_compute_recom #endif - max_rtime(1:15) = mean_rtime(1:15) - min_rtime(1:15) = mean_rtime(1:15) + + ! compute mean, max, min component WCT across processors + max_rtime(1:n_rtime-1) = mean_rtime(1:n_rtime-1) + min_rtime(1:n_rtime-1) = mean_rtime(1:n_rtime-1) + call MPI_AllREDUCE(MPI_IN_PLACE, mean_rtime, n_rtime-1, MPI_REAL, MPI_SUM, f%MPI_COMM_FESOM, f%MPIerr) + mean_rtime(1:n_rtime-1) = mean_rtime(1:n_rtime-1) / real(f%npes,real32) + call MPI_AllREDUCE(MPI_IN_PLACE, max_rtime, n_rtime-1, MPI_REAL, MPI_MAX, f%MPI_COMM_FESOM, f%MPIerr) + call MPI_AllREDUCE(MPI_IN_PLACE, min_rtime, n_rtime-1, MPI_REAL, MPI_MIN, f%MPI_COMM_FESOM, f%MPIerr) + #if defined (__recom) - max_rtime(16) = mean_rtime(16) - min_rtime(16) = mean_rtime(16) - call MPI_AllREDUCE(MPI_IN_PLACE, mean_rtime(16), 1, MPI_REAL, MPI_SUM, f%MPI_COMM_FESOM, f%MPIerr) - mean_rtime(16) = mean_rtime(16) / real(f%npes,real32) - call MPI_AllREDUCE(MPI_IN_PLACE, max_rtime(16), 1, MPI_REAL, MPI_MAX, f%MPI_COMM_FESOM, f%MPIerr) - call MPI_AllREDUCE(MPI_IN_PLACE, min_rtime(16), 1, MPI_REAL, MPI_MIN, f%MPI_COMM_FESOM, f%MPIerr) -#endif - - call MPI_AllREDUCE(MPI_IN_PLACE, mean_rtime, 15, MPI_REAL, MPI_SUM, f%MPI_COMM_FESOM, f%MPIerr) - mean_rtime(1:15) = mean_rtime(1:15) / real(f%npes,real32) - call MPI_AllREDUCE(MPI_IN_PLACE, max_rtime, 15, MPI_REAL, MPI_MAX, f%MPI_COMM_FESOM, f%MPIerr) - call MPI_AllREDUCE(MPI_IN_PLACE, min_rtime, 15, MPI_REAL, MPI_MIN, f%MPI_COMM_FESOM, f%MPIerr) + ! compute mean, max, min recom WCT across processors + max_rtime(n_rtime) = mean_rtime(n_rtime) + min_rtime(n_rtime) = mean_rtime(n_rtime) + call MPI_AllREDUCE(MPI_IN_PLACE, mean_rtime(n_rtime), 1, MPI_REAL, MPI_SUM, f%MPI_COMM_FESOM, f%MPIerr) + mean_rtime(n_rtime) = mean_rtime(n_rtime) / real(f%npes,real32) + call MPI_AllREDUCE(MPI_IN_PLACE, max_rtime(n_rtime), 1, MPI_REAL, MPI_MAX, f%MPI_COMM_FESOM, f%MPIerr) + call MPI_AllREDUCE(MPI_IN_PLACE, min_rtime(n_rtime), 1, MPI_REAL, MPI_MIN, f%MPI_COMM_FESOM, f%MPIerr) +#endif + #if defined (__oifs) ! OpenIFS coupled version has to call oasis_terminate through par_ex @@ -926,41 +998,48 @@ subroutine fesom_finalize() if(f%fesom_did_mpi_init) call par_ex(f%partit%MPI_COMM_FESOM, f%partit%mype) ! finalize MPI before FESOM prints its stats block, otherwise there is sometimes output from other processes from an earlier time in the programm AFTER the starts block (with parastationMPI) if (f%mype==0) then - 41 format (a35,a10,2a15) !Format for table heading - 42 format (a30,3f15.4) !Format for table content - - print 41, '___MODEL RUNTIME per task [seconds]','_____mean_','___________min_', '___________max_' - print 42, ' runtime ocean: ', mean_rtime(1), min_rtime(1), max_rtime(1) - print 42, ' > runtime oce. pres.,dens:', mean_rtime(2), min_rtime(2), max_rtime(2) - print 42, ' > runtime oce. mixing :', mean_rtime(3), min_rtime(3), max_rtime(3) - print 42, ' > runtime oce. dyn. u,v,w:', mean_rtime(4), min_rtime(4), max_rtime(4) - print 42, ' > runtime oce. dyn. ssh :', mean_rtime(5), min_rtime(5), max_rtime(5) - print 42, ' > runtime oce. solve ssh :', mean_rtime(6), min_rtime(6), max_rtime(6) - print 42, ' > runtime oce. GM/Redi :', mean_rtime(7), min_rtime(7), max_rtime(7) - print 42, ' > runtime oce. tracer :', mean_rtime(8), min_rtime(8), max_rtime(8) - print 42, ' runtime ice : ', mean_rtime(11), min_rtime(11), max_rtime(11) - print 42, ' > runtime ice step : ', mean_rtime(9), min_rtime(9), max_rtime(9) - print 42, ' runtime diag: ', mean_rtime(12), min_rtime(12), max_rtime(12) - print 42, ' runtime output: ', mean_rtime(13), min_rtime(13), max_rtime(13) - print 42, ' runtime restart: ', mean_rtime(14), min_rtime(14), max_rtime(14) - print 42, ' runtime forcing: ', mean_rtime(15), min_rtime(15), max_rtime(15) - print 42, ' runtime total (ice+oce): ', mean_rtime(10), min_rtime(10), max_rtime(10) + 41 format (a35,a10,2a15,a9,a10) !Format heading + 42 format (a,3f15.4,f8.2,a1,f8.2,a1) !Format oce/ice (two %) + 43 format (a,3f15.4,f8.2,a1) !Format other (one %) + + print 41, '___MODEL RUNTIME per task [seconds]','_____mean_','___________min_','___________max_','____%tot_','_%ice+oce_' + write(*,42) ' > runtime ocean :', mean_rtime(1), min_rtime(1), max_rtime(1), 100.*mean_rtime(1) /mean_rtime(21),'%',100.*mean_rtime(1) /mean_rtime(17),'%' + write(*,42) ' ├> runtime oce. pres.,dens:', mean_rtime(2), min_rtime(2), max_rtime(2), 100.*mean_rtime(2) /mean_rtime(21),'%',100.*mean_rtime(2) /mean_rtime(17),'%' + write(*,42) ' ├> runtime oce. mixing :', mean_rtime(3), min_rtime(3), max_rtime(3), 100.*mean_rtime(3) /mean_rtime(21),'%',100.*mean_rtime(3) /mean_rtime(17),'%' + write(*,42) ' ├> runtime oce. dyn. u,v,w:', mean_rtime(4), min_rtime(4), max_rtime(4), 100.*mean_rtime(4) /mean_rtime(21),'%',100.*mean_rtime(4) /mean_rtime(17),'%' + write(*,42) ' ├> runtime oce. dyn. ssh :', mean_rtime(5), min_rtime(5), max_rtime(5), 100.*mean_rtime(5) /mean_rtime(21),'%',100.*mean_rtime(5) /mean_rtime(17),'%' + write(*,42) ' │ └> runtime oce. slv ssh:', mean_rtime(6), min_rtime(6), max_rtime(6), 100.*mean_rtime(6) /mean_rtime(21),'%',100.*mean_rtime(6) /mean_rtime(17),'%' + write(*,42) ' ├> runtime oce. GM/Redi :', mean_rtime(7), min_rtime(7), max_rtime(7), 100.*mean_rtime(7) /mean_rtime(21),'%',100.*mean_rtime(7) /mean_rtime(17),'%' + write(*,42) ' └> runtime oce. tracer :', mean_rtime(8), min_rtime(8), max_rtime(8), 100.*mean_rtime(8) /mean_rtime(21),'%',100.*mean_rtime(8) /mean_rtime(17),'%' + write(*,42) ' > runtime ice :', mean_rtime(9), min_rtime(9), max_rtime(9), 100.*mean_rtime(9) /mean_rtime(21),'%',100.*mean_rtime(9) /mean_rtime(17),'%' + write(*,42) ' ├> runtime ice o2iflx :', mean_rtime(10), min_rtime(10), max_rtime(10), 100.*mean_rtime(10)/mean_rtime(21),'%',100.*mean_rtime(10)/mean_rtime(17),'%' + write(*,42) ' ├> runtime ice read forc :', mean_rtime(11), min_rtime(11), max_rtime(11), 100.*mean_rtime(11)/mean_rtime(21),'%',100.*mean_rtime(11)/mean_rtime(17),'%' + write(*,42) ' ├> runtime ice step :', mean_rtime(12), min_rtime(12), max_rtime(12), 100.*mean_rtime(12)/mean_rtime(21),'%',100.*mean_rtime(12)/mean_rtime(17),'%' + write(*,42) ' │ ├> runtime ice evp :', mean_rtime(13), min_rtime(13), max_rtime(13), 100.*mean_rtime(13)/mean_rtime(21),'%',100.*mean_rtime(13)/mean_rtime(17),'%' + write(*,42) ' │ ├> runtime ice adv. :', mean_rtime(14), min_rtime(14), max_rtime(14), 100.*mean_rtime(14)/mean_rtime(21),'%',100.*mean_rtime(14)/mean_rtime(17),'%' + write(*,42) ' │ └> runtime ice therm. :', mean_rtime(15), min_rtime(15), max_rtime(15), 100.*mean_rtime(15)/mean_rtime(21),'%',100.*mean_rtime(15)/mean_rtime(17),'%' + write(*,42) ' └> runtime ice o2aflx :', mean_rtime(16), min_rtime(16), max_rtime(16), 100.*mean_rtime(16)/mean_rtime(21),'%',100.*mean_rtime(16)/mean_rtime(17),'%' + write(*,42) ' > runtime total (ice+oce) :', mean_rtime(17), min_rtime(17), max_rtime(17), 100.*mean_rtime(17)/mean_rtime(21),'%',100.*mean_rtime(17)/mean_rtime(17),'%' + write(*,43) ' > runtime diag :', mean_rtime(18), min_rtime(18), max_rtime(18), 100.*mean_rtime(18)/mean_rtime(21),'%' + write(*,43) ' > runtime output :', mean_rtime(19), min_rtime(19), max_rtime(19), 100.*mean_rtime(19)/mean_rtime(21),'%' + write(*,43) ' > runtime restart :', mean_rtime(20), min_rtime(20), max_rtime(20), 100.*mean_rtime(20)/mean_rtime(21),'%' + #if defined (__recom) - print 42, ' runtime recom: ', mean_rtime(16), min_rtime(16), max_rtime(16) + print 43, ' runtime recom: ', mean_rtime(n_rtime), min_rtime(n_rtime), max_rtime(n_rtime), 100.*mean_rtime(n_rtime)/mean_rtime(21),'%' #endif - 43 format (a33,i15) !Format Ncores - 44 format (a33,i15) !Format OMP threads - 45 format (a33,f15.4,a4) !Format runtime + 44 format (a33,i15) !Format Ncores + 45 format (a33,i15) !Format OMP threads + 46 format (a33,f15.4,a4) !Format runtime write(*,*) write(*,*) '======================================================' write(*,*) '================ BENCHMARK RUNTIME ===================' - print 43, ' Number of cores : ',f%npes + print 44, ' Number of cores : ',f%npes #if defined(_OPENMP) - print 44, ' Max OpenMP threads : ',OMP_GET_MAX_THREADS() + print 45, ' Max OpenMP threads : ',OMP_GET_MAX_THREADS() #endif - print 45, ' Runtime for all timesteps : ',f%runtime_alltimesteps,' sec' + print 46, ' Runtime for all timesteps : ',f%runtime_alltimesteps,' sec' write(*,*) '======================================================' write(*,*) end if diff --git a/src/gen_modules_config.F90 b/src/gen_modules_config.F90 index 2974c63f7..670e500a2 100755 --- a/src/gen_modules_config.F90 +++ b/src/gen_modules_config.F90 @@ -168,7 +168,7 @@ module g_config real(kind=WP) :: dt integer :: save_count_mean, save_count_restart logical :: r_restart - real(kind=WP) :: rtime_ice=0.0, rtime_tot=0.0 + real(kind=WP) :: rtime_ice=0.0, rtime_tot=0.0, rtime_ice_evp=0.0, rtime_ice_adv=0.0, rtime_ice_therm=0.0 real(kind=WP) :: rtime_oce=0.0, rtime_oce_dyn=0.0, rtime_oce_dynssh=0.0, rtime_oce_solvessh=0.0 real(kind=WP) :: rtime_oce_solvetra=0.0, rtime_oce_GMRedi=0.0, rtime_oce_presdens=0.0, rtime_oce_mixing=0.0 real(kind=WP) :: dummy=1.e10 diff --git a/src/ice_setup_step.F90 b/src/ice_setup_step.F90 index 6821125fb..1c6180089 100755 --- a/src/ice_setup_step.F90 +++ b/src/ice_setup_step.F90 @@ -333,7 +333,10 @@ subroutine ice_timestep(step, ice, partit, mesh) #if defined (FESOM_PROFILING) call fesom_profiler_end("ice_thermodynamics") #endif - rtime_ice = rtime_ice + (t3-t0) + rtime_ice = rtime_ice + (t3-t0) + rtime_ice_evp = rtime_ice_evp + t1-t0 + rtime_ice_adv = rtime_ice_adv + t2-t1 + rtime_ice_therm = rtime_ice_therm + t3-t2 rtime_tot = rtime_tot + (t3-t0) if(mod(step,logfile_outfreq)==0 .and. mype==0) then write(*,*) '___ICE STEP EXECUTION TIMES____________________________' From 2e4851e3deee23254b602e0b94219fb2fb71007a Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 2 Jun 2026 15:28:54 +0200 Subject: [PATCH 32/63] fix small allocation bug --- src/cvmix_driver/cvmix_idemix2.F90 | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 89c7f97fd..2a43b8d63 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -803,9 +803,11 @@ subroutine compute_vdiff_vdiss_Eiw( & real(cvmix_r8) , intent(in), dimension(nlev) :: fbot ! real(cvmix_r8) , intent(in), dimension(nlev) :: fadd --> in moment no additional forcings real(cvmix_r8) , intent(in), dimension(nlev) :: Eiw_old - !___Output_________________________________________________________________ + + !___Output__________________________________________________________________ real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_new real(cvmix_r8) , intent(out), dimension(nlev) :: Eiw_diss + real(cvmix_r8) , intent(out), optional :: Eiw_dt(nlev) real(cvmix_r8) , intent(out), optional :: Eiw_vdif(nlev) real(cvmix_r8) , intent(out), optional :: Eiw_bot(nlev) @@ -835,7 +837,6 @@ subroutine compute_vdiff_vdiss_Eiw( & d_tri = 0.0_cvmix_r8 Eiw_new = 0.0_cvmix_r8 Eiw_diss = 0.0_cvmix_r8 - Eiw_bot = 0.0_cvmix_r8 !___________________________________________________________________________ ! initialise additional forcings with zeros, there can be additional forcing terms @@ -1001,6 +1002,7 @@ subroutine compute_vdiff_vdiss_Eiw( & !___________________________________________________________________________ ! debuggin diagnostics: + ! production of Eiw from vertical diffusion if (present(Eiw_vdif)) then nz = 1 @@ -1011,7 +1013,7 @@ subroutine compute_vdiff_vdiss_Eiw( & nz = nlev Eiw_vdif(nz) = a_dif(nz)*Eiw_new(nz-1) - b_dif(nz)*Eiw_new(nz) end if - + ! total production of Eiw if (present(Eiw_dt )) Eiw_dt(:) = (Eiw_new(:) - Eiw_old(:))/dt @@ -1062,17 +1064,17 @@ subroutine compute_Eiw_waveinteract( & real(cvmix_r8) , intent(in ) :: dzw(nlev-1) ! --> layer thickness real(cvmix_r8) , intent(in ) :: dphi(nfbin) real(cvmix_r8) , intent(in ) :: dt - logical , intent(in ) :: flag_posdef + logical , intent(in ) :: flag_posdef real(cvmix_r8) , intent(in ) :: E_iw_old(nlev) real(cvmix_r8) , intent(inout) :: E_iw_new(nlev) real(cvmix_r8) , intent(in ), optional :: E_M2_old(nfbin) real(cvmix_r8) , intent(inout), optional :: E_M2_new(nfbin) - real(cvmix_r8) , intent(in ), optional :: E_M2_struct(nfbin) + real(cvmix_r8) , intent(in ), optional :: E_M2_struct(nlev) real(cvmix_r8) , intent(in ), optional :: alpha_M2_c real(cvmix_r8) , intent(in ), optional :: tau_M2 real(cvmix_r8) , intent(in ), optional :: E_niw_old(nfbin) real(cvmix_r8) , intent(inout), optional :: E_niw_new(nfbin) - real(cvmix_r8) , intent(in ), optional :: E_niw_struct(nfbin) + real(cvmix_r8) , intent(in ), optional :: E_niw_struct(nlev) real(cvmix_r8) , intent(in ), optional :: tau_niw ! optional diagnostics From 64b352d0ccb6a599612215ac45d0925e321bae5e Mon Sep 17 00:00:00 2001 From: Patrick Scholz Date: Wed, 3 Jun 2026 13:28:12 +0200 Subject: [PATCH 33/63] refactor reflect BC diagnostics and add OMP/arithmetic performance improvements Diagnostics: - Replace per-compartment iwe2_{M2,niw}_reflect_src persistent copies with iwe2_E_{M2,niw}_refl tendency arrays (m^2/s^3, consistent with Eadvh/Ediss) - Rename iwe2_bc_reflect_{bin,sgn} -> iwe2_refl_{bin,sgn}, iwe2_is_reflect_node -> iwe2_refl_node for consistency - apply_reflect_bc_spctrl now takes vol_s explicitly; refl_src pre-scaled by 1/vol_s (eliminates division in injection step); intent(out) makes zeroing explicit - Fix NIW init bug: iwe2_E_niw_dt was initialized before allocation - Fix OMP COLLAPSE(2) with outer cycle (non-conforming); drop to PARALLEL DO OMP parallelisation in calc_cvmix_idemix2: - Node param loop (cn, alpha_c, v0/c0, tau, E_struct) - iwe2_M2_w / iwe2_niw_w normalization loops - Eiw vertical diffusion loop - Wave-wave interaction loop - Kv/Av output loop Arithmetic optimisations: - Hoist 1/(1+dt*tauE) outside fbini loop in hsintegrate_Ecompart (50 div -> 1 div + 50 mul per node) - Precompute elem_area/3 once per element in scatter loop (was computed 3x) - Precompute 1/area once per node in normalization loops - Replace 180.0/pi with /rad (uses o_param parameter) Cross-spectral wrap indices (adv_Ecompart_crss_spctrl_superbee): - Add module-level iwe2_idxp1/p2/m1(nfbin), allocated and filled once in init - Eliminates 3 conditional index computations per (node,fbini) from inner loop, enabling vectorisation of the fbini loop --- .../gen_modules_cvmix_idemix2.F90 | 441 +++++++++++------- src/io_meandata.F90 | 8 +- 2 files changed, 267 insertions(+), 182 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 72a2078d5..872e41654 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -191,7 +191,8 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_M2_dt , & iwe2_E_M2_advh, iwe2_E_M2_advs , & iwe2_E_M2_diss, iwe2_E_M2_diss_wwi, & - iwe2_E_M2_forc + iwe2_E_M2_forc, & + iwe2_E_M2_refl ! --- niw related global variables --- @@ -204,7 +205,8 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_niw_dt , & iwe2_E_niw_advh, iwe2_E_niw_advs , & iwe2_E_niw_diss, & - iwe2_E_niw_forc + iwe2_E_niw_forc, & + iwe2_E_niw_refl ! --- Eiw - internal wave energy related variables --- real(kind=WP), allocatable, dimension(:,:,:):: iwe2_E_iw @@ -240,23 +242,17 @@ module g_cvmix_idemix2 ! reflective coastal BC: for each edge touching exactly one coast node, ! iwe2_bc_reflect_bin stores the mirror spectral bin (0 = edge not flagged), ! iwe2_bc_reflect_sgn = +1 if ednodes(1) is the coast node, -1 if ednodes(2) is. - integer , allocatable, dimension(:) :: iwe2_bc_reflect_bin - integer , allocatable, dimension(:) :: iwe2_bc_reflect_sgn + integer , allocatable, dimension(:) :: iwe2_refl_bin + integer , allocatable, dimension(:) :: iwe2_refl_sgn ! per-timestep scratch: blocked coast flux accumulated per (mirror bin, interior node), ! filled by apply_reflect_bc_spctrl, applied to Edivh in hsintegrate_Ecompart - real(kind=WP), allocatable, dimension(:,:) :: iwe2_reflect_src - ! persistent per-compartment copies of iwe2_reflect_src for I/O output - real(kind=WP), allocatable, dimension(:,:) :: iwe2_M2_reflect_src - real(kind=WP), allocatable, dimension(:,:) :: iwe2_niw_reflect_src + real(kind=WP), allocatable, dimension(:,:) :: iwe2_refl_src ! mask: .true. for own nodes that are interior to at least one coast edge - logical, allocatable, dimension(:) :: iwe2_is_reflect_node - ! compact list of own-node indices that have at least one coast edge; - ! used to restrict the Edivh reflect_src injection to coast-adjacent nodes only - integer, allocatable, dimension(:) :: iwe2_reflect_nodes - integer :: iwe2_n_reflect_nodes - - ! real(kind=WP), allocatable, dimension(:) :: iwe2_cn_e, iwe2_cn_gradx, iwe2_cn_grady - + logical, allocatable, dimension(:) :: iwe2_refl_node + ! pre-computed periodic wrap indices for cross-spectral superbee stencil + ! (branch-free inner loop in adv_Ecompart_crss_spctrl_superbee) + integer, allocatable, dimension(:) :: iwe2_idxp1, iwe2_idxp2, iwe2_idxm1 + ! load variables from CVMix list type(cvmix_data_type) :: CVMix_vars @@ -441,11 +437,13 @@ subroutine init_cvmix_idemix2(partit, mesh) allocate( iwe2_E_M2_advh(nfbin, myDim_nod2D) & , iwe2_E_M2_advs(nfbin, myDim_nod2D) & , iwe2_E_M2_diss(nfbin, myDim_nod2D) & - , iwe2_E_M2_forc(nfbin, myDim_nod2D) ) + , iwe2_E_M2_forc(nfbin, myDim_nod2D) & + , iwe2_E_M2_refl(nfbin, myDim_nod2D) ) iwe2_E_M2_advh(:,:) = 0.0_WP iwe2_E_M2_advs(:,:) = 0.0_WP iwe2_E_M2_diss(:,:) = 0.0_WP iwe2_E_M2_forc(:,:) = 0.0_WP + iwe2_E_M2_refl(:,:) = 0.0_WP end if if (idemix2_diag_Ecompart .or. idemix2_diag_WWI) then @@ -508,12 +506,13 @@ subroutine init_cvmix_idemix2(partit, mesh) allocate( iwe2_E_niw_advh(nfbin, myDim_nod2D) & , iwe2_E_niw_advs(nfbin, myDim_nod2D) & , iwe2_E_niw_diss(nfbin, myDim_nod2D) & - , iwe2_E_niw_forc(nfbin, myDim_nod2D) ) - iwe2_E_niw_dt( :,:) = 0.0_WP + , iwe2_E_niw_forc(nfbin, myDim_nod2D) & + , iwe2_E_niw_refl(nfbin, myDim_nod2D) ) iwe2_E_niw_advh(:,:) = 0.0_WP iwe2_E_niw_advs(:,:) = 0.0_WP iwe2_E_niw_diss(:,:) = 0.0_WP iwe2_E_niw_forc(:,:) = 0.0_WP + iwe2_E_niw_refl(:,:) = 0.0_WP end if if (idemix2_diag_Ecompart .or. idemix2_diag_WWI) then @@ -529,6 +528,16 @@ subroutine init_cvmix_idemix2(partit, mesh) end if end if + ! reflected boundary condition + allocate(iwe2_refl_bin(myDim_edge2D)) + allocate(iwe2_refl_sgn(myDim_edge2D)) + allocate(iwe2_refl_src(idemix2_nfbin, myDim_nod2D)) + allocate(iwe2_refl_node(myDim_nod2D+eDim_nod2D)) + iwe2_refl_bin(:) = 0 + iwe2_refl_sgn(:) = 0 + iwe2_refl_src(:,:)= 0.0_WP + iwe2_refl_node(:) = .false. + ! allocate 1d Spectral space coordinates allocate( iwe2_phit( nfbin) & , iwe2_phiu( nfbin) & @@ -597,14 +606,29 @@ subroutine init_cvmix_idemix2(partit, mesh) ! iwe2_phit(k) represents the edge of the k-th spectral bin iwe2_phit(1) = -iwe2_dphit(1) iwe2_phiu(1 )= iwe2_phit(1)+iwe2_dphit(1)/2.0_WP - do fbin_i=2,nfbin + do fbin_i=2,nfbin iwe2_phit(fbin_i) = iwe2_phit(fbin_i-1) + iwe2_dphit(fbin_i) iwe2_phiu(fbin_i) = iwe2_phiu(fbin_i-1) + iwe2_dphiu(fbin_i) - end do - + end do + + !_______________________________________________________________________ + ! pre-compute periodic wrap indices for cross-spectral superbee stencil + allocate(iwe2_idxp1(nfbin), iwe2_idxp2(nfbin), iwe2_idxm1(nfbin)) + do fbin_i = 1, nfbin + iwe2_idxp1(fbin_i) = fbin_i+1; if (iwe2_idxp1(fbin_i)>nfbin) iwe2_idxp1(fbin_i)=iwe2_idxp1(fbin_i)-(nfbin-2) + iwe2_idxp2(fbin_i) = fbin_i+2; if (iwe2_idxp2(fbin_i)>nfbin) iwe2_idxp2(fbin_i)=iwe2_idxp2(fbin_i)-(nfbin-2) + iwe2_idxm1(fbin_i) = fbin_i-1; if (iwe2_idxm1(fbin_i)<1 ) iwe2_idxm1(fbin_i)=nfbin-2 + end do + !_______________________________________________________________________ ! pre-compute reflective coastal BC lookup tables - call init_reflect_bc(partit, mesh) + call init_reflect_bc( iwe2_refl_bin & + , iwe2_refl_sgn & + , iwe2_refl_src & + , iwe2_refl_node & + , partit & + , mesh & + ) !_______________________________________________________________________ ! read idemix M2 forcing from cfsr data --> file @@ -965,11 +989,21 @@ end subroutine init_cvmix_idemix2 ! │ ! │ iwe2_bc_reflect_bin(edge) = kk (mirror spectral bin) ! │ iwe2_bc_reflect_sgn(edge) = +1 (coast = ednodes(1)) - subroutine init_reflect_bc(partit, mesh) + subroutine init_reflect_bc( refl_bin & + , refl_sgn & + , refl_src & + , refl_node & + , partit & + , mesh & + ) implicit none - type(t_mesh), intent(in), target :: mesh + type(t_mesh) , intent(in), target :: mesh type(t_partit), intent(in), target :: partit - + integer , intent(inout) :: refl_bin(partit%myDim_edge2D) + integer , intent(inout) :: refl_sgn(partit%myDim_edge2D) + real(kind=WP) , intent(inout) :: refl_src(idemix2_nfbin, partit%myDim_nod2D) + logical , intent(inout) :: refl_node(partit%myDim_nod2D+partit%eDim_nod2D) + integer :: edge, n1, n2, n_int, node, kk_bc, fbinj, nfbin real(kind=WP) :: lon1, lat1, lon2, lat2, lat_mean real(kind=WP) :: edge_dx, edge_dy, phi_mirror, dist, dist_min @@ -979,17 +1013,8 @@ subroutine init_reflect_bc(partit, mesh) #include "../associate_part_ass.h" #include "../associate_mesh_ass.h" nfbin = idemix2_nfbin - - allocate(iwe2_bc_reflect_bin(myDim_edge2D)) - allocate(iwe2_bc_reflect_sgn(myDim_edge2D)) - allocate(iwe2_reflect_src(idemix2_nfbin, myDim_nod2D)) - if (idemix2_diag_Ecompart) then - allocate(iwe2_M2_reflect_src (idemix2_nfbin, myDim_nod2D)) - allocate(iwe2_niw_reflect_src(idemix2_nfbin, myDim_nod2D)) - end if - allocate(is_coast_node(myDim_nod2D+eDim_nod2D)) - - ! > iwe2_bc_reflect_bin(edge) stores the MIRROR SPECTRAL BIN for a flagged + + ! > refl_bin(edge) stores the MIRROR SPECTRAL BIN for a flagged ! coast edge. 0 = edge not flagged, BC skipped. ! ! > HOW IT IS COMPUTED (init_reflect_bc) @@ -999,16 +1024,16 @@ subroutine init_reflect_bc(partit, mesh) ! edge_dy = lat_interior - lat_coast ! 2. phi_mirror = atan2(edge_dy, edge_dx) mapped to [0, 2*pi) ! 3. kk = interior bin (2..nfbin-1) with angle closest to phi_mirror - ! 4. iwe2_bc_reflect_bin(edge) = kk + ! 4. refl_bin(edge) = kk ! ! > HOW IT IS USED (apply_reflect_bc_spctrl): ! ALL toward-coast bins at this edge (any fbini where sgn*flux > 0) ! are blocked and their energy reflected into the SAME single bin kk: ! reflect_src(kk, n_int) += sgn * outflux (for all toward-coast fbini) ! One kk per edge — an approximation based on the edge-normal geometry. - iwe2_bc_reflect_bin(:) = 0 + ! refl_bin(:) = 0 - ! > iwe2_bc_reflect_sgn(edge) encodes WHICH of the two edge nodes is the coast + ! > refl_sgn(edge) encodes WHICH of the two edge nodes is the coast ! node, and from that, WHICH flux sign means "toward coast". Each edge has ! two endpoint nodes: edges(1, edge) and edges(2, edge). The sign convention ! in the FV scheme is: @@ -1033,30 +1058,27 @@ subroutine init_reflect_bc(partit, mesh) ! ! in both orientations (positive for sgn=+1 with outflux>0, ! positive for sgn=-1 with outflux<0). - iwe2_bc_reflect_sgn(:) = 0 + ! refl_sgn(:) = 0 - ! > iwe2_reflect_src is a 2D scratch array (nfbin, nod2D) used to implement + ! > refl_src is a 2D scratch array (nfbin, nod2D) used to implement ! reflective boundary conditions at coastlines for horizontal NIW energy advection. ! 1. During apply_reflect_bc_spctrl: ! For every coast-adjacent edge flagged in iwe2_bc_reflect_bin, any flux ! directed toward the coast node is zeroed out and the blocked energy is - ! accumulated into iwe2_reflect_src(kk, n_int) at the interior node (n_int), + ! accumulated into refl_src(kk, n_int) at the interior node (n_int), ! with the sign corrected so energy is conserved. ! 2. After advection in hsintegrate_Ecompart: ! The accumulated blocked flux is re-injected as a divergence source - ! Edivh += iwe2_reflect_src / vol_s, effectively bouncing the energy back + ! Edivh += refl_src / vol_s, effectively bouncing the energy back ! into the interior in bin kk (the mirror/reflected propagation direction). ! ! > In short: it is a flux-blocking + re-injection buffer that prevents NIW energy ! from leaking into land, redirecting it instead into the spectrally mirrored ! propagation direction at the last ocean node. - iwe2_reflect_src(:,:) = 0.0_WP - if (idemix2_diag_Ecompart) then - iwe2_M2_reflect_src (:,:) = 0.0_WP - iwe2_niw_reflect_src(:,:) = 0.0_WP - end if + ! refl_src(:,:) = 0.0_WP ! a node is a coast node if it belongs to at least one boundary edge + allocate(is_coast_node(myDim_nod2D+eDim_nod2D)) is_coast_node(:) = .false. do edge = 1, myDim_edge2D if (edge_tri(2, edge) == 0) then @@ -1082,12 +1104,12 @@ subroutine init_reflect_bc(partit, mesh) ! coast = n2, interior = n1: reflect direction is n2 -> n1 edge_dx = (lon1 - lon2) * cos(lat_mean) edge_dy = lat1 - lat2 - iwe2_bc_reflect_sgn(edge) = -1 ! negative flux = transport n1->n2 = INTO coast + refl_sgn(edge) = -1 ! negative flux = transport n1->n2 = INTO coast else ! coast = n1, interior = n2: reflect direction is n1 -> n2 edge_dx = (lon2 - lon1) * cos(lat_mean) edge_dy = lat2 - lat1 - iwe2_bc_reflect_sgn(edge) = +1 ! positive flux = transport n2->n1 = INTO coast + refl_sgn(edge) = +1 ! positive flux = transport n2->n1 = INTO coast end if ! mirror angle = direction away from coast, mapped to [0, 2*pi) @@ -1104,16 +1126,15 @@ subroutine init_reflect_bc(partit, mesh) kk_bc = fbinj end if end do - iwe2_bc_reflect_bin(edge) = kk_bc + refl_bin(edge) = kk_bc end do ! create logical array if node is a reflected boudnary node - allocate(iwe2_is_reflect_node(myDim_nod2D)) - iwe2_is_reflect_node(:) = .false. + refl_node(:) = .false. do edge = 1, myDim_edge2D - if (iwe2_bc_reflect_bin(edge) == 0) cycle - n_int = merge(edges(2,edge), edges(1,edge), iwe2_bc_reflect_sgn(edge) == +1) - if (n_int <= myDim_nod2D) iwe2_is_reflect_node(n_int) = .true. + if (refl_bin(edge) == 0) cycle + n_int = merge(edges(2,edge), edges(1,edge), refl_sgn(edge) == +1) + if (n_int <= myDim_nod2D) refl_node(n_int) = .true. end do deallocate(is_coast_node) @@ -1138,6 +1159,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) integer :: elnodes(3), el(2), ednodes(2) real(kind=WP) :: lat_n_deg, lat_e_deg real(kind=WP) :: cn, cn_e, cn_gradx_e, cn_grady_e, omega_niw_e + real(kind=WP) :: inv_area, area_third logical :: topo_shelf=.False. logical :: debug=.false. ! Timing variables @@ -1179,6 +1201,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !_______________________________________________________________________ ! 1. Compute IDEMIX2 parameters (cn, alpha_c, v0, c0, tau, struct functions) t0 = MPI_Wtime() +!$OMP PARALLEL DO PRIVATE(node, lat_n_deg, nln, uln, nz, cn, topo_shelf) do node=1, myDim_nod2D+eDim_nod2D !___________________________________________________________________ ! re-initialse cross spectral velocites, for later accumulation through @@ -1187,7 +1210,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) if (idemix2_enable_niw) iwe2_niw_w(:,node) = 0.0_WP !___________________________________________________________________ - lat_n_deg = geo_coord_nod2D(2,node) * 180.0/pi + lat_n_deg = geo_coord_nod2D(2,node) / rad !___________________________________________________________________ ! compute baroclinic gravity wave speed @@ -1355,6 +1378,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) end if end do ! --> do node=1, myDim_nod2D+eDim_nod2D +!$OMP END PARALLEL DO t1 = MPI_Wtime() time_params = t1 - t0 @@ -1365,7 +1389,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) nln = nlevels(elem)-1 uln = ulevels(elem) elnodes = elem2d_nodes(:,elem) - lat_e_deg = sum(geo_coord_nod2D(2,elnodes))/3.0 * 180.0/pi + lat_e_deg = sum(geo_coord_nod2D(2,elnodes)) / (3.0_WP*rad) + area_third = elem_area(elem) / 3.0_WP if (idemix2_enable_M2) w_M2_e(:) = 0.0_WP if (idemix2_enable_niw) w_niw_e(:) = 0.0_WP @@ -1439,7 +1464,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! --> here w_M2_e and w_niw_e are still on elements but for the proper ! finite volume advection implementation we need them on nodes ! do k=1,3 - iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + w_M2_e(:)*elem_area(elem)/3.0_WP + iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + w_M2_e(:)*area_third end do end if @@ -1467,7 +1492,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) end if do k=1,3 - iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*elem_area(elem)/3.0_WP + iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*area_third end do end if ! --> at the end we still need to normalize iwe2_M2_w and iwe2_niw_w @@ -1482,17 +1507,23 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) if (idemix2_enable_M2) then call exchange_elem_fbin(iwe2_M2_uv, partit) call exchange_nod_fbin(iwe2_M2_w, partit) +!$OMP PARALLEL DO PRIVATE(node, inv_area) do node=1, myDim_nod2D+eDim_nod2D - iwe2_M2_w( :, node) = iwe2_M2_w(:, node)/area(1, node) + inv_area = 1.0_WP / area(1, node) + iwe2_M2_w(:, node) = iwe2_M2_w(:, node) * inv_area end do +!$OMP END PARALLEL DO end if - - if (idemix2_enable_niw) then + + if (idemix2_enable_niw) then call exchange_elem_fbin(iwe2_niw_uv, partit) call exchange_nod_fbin(iwe2_niw_w, partit) +!$OMP PARALLEL DO PRIVATE(node, inv_area) do node=1, myDim_nod2D+eDim_nod2D - iwe2_niw_w( :, node) = iwe2_niw_w(:, node)/area(1, node) - end do + inv_area = 1.0_WP / area(1, node) + iwe2_niw_w(:, node) = iwe2_niw_w(:, node) * inv_area + end do +!$OMP END PARALLEL DO end if @@ -1519,6 +1550,10 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , iwe2_gradxy_n & , iwe2_flx_uv & , iwe2_flx_w & + , iwe2_refl_bin & + , iwe2_refl_sgn & + , iwe2_refl_src & + , iwe2_refl_node & , vol_nodB2T & , partit & , mesh & @@ -1528,6 +1563,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , iwe2_E_M2_advs & ! optional: diagnostic , iwe2_E_M2_diss & ! optional: diagnostic , iwe2_E_M2_forc & ! optional: diagnostic + , iwe2_E_M2_refl & ! optional: diagnostic ) else call hsintegrate_Ecompart( & @@ -1545,6 +1581,10 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , iwe2_gradxy_n & , iwe2_flx_uv & , iwe2_flx_w & + , iwe2_refl_bin & + , iwe2_refl_sgn & + , iwe2_refl_src & + , iwe2_refl_node & , vol_nodB2T & , partit & , mesh & @@ -1563,7 +1603,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! create complete Ecomaprt diagnostic if (idemix2_diag_Ecompart) then call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & + iwe2_taum1, iwe2_tau, iwe2_taup1 & , 'NIW' & , iwe2_E_niw & , iwe2_E_niw_divh & @@ -1577,6 +1617,10 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , iwe2_gradxy_n & , iwe2_flx_uv & , iwe2_flx_w & + , iwe2_refl_bin & + , iwe2_refl_sgn & + , iwe2_refl_src & + , iwe2_refl_node & , vol_nodB2T & , partit & , mesh & @@ -1586,10 +1630,11 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , iwe2_E_niw_advs & ! optional: diagnostic , iwe2_E_niw_diss & ! optional: diagnostic , iwe2_E_niw_forc & ! optional: diagnostic + , iwe2_E_niw_refl & ! optional: diagnostic ) else - call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & , 'NIW' & , iwe2_E_niw & , iwe2_E_niw_divh & @@ -1603,6 +1648,10 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , iwe2_gradxy_n & , iwe2_flx_uv & , iwe2_flx_w & + , iwe2_refl_bin & + , iwe2_refl_sgn & + , iwe2_refl_src & + , iwe2_refl_node & , vol_nodB2T & , partit & , mesh & @@ -1618,11 +1667,12 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !_______________________________________________________________________ ! 4. Integrate IDEMIX equation vertical, solve vertical diffusion and - t6 = MPI_Wtime() + t6 = MPI_Wtime() ! dissipation part implicitly - ! Eiw^(t+1) = Eiw^(t) + dt*[ d/dz( c_0 * tau_v * d/dz(c_0*E_iw))^(t+1) + ! Eiw^(t+1) = Eiw^(t) + dt*[ d/dz( c_0 * tau_v * d/dz(c_0*E_iw))^(t+1) ! - alpha_c*Eiw^(t+1) ! + Forc^(t) ] +!$OMP PARALLEL DO PRIVATE(node, uln, nln) do node = 1, myDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) @@ -1658,6 +1708,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) end if end do ! --> do node = 1, myDim_nod2D +!$OMP END PARALLEL DO t7 = MPI_Wtime() time_Eiw_vdiff = t7 - t6 @@ -1733,7 +1784,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !_______________________________________________________________________ ! 7. compute wave-wave interaction t8 = MPI_Wtime() - if (idemix2_enable_M2 .or. idemix2_enable_niw) then + if (idemix2_enable_M2 .or. idemix2_enable_niw) then +!$OMP PARALLEL DO PRIVATE(node, uln, nln) do node = 1, myDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) @@ -1860,6 +1912,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) end if end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then end do ! --> for node = 1, myDim_nod2D +!$OMP END PARALLEL DO end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then t9 = MPI_Wtime() time_waveint = t9 - t8 @@ -1872,6 +1925,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !___________________________________________________________________ ! write out diffusivity --> convert from elem to vertices +!$OMP PARALLEL DO PRIVATE(node, uln, nln) do node=1, myDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) @@ -1884,7 +1938,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , KappaH = Kv( uln:nln, node) & , KappaM = iwe2_Av( uln:nln, node) & ) - end do + end do +!$OMP END PARALLEL DO call exchange_nod(iwe2_Av, partit) call exchange_nod(Kv , partit) @@ -1933,15 +1988,15 @@ end subroutine calc_cvmix_idemix2 ! !___________________________________________________________________________ ! horizontal superbee advection of spectral bins - subroutine adv_Ecompart_hor_spctrl_superbee( & - vel , & - ttf , & - ttf_grad_n , & - flux , & - partit , & - mesh , & - flag_2ndord_time , & - flag_posdef & + subroutine adv_Ecompart_hor_spctrl_superbee(& + vel & + , ttf & + , ttf_grad_n & + , flux & + , partit & + , mesh & + , flag_2ndord_time & + , flag_posdef & ) implicit none @@ -2265,24 +2320,33 @@ end subroutine adv_Ecompart_hor_spctrl_superbee ! fbini --> energy blocked at coast, stays at n_int ! kk <-- same energy re-injected at n_int in mirror direction ! - subroutine apply_reflect_bc_spctrl(flux, partit, mesh) + subroutine apply_reflect_bc_spctrl( flux & + , refl_src & + , refl_bin & + , refl_sgn & + , vol_s & + , partit & + , mesh) implicit none + !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit), intent(inout), target :: partit type(t_mesh) , intent(in ), target :: mesh real(kind=WP) , intent(inout) :: flux(idemix2_nfbin, partit%myDim_edge2D) - + integer , intent(in ) :: refl_bin( partit%myDim_edge2D ) + integer , intent(in ) :: refl_sgn( partit%myDim_edge2D ) + real(kind=WP) , intent(out ) :: refl_src(idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(in ) :: vol_s(partit%myDim_nod2D+partit%eDim_nod2D) + !___LOCAL VARIABLES_____________________________________________________ integer :: edge, fbini, kk, nfbin, sgn, n_int - real(kind=WP) :: outflux + real(kind=WP) :: outflux, ivols_int #include "../associate_part_def.h" -#include "../associate_mesh_def.h"1 +#include "../associate_mesh_def.h" #include "../associate_part_ass.h" #include "../associate_mesh_ass.h" nfbin = idemix2_nfbin - ! Reset scratch; will be divided by vol_s and added to Edivh in - ! hsintegrate_Ecompart after adv_Ecompart_flx2tra_spctrl. - iwe2_reflect_src(:,:) = 0.0_WP + refl_src(:,:) = 0.0_WP ! Zero every coast-directed flux so no energy reaches the coast node. ! For each blocked flux in bin fbini, accumulate two terms into reflect_src: @@ -2292,7 +2356,7 @@ subroutine apply_reflect_bc_spctrl(flux, partit, mesh) ! Applied to Edivh after adv_Ecompart_flx2tra_spctrl in hsintegrate_Ecompart. !$OMP PARALLEL DO PRIVATE(edge, fbini, kk, sgn, n_int, outflux) do edge = 1, myDim_edge2D - kk = iwe2_bc_reflect_bin(edge) + kk = refl_bin(edge) ! edge is not connected to coast if (kk == 0) cycle @@ -2300,23 +2364,24 @@ subroutine apply_reflect_bc_spctrl(flux, partit, mesh) ! interior = edges(2, edge) ! sgn = -1 --> coast node = edges(2, edge) ! interior = edges(1, edge) - sgn = iwe2_bc_reflect_sgn(edge) + sgn = refl_sgn(edge) ! which one is interior coastal edge node n_int = merge(edges(2, edge), edges(1, edge), sgn == +1) + ! local scaler volume + ivols_int = 1/vol_s(n_int) + do fbini = 2, nfbin-1 - outflux = flux(fbini, edge) + outflux = flux(fbini, edge)*ivols_int if (sgn * outflux > 0.0_WP) then ! block flux towards coast by setting to zero flux(fbini, edge) = 0.0_WP if (n_int <= myDim_nod2D) then !$OMP ATOMIC - ! put energy in edge mirror spectral bin - iwe2_reflect_src(kk, n_int) = iwe2_reflect_src(kk, n_int) + sgn * outflux + refl_src(kk, n_int) = refl_src(kk, n_int) + sgn * outflux !$OMP ATOMIC - ! take energy from actual spectral bin - iwe2_reflect_src(fbini, n_int) = iwe2_reflect_src(fbini, n_int) - sgn * outflux + refl_src(fbini, n_int) = refl_src(fbini, n_int) - sgn * outflux end if end if end do ! --> do fbini = 2, nfbin-1 @@ -2332,15 +2397,15 @@ end subroutine apply_reflect_bc_spctrl !___________________________________________________________________________ ! cross spectral superbee advection across spectral bins subroutine adv_Ecompart_crss_spctrl_superbee( & - cs , & ! cross-spectral exchange rate - ttf , & ! Energy compartment @ node - dphi , & ! width spectral bin - flux , & ! cross-spectral flux - partit , & - mesh , & - flag_2ndord_time , & - flag_posdef & - ! flag_wlimitcfl & + cs & ! cross-spectral exchange rate + , ttf & ! Energy compartment @ node + , dphi & ! width spectral bin + , flux & ! cross-spectral flux + , partit & + , mesh & + , flag_2ndord_time & + , flag_posdef & + ! flag_wlimitcfl & ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ @@ -2355,7 +2420,7 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & ! logical , intent(in) :: flag_wlimitcfl !___LOCAL VARIABLES_____________________________________________________ - integer :: node, fbini, nfbin, idxp1, idxp2, idxm1 + integer :: node, fbini, nfbin real(kind=WP) :: R, ttf0, ttfp1, dttf0p1, Tmean1, Tmean2, Cr, vflux, vfabs real(kind=WP) :: CFL !, cflmax=0.50_WP #include "../associate_part_def.h" @@ -2368,7 +2433,7 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & !_______________________________________________________________________ #ifndef ENABLE_OPENACC -!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, fbini, idxp1, idxp2, idxm1, & +!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, fbini, & !$OMP ttf0, ttfp1, dttf0p1, R, Cr, Tmean1, Tmean2, & !$OMP CFL, vflux, vfabs) !$OMP DO @@ -2386,60 +2451,50 @@ subroutine adv_Ecompart_crss_spctrl_superbee( & ! Compute flux at all interfaces (1 to nfbin-1) ! Bins 1 and nfbin are boundary bins (should have zero energy) do fbini = 1, nfbin - !_______________________________________________________________ - ! Periodic wrapping for gradient stencil - idxp1 = fbini+1 ; if (idxp1>nfbin) idxp1=idxp1-(nfbin-2) - idxp2 = fbini+2 ; if (idxp2>nfbin) idxp2=idxp2-(nfbin-2) - idxm1 = fbini-1 ; if (idxm1<1 ) idxm1=nfbin-2 - - ! ! limit W cross spectral exchange rate to the CFL limit - ! cs(fbini, node) = merge( min(abs(cs(fbini, node)), cflmax*dphi(fbini)/dt)*sign(1.0_WP, cs(fbini, node)) & - ! , cs(fbini, node) & - ! , flag_wlimitcfl & - ! ) - + ! wrap indices pre-computed in init (branch-free, module arrays) + CFL = abs(cs(fbini, node)) * dt / dphi(fbini) - + !_______________________________________________________________ - ! compute tracer difference - ttf0 = ttf(fbini , node) - ttfp1 = ttf(idxp1 , node) + ! compute tracer difference + ttf0 = ttf(fbini , node) + ttfp1 = ttf(iwe2_idxp1(fbini) , node) dttf0p1 = ttfp1 - ttf0 - + !_______________________________________________________________ ! tracer Slope Ratio Calculation for upwind point - ! compute tracer slope - R = (ttfp1-ttf(idxp2,node))/(-dttf0p1+small) - + ! compute tracer slope + R = (ttfp1-ttf(iwe2_idxp2(fbini),node))/(-dttf0p1+small) + ! apply superbee limiter - Cr = slimiter_superbee(R) - + Cr = slimiter_superbee(R) + ! construct edge centered tracer value ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * dz/2 - ! --> this is seconds order in space, but first order in time - ! + ! --> this is seconds order in space, but first order in time + ! ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) ! T_(i+0.5) = T_i+1 - [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) ! --> CFL = W*dt/dx Tmean2 = ttfp1 + 0.5_WP*Cr*(-dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) Tmean2 = merge(max(0.0_WP, Tmean2), Tmean2, flag_posdef) - + !_______________________________________________________________ ! tracer Slope Ratio Calculation for downwind point - ! compute tracer slope - R = (ttf0-ttf(idxm1,node))/(dttf0p1+small) - + ! compute tracer slope + R = (ttf0-ttf(iwe2_idxm1(fbini),node))/(dttf0p1+small) + ! apply superbee limiter - Cr = slimiter_superbee(R) - + Cr = slimiter_superbee(R) + ! construct edge centered tracer value ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * dz/2 - ! --> this is seconds order in space, but first order in time - ! + ! --> this is seconds order in space, but first order in time + ! ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * (dz/2 -|W|*dt/2) ! T_(i+0.5) = T_i + [ (T_i+1 - T_i)/dz ]_Limited * dz/2 *(1 - CFL) ! --> CFL = W*dt/dx - Tmean1 = ttf0 + 0.5_WP*Cr*(dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) + Tmean1 = ttf0 + 0.5_WP*Cr*(dttf0p1) * (1.0_WP-merge(CFL, 0.0_WP, flag_2ndord_time)) Tmean1 = merge(max(0.0_WP, Tmean1), Tmean1, flag_posdef) !_______________________________________________________________ @@ -2491,6 +2546,8 @@ end function slimiter_superbee subroutine adv_Ecompart_flx2tra_spctrl( & flx_h , & flx_v , & + refl_src , & + refl_node , & div_h , & div_v , & dphit , & @@ -2502,15 +2559,18 @@ subroutine adv_Ecompart_flx2tra_spctrl( & !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit), intent(inout), target :: partit type(t_mesh) , intent(in ), target :: mesh - real(kind=WP) , intent(in) :: flx_h( idemix2_nfbin, partit%myDim_edge2D) - real(kind=WP) , intent(in) :: flx_v( idemix2_nfbin, partit%myDim_nod2D) - real(kind=WP) , intent(inout) :: div_h( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: div_v( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) + real(kind=WP) , intent(in) :: flx_h( idemix2_nfbin, partit%myDim_edge2D) + real(kind=WP) , intent(in) :: flx_v( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout) :: refl_src(idemix2_nfbin, partit%myDim_nod2D ) + logical , intent(in) :: refl_node( partit%myDim_nod2D+partit%eDim_nod2D ) + + real(kind=WP) , intent(inout) :: div_h( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: div_v( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) real(kind=WP) , intent(in ) :: vol_s(partit%myDim_nod2D+partit%eDim_nod2D) !___LOCAL VARIABLES_____________________________________________________ integer :: node, edge, fbini, nfbin, ednodes(2) - real(kind=WP) :: inv_dphi(idemix2_nfbin) + real(kind=WP) :: inv_dphi(idemix2_nfbin), ivols_lcl #include "../associate_part_def.h" #include "../associate_mesh_def.h" @@ -2650,16 +2710,36 @@ subroutine adv_Ecompart_flx2tra_spctrl( & !$ACC UPDATE DEVICE(dttf_h) # endif #endif - + !_______________________________________________________________________ ! normalize with total volume of scalar cell from top to bottom #ifndef ENABLE_OPENACC !$OMP PARALLEL DO COLLAPSE(2) #else !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) #endif - do node=1, myDim_nod2d+eDim_nod2D + do node=1, myDim_nod2d! +eDim_nod2D + ivols_lcl = 1/vol_s(node) do fbini=2,nfbin-1 - div_h(fbini, node) = div_h(fbini,node)/vol_s(node) + div_h(fbini, node) = div_h(fbini,node)*ivols_lcl + end do + end do +#ifndef ENABLE_OPENACC + !$OMP END PARALLEL DO +#else + !$ACC END PARALLEL LOOP +#endif + + !_______________________________________________________________________ + ! inject blocked coast fluxes as source at interior nodes in mirror bin +#ifndef ENABLE_OPENACC + !$OMP PARALLEL DO +#else + !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) +#endif + do node = 1, myDim_nod2D + if (.not. refl_node(node)) cycle + do fbini = 2, nfbin-1 + div_h(fbini, node) = div_h(fbini, node) + refl_src(fbini, node) end do end do #ifndef ENABLE_OPENACC @@ -2691,6 +2771,10 @@ subroutine hsintegrate_Ecompart( & , gradxy_n & , flx_uv & , flx_cs & + , refl_bin & + , refl_sgn & + , refl_src & + , refl_node & , vol_s & , partit & , mesh & @@ -2700,6 +2784,7 @@ subroutine hsintegrate_Ecompart( & , Eadvs & , Ediss & , Eforc & + , Erefl & ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ @@ -2718,7 +2803,11 @@ subroutine hsintegrate_Ecompart( & real(kind=WP) , intent(inout) :: gradxy_n(2, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: dphit( idemix2_nfbin) real(kind=WP) , intent(inout) :: flx_uv( idemix2_nfbin, partit%myDim_edge2D) - real(kind=WP) , intent(inout) :: flx_cs( idemix2_nfbin, partit%myDim_nod2D ) + real(kind=WP) , intent(inout) :: flx_cs( idemix2_nfbin, partit%myDim_nod2D ) + integer , intent(in ) :: refl_bin( partit%myDim_edge2D ) + integer , intent(in ) :: refl_sgn( partit%myDim_edge2D ) + real(kind=WP) , intent(inout) :: refl_src( idemix2_nfbin, partit%myDim_nod2D ) + logical , intent(in ) :: refl_node( partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: vol_s( partit%myDim_nod2D +partit%eDim_nod2D) logical , intent(in) :: flag_AB2 @@ -2727,9 +2816,11 @@ subroutine hsintegrate_Ecompart( & real(kind=WP) , intent(inout), optional:: Eadvs( idemix2_nfbin, partit%myDim_nod2D) real(kind=WP) , intent(inout), optional:: Ediss( idemix2_nfbin, partit%myDim_nod2D) real(kind=WP) , intent(inout), optional:: Eforc( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(inout), optional:: Erefl( idemix2_nfbin, partit%myDim_nod2D) !___LOCAL VARIABLES_____________________________________________________ integer :: node, fbini, nfbin + real(kind=WP) :: inv_denom #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" @@ -2764,15 +2855,15 @@ subroutine hsintegrate_Ecompart( & ) ! apply reflective coastal BC: redirect coast-directed fluxes into mirror bins - call apply_reflect_bc_spctrl(flx_uv, partit, mesh) - if (idemix2_diag_Ecompart) then - if (Ename == 'M2') then - iwe2_M2_reflect_src (:,:) = iwe2_reflect_src(:,:) - else - iwe2_niw_reflect_src(:,:) = iwe2_reflect_src(:,:) - end if - end if - + call apply_reflect_bc_spctrl( flx_uv & + , refl_src & + , refl_bin & + , refl_sgn & + , vol_s & + , partit & + , mesh & + ) + !_______________________________________________________________________ ! compute cross spectral superbee advected tracer flux call adv_Ecompart_crss_spctrl_superbee( & @@ -2791,6 +2882,8 @@ subroutine hsintegrate_Ecompart( & call adv_Ecompart_flx2tra_spctrl( & flx_uv & ,flx_cs & + ,refl_src & + ,refl_node & ,Edivh(ti,:,:) & ,Edivs(ti,:,:) & ,dphit & @@ -2799,18 +2892,6 @@ subroutine hsintegrate_Ecompart( & ,mesh & ) - !_______________________________________________________________________ - ! inject blocked coast fluxes as source at interior nodes in mirror bin -!$OMP PARALLEL DO PRIVATE(node, fbini) - do node = 1, myDim_nod2D - if (.not. iwe2_is_reflect_node(node)) cycle - do fbini = 2, nfbin-1 - Edivh(ti, fbini, node) = Edivh(ti, fbini, node) & - + iwe2_reflect_src(fbini, node) / vol_s(node) - end do - end do -!$OMP END PARALLEL DO - !_______________________________________________________________________ ! Eden and Olbers 2014, eq. 2 ! integrate E_M2^(n+1) = E_M2^(n) + dt*[ @@ -2828,8 +2909,9 @@ subroutine hsintegrate_Ecompart( & !_______________________________________________________________________ ! Adams-Bashforth 2nd order + implicit dissipation - if (flag_AB2) then + if (flag_AB2) then do node= 1, myDim_nod2d + inv_denom = 1.0_WP / (1.0_WP + dt*tauE(node)) do fbini=2,nfbin-1 E(tip1, fbini, node) = ( E(ti, fbini, node) & + dt * ( & @@ -2839,15 +2921,16 @@ subroutine hsintegrate_Ecompart( & - (0.5_WP+idemix2_AB_epsilon)*Edivs(tim1, fbini, node) & + forc( fbini, node) & ) & - ) / (1.0_WP + dt*tauE(node)) + ) * inv_denom end do E(tip1, 1, node) = E(tip1, nfbin-1, node) E(tip1, nfbin, node) = E(tip1, 2, node) - end do + end do !_______________________________________________________________________ ! Forward Euler + implicit dissipation else do node= 1, myDim_nod2d + inv_denom = 1.0_WP / (1.0_WP + dt*tauE(node)) do fbini=2,nfbin-1 E(tip1, fbini, node) = ( E(ti, fbini, node) & + dt * ( & @@ -2855,7 +2938,7 @@ subroutine hsintegrate_Ecompart( & + Edivs(ti, fbini, node) & ! d/dphi (w*E^n) + forc( fbini, node) & ! forc ) & - ) / (1.0_WP + dt*tauE(node)) + ) * inv_denom end do E(tip1, 1, node) = E(tip1, nfbin-1, node) E(tip1, nfbin, node) = E(tip1, 2, node) @@ -2891,6 +2974,8 @@ subroutine hsintegrate_Ecompart( & end if if (present(Eforc)) Eforc(:,:) = forc(:, 1:myDim_nod2D) + + if (present(Erefl)) Erefl(:,:) = refl_src(:, 1:myDim_nod2D) end subroutine hsintegrate_Ecompart @@ -2977,18 +3062,18 @@ subroutine compute_vol_nodB2T_fix(vol_nodB2T, mesh, partit) real(kind=WP) , intent(inout) :: vol_nodB2T(partit%myDim_nod2D+partit%eDim_nod2D) !___LOCAL VARIABLES_____________________________________________________ integer :: node, elem, nz, nln, uln, elnodes(3) - real(kind=WP) :: lcl_sumvol, glb_sumvol, vol +! real(kind=WP) :: lcl_sumvol, glb_sumvol, vol #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" #include "../associate_mesh_ass.h" vol_nodB2T = 0.0_WP - lcl_sumvol = 0.0_WP +! lcl_sumvol = 0.0_WP do node = 1, myDim_nod2D nln = nlevels_nod2D(node)-1 uln = ulevels_nod2D(node) do nz=uln,nln - lcl_sumvol = lcl_sumvol + areasvol(nz,node)*abs(zbar(nz)-zbar(nz+1)) +! lcl_sumvol = lcl_sumvol + areasvol(nz,node)*abs(zbar(nz)-zbar(nz+1)) vol_nodB2T(node) = vol_nodB2T(node) + areasvol(nz,node)*abs(zbar(nz)-zbar(nz+1)) end do end do !-->do node = 1,node_size diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index aad01e656..d9fb3f536 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1348,8 +1348,8 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Em2_strct' , 'EM2 structure function energy' , 'm^2/s^2' , iwe2_E_M2_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) ! optional diagnostic if (idemix2_diag_Ecompart) then - if (allocated(iwe2_M2_reflect_src )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_reflsrc' , 'M2 coast-reflect. accumulated flux' , 'm^4/s^3' , iwe2_M2_reflect_src(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_M2_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_dt' , 'EM2 total tendency' , 'm^2/s^3' , iwe2_E_M2_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_refl )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_refl' , 'EM2 coast-reflect. accumulated flux', 'm^2/s^3' , iwe2_E_M2_refl(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_dt' , 'EM2 total tendency' , 'm^2/s^3' , iwe2_E_M2_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_M2_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advh' , 'EM2 horizontal advection' , 'm^2/s^3' , iwe2_E_M2_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_M2_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advs' , 'EM2 spectral advection' , 'm^2/s^3' , iwe2_E_M2_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_M2_diss )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_diss' , 'EM2 dissipation' , 'm^2/s^3' , iwe2_E_M2_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1375,8 +1375,8 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eniw_strct' , 'Eniw structure function energy' , 'm^2/s^2' , iwe2_E_niw_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) ! optional diagnostic if (idemix2_diag_Ecompart) then - if (allocated(iwe2_niw_reflect_src)) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_reflsrc', 'niw coast-reflect. accumulated flux', 'm^4/s^3' , iwe2_niw_reflect_src(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - if (allocated(iwe2_E_niw_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_dt' , 'Eniw total tendency' , 'm^2/s^3' , iwe2_E_niw_dt(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_refl )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_refl' , 'Eniw coast-reflect. accumulated flux', 'm^2/s^3', iwe2_E_niw_refl(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_dt' , 'Eniw total tendency' , 'm^2/s^3' , iwe2_E_niw_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_niw_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advh' , 'Eniw horizontal advection' , 'm^2/s^3' , iwe2_E_niw_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_niw_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advs' , 'Eniw spectral advection' , 'm^2/s^3' , iwe2_E_niw_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_niw_diss )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_diss' , 'Eniw dissipation' , 'm^2/s^3' , iwe2_E_niw_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) From c5530a6b34f694e69cf28bca7a8e5227491a4507 Mon Sep 17 00:00:00 2001 From: Patrick Scholz Date: Wed, 3 Jun 2026 15:40:20 +0200 Subject: [PATCH 34/63] fix superbee limiter and flag_2ndord_time inversion in adv_tra_hor_spbee MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit oce_adv_tra_hor.F90: - spbee_limiter was implementing the MC (Monotonized Central) limiter min(2r, (1+r)/2, 2) instead of the correct superbee max(min(2r,1), min(r,2)); fixed to true superbee — less numerical diffusion, sharper fronts - flag_2ndord_time assignment was inverted: num_ord==1 was enabling the second-order time (CFL) correction instead of disabling it; fixed gen_modules_cvmix_idemix2.F90: - precompute dt/edlen as dt_over_edlen once per edge outside fbini loop, avoiding a division inside the inner spectral bin loop --- src/cvmix_driver/gen_modules_cvmix_idemix2.F90 | 8 ++++---- src/oce_adv_tra_hor.F90 | 10 ++++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 872e41654..7f14c0378 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -2011,7 +2011,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee(& logical , intent(in) :: flag_posdef !___LOCAL VARIABLES_____________________________________________________ - real(kind=WP) :: dx1, dy1, dx2, dy2, dxdy12(2), edlen, n_x, n_y, n_len + real(kind=WP) :: dx1, dy1, dx2, dy2, dxdy12(2), dt_over_edlen, n_x, n_y, n_len real(kind=WP) :: u1, u2, v1, v2, Ue, CFL, dh1, dh2 real(kind=WP) :: R, ttfp2, ttfm1, ttf0, ttfp1, dttf0p1, Tmean1, Tmean2, Cr, vflux, vfabs integer :: el(2), el2, ednodes(2), edge, fbini, nfbin, nln, uln, nz @@ -2027,7 +2027,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee(& ! this advection does !!! NOT !!! go over the vertical dimension it goes ! over the domain of the spectral bins !$OMP PARALLEL DEFAULT(SHARED) PRIVATE(edge, ednodes, el, el2, fbini, nln, & -!$OMP dx1, dy1, dx2, dy2, dxdy12, dh1, dh2, n_x, n_y, n_len, edlen, & +!$OMP dx1, dy1, dx2, dy2, dxdy12, dh1, dh2, n_x, n_y, n_len, dt_over_edlen, & !$OMP u1, v1, u2, v2, Ue, CFL, vflux, vfabs, & !$OMP ttf0, ttfp1, dttf0p1, ttfp2, ttfm1, R, Cr, Tmean1, Tmean2) !$OMP DO @@ -2108,7 +2108,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee(& n_x = dy1 n_y = -dx1 end if - edlen = sqrt(dxdy12(1)**2 + dxdy12(2)**2) + dt_over_edlen = dt/sqrt(dxdy12(1)**2 + dxdy12(2)**2) ! Normalize normal vector to unit length for CFL calculation n_len = sqrt(n_x**2 + n_y**2) @@ -2133,7 +2133,7 @@ subroutine adv_Ecompart_hor_spctrl_superbee(& ! mean velocity --> need to add component to make second order ! in time Ue = sqrt((0.5_WP*( u1 + u2 )*n_x)**2 + (0.5_WP*( v1 + v2 )*n_y)**2) - CFL = min(1.0_WP, Ue*dt/edlen) + CFL = min(1.0_WP, Ue*dt_over_edlen) !_______________________________________________________________ ! compute tracer difference allong edge diff --git a/src/oce_adv_tra_hor.F90 b/src/oce_adv_tra_hor.F90 index 730fbb11a..2c72fac68 100644 --- a/src/oce_adv_tra_hor.F90 +++ b/src/oce_adv_tra_hor.F90 @@ -857,6 +857,8 @@ end subroutine adv_tra_hor_mfct !_______________________________________________________________________________ ! horizontal advection second order in space (2nd oprder in time) using superbee ! slope limiter +! !!! ATTENTION !!! +! This part is sofar untested it is left here for later pickup subroutine adv_tra_hor_spbee( & vel , & ttf , & @@ -900,10 +902,10 @@ subroutine adv_tra_hor_spbee( & !___________________________________________________________________________ if (num_ord == 1.0_WP) then - flag_2ndord_time = .True. - else flag_2ndord_time = .False. - end if + else + flag_2ndord_time = .True. + end if !___________________________________________________________________________ l_init_zero=.true. @@ -1129,7 +1131,7 @@ subroutine adv_tra_hor_spbee( & ! superbee slope limiter pure elemental real(kind=WP) function spbee_limiter(R) result(Cr) real(kind=WP), intent(in) :: R - Cr = max(0._WP, min( min(2._WP*R, 0.5_WP+R/2._WP), 2._WP )) + Cr = max(0._WP, max( min(2._WP*R, 1._WP), min(R, 2._WP) )) end function spbee_limiter ! From cca458ed78739819f84927bd760e7997a816b3ac Mon Sep 17 00:00:00 2001 From: Jan Streffing Date: Wed, 3 Jun 2026 21:23:40 +0200 Subject: [PATCH 35/63] fix iceberg netcdf time units and empty attrs Co-Authored-By: Claude Opus 4.8 --- src/icb_step.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/icb_step.F90 b/src/icb_step.F90 index a973cc91a..4881dc090 100644 --- a/src/icb_step.F90 +++ b/src/icb_step.F90 @@ -1589,7 +1589,7 @@ subroutine init_buoy_output(partit) implicit none #include "netcdf.inc" - integer :: status,ncid,year_start,month_start,day_start + integer :: status,ncid integer :: dimid_ib, dimid_rec, dimids(2) integer :: time_varid, iter_varid integer :: lonrad_id, latrad_id, londeg_id, latdeg_id @@ -1693,7 +1693,7 @@ subroutine init_buoy_output(partit) longname='time' ! use NetCDF Climate and Forecast (CF) Metadata Convention status = nf_PUT_ATT_TEXT(ncid, time_varid, 'long_name', len_trim(longname), trim(longname)) if (status .ne. nf_noerr) call handle_err(status, partit) - write(att_text, '(a14,I4.4,a1,I2.2,a1,I2.2,a6)') 'seconds since ', year_start, '-', month_start, '-', day_start, ' 00:00:00' + write(att_text, '(a14,I4.4,a1,I2.2,a1,I2.2,a9)') 'seconds since ', yearstart, '-', 1, '-', 1, ' 00:00:00' status = nf_PUT_ATT_TEXT(ncid, time_varid, 'units', len_trim(att_text), trim(att_text)) if (status .ne. nf_noerr) call handle_err(status, partit) if (include_fleapyear) then @@ -1890,7 +1890,7 @@ subroutine init_buoy_output(partit) longname='fesom element' status = nf_PUT_ATT_TEXT(ncid, felem_id, 'long_name', len_trim(longname), trim(longname)) if (status .ne. nf_noerr) call handle_err(status, partit) - status = nf_put_att_text(ncid, felem_id, 'units', 18, '') + status = nf_put_att_text(ncid, felem_id, 'units', 0, '') if (status .ne. nf_noerr) call handle_err(status, partit) description='' status = nf_put_att_text(ncid, felem_id, 'description', len_trim(description), trim(description)) @@ -1901,7 +1901,7 @@ subroutine init_buoy_output(partit) longname='grounded' status = nf_PUT_ATT_TEXT(ncid, grounded_id, 'long_name', len_trim(longname), trim(longname)) if (status .ne. nf_noerr) call handle_err(status, partit) - status = nf_put_att_text(ncid, grounded_id, 'units', 18, '') + status = nf_put_att_text(ncid, grounded_id, 'units', 0, '') if (status .ne. nf_noerr) call handle_err(status, partit) description='' status = nf_put_att_text(ncid, grounded_id, 'description', len_trim(description), trim(description)) From d74f24cd9f97569005422c9df94f89e171285107 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 4 Jun 2026 09:37:43 +0200 Subject: [PATCH 36/63] switch off global energy checker --- src/cvmix_driver/gen_modules_cvmix_idemix2.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 7f14c0378..96e6b2a90 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -1592,7 +1592,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) end if ! Compute global total NIW energy for conservation check - call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') + ! call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'M2') end if t4 = MPI_Wtime() @@ -1659,7 +1659,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) end if ! Compute global total NIW energy for conservation check - call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') + ! call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'niw') end if t5 = MPI_Wtime() From 89b019c230d94acb7af1442b08efdfbe62b80db5 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 4 Jun 2026 12:31:27 +0200 Subject: [PATCH 37/63] fix some ci-test problems --- src/fesom_module.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fesom_module.F90 b/src/fesom_module.F90 index 39e0d465b..28ea49256 100755 --- a/src/fesom_module.F90 +++ b/src/fesom_module.F90 @@ -360,7 +360,7 @@ subroutine fesom_init(fesom_total_nsteps) f%partit%eDim_nod2D, f%partit%mype, f%partit%MPI_COMM_FESOM, & f%partit%myDim_elem2D, f%partit%eDim_elem2D, tracers_info, & f%tracers%num_tracers, rad) ! adjust values for recom tracers (derived type "t_tracer") - f%partit, f%mesh) ! adjust values for recom tracers (derived type "t_tracer") + f%t_recom_e=MPI_Wtime() deallocate(tracers_info%ids) deallocate(tracers_info%data_pointers) @@ -819,7 +819,7 @@ subroutine fesom_runloop(current_nsteps) f%partit%com_nod2D%sPE, f%partit%com_nod2D%rPE, & f%partit%com_nod2D%req, f%partit%com_nod2D%nreq, & dt, daynew, month, mstep, ndpyr, yearold, timenew, rad, kappa, & - press_air, u_wind, f%tracers, f%partit, f%mesh) + press_air, u_wind, v_wind, shortwave) f%t_recom_e = MPI_Wtime() deallocate(tracers_info%ids) From 7c7a4234fb0bcd6f0fd3fba5256c2751dc7cb91d Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 4 Jun 2026 12:46:48 +0200 Subject: [PATCH 38/63] fix some ci-test problems --- src/oce_tracer_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/oce_tracer_mod.F90 b/src/oce_tracer_mod.F90 index 7646bff1b..bb04dda44 100755 --- a/src/oce_tracer_mod.F90 +++ b/src/oce_tracer_mod.F90 @@ -200,14 +200,14 @@ SUBROUTINE tracer_gradient_elements(ttf, ttf_grad, partit, mesh, do_overz_in) ! !___________________________________________________________________________ - else ! (do_overz==.False.) + else ! (do_overz==.False.) + nzmin = 1 + nzmax = size(ttf, 1) #ifndef ENABLE_OPENACC -!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(elem, elnodes, nz, nzmin, nzmax) +!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(elem, elnodes, nz) #else !ACC PARALLEL LOOP DEFAULT(PRESENT) PRIVATE(elnodes) -#endif - nzmin = 1 - nzmax = size(ttf, 1) +#endif do elem=1, myDim_elem2D elnodes=elem2D_nodes(:,elem) do nz=nzmin+1, nzmax-1 From cfe2fcea06aa4daa77b4e01f3bb89ef849e02c90 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 4 Jun 2026 12:54:15 +0200 Subject: [PATCH 39/63] fix some ci-test problems --- src/oce_adv_tra_ver.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/oce_adv_tra_ver.F90 b/src/oce_adv_tra_ver.F90 index 241437332..30be62a03 100644 --- a/src/oce_adv_tra_ver.F90 +++ b/src/oce_adv_tra_ver.F90 @@ -718,6 +718,8 @@ end subroutine adv_tra_ver_cdiff ! !_______________________________________________________________________________ ! vertical advection 2nd order in space (and time) using superbee slope limiter +! !!! ATTENTION !!! +! This part is sofar untested it is left here for later pickup subroutine adv_tra_ver_spbee( & W , & ttf , & @@ -769,7 +771,7 @@ subroutine adv_tra_ver_spbee( & !___________________________________________________________________________ #ifndef ENABLE_OPENACC -!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, nz, nzmin, nzmax, tff0, tffp1, dttf0p1, & +!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(node, nz, nzmin, nzmax, ttf0, ttfp1, dttf0p1, & !$OMP R, Cr, Tmean2, Tmean1, cfl, vflux, vfabs) !$OMP DO #else From 212cf263bb7c4f1125a6eed2d279356c0dea15a4 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 4 Jun 2026 13:23:16 +0200 Subject: [PATCH 40/63] fix some ci-test problems --- .../gen_modules_cvmix_idemix2.F90 | 32 +++++++++++++------ 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 96e6b2a90..55f7a8d27 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -2698,7 +2698,7 @@ subroutine adv_Ecompart_flx2tra_spctrl( & !$ACC END LOOP # endif #endif - end do + end do #ifndef ENABLE_OPENACC !$OMP END DO @@ -2713,19 +2713,26 @@ subroutine adv_Ecompart_flx2tra_spctrl( & !_______________________________________________________________________ ! normalize with total volume of scalar cell from top to bottom #ifndef ENABLE_OPENACC - !$OMP PARALLEL DO COLLAPSE(2) -#else - !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) -#endif + ! precompute reciprocal outside inner loop: FP division is ~6x more expensive + ! than multiply on CPU, and the outer loop already saturates thread count + !$OMP PARALLEL DO PRIVATE(ivols_lcl) do node=1, myDim_nod2d! +eDim_nod2D ivols_lcl = 1/vol_s(node) do fbini=2,nfbin-1 div_h(fbini, node) = div_h(fbini,node)*ivols_lcl end do end do -#ifndef ENABLE_OPENACC !$OMP END PARALLEL DO #else + ! on GPU, division throughput is far less asymmetric than on CPU and memory + ! bandwidth dominates; inline division to keep loops perfectly nested for + ! COLLAPSE(2), which gives a flat warp-filling iteration space + !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) + do node=1, myDim_nod2d! +eDim_nod2D + do fbini=2,nfbin-1 + div_h(fbini, node) = div_h(fbini,node)/vol_s(node) + end do + end do !$ACC END PARALLEL LOOP #endif @@ -2733,18 +2740,23 @@ subroutine adv_Ecompart_flx2tra_spctrl( & ! inject blocked coast fluxes as source at interior nodes in mirror bin #ifndef ENABLE_OPENACC !$OMP PARALLEL DO -#else - !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) -#endif do node = 1, myDim_nod2D if (.not. refl_node(node)) cycle do fbini = 2, nfbin-1 div_h(fbini, node) = div_h(fbini, node) + refl_src(fbini, node) end do end do -#ifndef ENABLE_OPENACC !$OMP END PARALLEL DO #else + ! cycle on outer loop is semantically wrong in a COLLAPSE(2) combined iteration + ! space (would cycle fbini, not node); condition moved inside inner loop — + ! a predicated assignment is GPU-friendly and restores perfect nesting + !$ACC PARALLEL LOOP GANG VECTOR COLLAPSE(2) DEFAULT(PRESENT) VECTOR_LENGTH(acc_vl) + do node = 1, myDim_nod2D + do fbini = 2, nfbin-1 + if (refl_node(node)) div_h(fbini, node) = div_h(fbini, node) + refl_src(fbini, node) + end do + end do !$ACC END PARALLEL LOOP #endif From f9c8630713f1e29bbb67ac0138ee2ab018fa4777 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 4 Jun 2026 15:42:06 +0200 Subject: [PATCH 41/63] improve comments, switch of some part when idemix2 runs in idemix1 mode --- .../gen_modules_cvmix_idemix2.F90 | 1096 ++++++++--------- 1 file changed, 506 insertions(+), 590 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 55f7a8d27..0c2bc4d00 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -11,7 +11,7 @@ ! @see Eden C., Czeschel L., Olbers D.: ! Towards Energetically Consistent Ocean Models. ! J. Phys. Oceanogr., 44, 3160-3184, doi: 10.1175/JPO-D-13-0260.1, 2014. -! written by Patrick Scholz, 10.05.2019 +! written by Patrick Scholz, 04.06.2026 module g_cvmix_idemix2 !___________________________________________________________________________ @@ -71,8 +71,8 @@ module g_cvmix_idemix2 ! use superbee-spectral advection scheme and Adams-Bashfort timestepping ! logical :: idemix2_enable_superbee_adv = .true. - logical :: idemix2_enable_AB_timestep = .true. - integer :: idemix2_AB_epsilon = 0.1_WP + logical :: idemix2_enable_AB = .true. + real(kind=WP) :: idemix2_AB_epsilon = 0.1_WP ! number of spectral bins used for the M2 tidal and near-inertial wave (niw) components ! e.g 50+2 in loop used as do fbin=2,51 ... 1 and 52 serve as spectral boudary condition ! The first and last bins are used for boundary conditions in the spectral space. @@ -164,7 +164,7 @@ module g_cvmix_idemix2 character(MAX_PATH):: idemix2_hlamforc_vname= 'LAMBDA_G10' namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, idemix2_scal_cn, & - idemix2_enable_AB_timestep, idemix2_nfbin, & ! idemix2_enable_superbee_adv + idemix2_enable_AB, idemix2_nfbin, & ! idemix2_enable_superbee_adv idemix2_enable_hor_diffusion, idemix2_enable_hor_diff_iter, idemix2_hor_diff_niter, & idemix2_shelf_dist, & idemix2_botforc_Etot, & @@ -311,7 +311,7 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) " ├> idemix2_mu0 = ", idemix2_mu0 write(*,*) " │ " ! write(*,*) " ├> idemix2_superbee_adv = ", idemix2_enable_superbee_adv - write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB_timestep + write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB write(*,*) " ├> idemix2_nfbin = ", idemix2_nfbin write(*,*) " │ " write(*,*) " ├> idemix2_enable_M2 = ", idemix2_enable_M2 @@ -622,12 +622,12 @@ subroutine init_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ ! pre-compute reflective coastal BC lookup tables - call init_reflect_bc( iwe2_refl_bin & - , iwe2_refl_sgn & - , iwe2_refl_src & - , iwe2_refl_node & - , partit & - , mesh & + call init_reflect_bc( iwe2_refl_bin & ! OUT: mirror spectral bin index per coast edge (0=not coast) + , iwe2_refl_sgn & ! OUT: sign per coast edge (+1 if ednodes(1) is coast, -1 otherwise) + , iwe2_refl_src & ! OUT: per-timestep reflect source accumulator (m²/s³) + , iwe2_refl_node & ! OUT: logical mask, .true. for coast-adjacent nodes + , partit & ! IN + , mesh & ! IN ) !_______________________________________________________________________ @@ -954,19 +954,19 @@ subroutine init_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ ! initialise IDEMIX parameters call cvmix_idemix2_init( & - tau_v = idemix2_tau_v & - , tau_h = idemix2_tau_h & - , gamma = idemix2_gamma & - , jstar = idemix2_jstar & - , mu0 = idemix2_mu0 & - , nfbin = idemix2_nfbin & - , shelf_dist = idemix2_shelf_dist & - , enable_M2 = idemix2_enable_M2 & - , enable_niw = idemix2_enable_niw & - , enable_AB_timestep = idemix2_enable_AB_timestep & - , enable_hor_diffusion= idemix2_enable_hor_diffusion & - , enable_hor_diff_iter= idemix2_enable_hor_diff_iter & - , hor_diff_niter = idemix2_hor_diff_niter & + tau_v = idemix2_tau_v & !IN: vertical dissipation timescale (s) + , tau_h = idemix2_tau_h & !IN: horizontal diffusion timescale (s) + , gamma = idemix2_gamma & !IN: spectral bandwidth parameter + , jstar = idemix2_jstar & !IN: GM76 spectral peak mode number + , mu0 = idemix2_mu0 & !IN: wave-wave interaction coefficient + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , shelf_dist = idemix2_shelf_dist & !IN: shelf distance threshold (m) + , enable_M2 = idemix2_enable_M2 & !IN: activate M2 tidal compartment + , enable_niw = idemix2_enable_niw & !IN: activate NIW compartment + , enable_AB_timestep = idemix2_enable_AB & !IN: use Adams-Bashforth 2nd-order time stepping + , enable_hor_diffusion= idemix2_enable_hor_diffusion & !IN: enable horizontal Laplacian diffusion + , enable_hor_diff_iter= idemix2_enable_hor_diff_iter & !IN: use iterative horizontal diffusion + , hor_diff_niter = idemix2_hor_diff_niter & !IN: number of horizontal diffusion iterations ! enable_superbee_adv = idemix2_enable_superbee_adv & ) @@ -1154,27 +1154,24 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) integer, intent(in) :: istep type(t_mesh), intent(in), target :: mesh type(t_partit), intent(inout), target :: partit - integer :: node, elem, edge, node_size, elem_size, k, fbini, nfbin, nodeH_size, elemH_size - integer :: nz, nln, nl1, nl2, nl12, nu1, nu2, nu12, uln, iter - integer :: elnodes(3), el(2), ednodes(2) + integer :: node, elem, edge, node_size, elem_size, k, fbini, nfbin + integer :: nz, nln, nl1, nl2, nl12, nu1, nu2, nu12, uln, iter + integer :: elnodes(3), el(2), ednodes(2) real(kind=WP) :: lat_n_deg, lat_e_deg real(kind=WP) :: cn, cn_e, cn_gradx_e, cn_grady_e, omega_niw_e real(kind=WP) :: inv_area, area_third logical :: topo_shelf=.False. - logical :: debug=.false. ! Timing variables real(kind=WP) :: t_start, t_end, t0, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10 real(kind=WP) :: time_params, time_groupvel, time_M2_integ, time_niw_integ - real(kind=WP) :: time_Eiw_vdiff, time_Eiw_hdiff, time_waveint, time_Kv_Av, time_total + real(kind=WP) :: time_Eiw_vdiff=0.0, time_Eiw_hdiff=0.0, time_waveint=0.0, time_Kv_Av=0.0, time_total=0.0 #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" #include "../associate_mesh_ass.h" node_size = myDim_nod2D - nodeH_size = myDim_nod2D+eDim_nod2D elem_size = myDim_elem2D - elemH_size = myDim_elem2D+eDim_elem2D nfbin = idemix2_nfbin !_______________________________________________________________________ @@ -1232,53 +1229,20 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !___________________________________________________________________ ! 1st. compute idemix2 parameter over the vertical water column and ! local horizontal parameters on elements !!!: - ! IN VARIABLES: - ! -------------- - ! nlev ... number of mid-depth levels - ! coriolis ... coriolis parameter - ! Nsqr ... squared buoyancy frequency - ! cn ... baroclionic gravity wave speed - ! - ! OUT VARIABLES: - ! -------------- - ! alpha_c ... 3d enery dissipation coefficient - ! v0 ... 3d horizontal group velocities (m/s) for the continuous - ! internal wave spectrum - ! c0 ... 3d vertical group velocities (m/s) for the continuous - ! internal wave spectrum call cvmix_idemix2_compute_param( & - nlev = nln-uln+1 & !IN - , coriolis = mesh%coriolis_node( node) & !IN - , Nsqr = bvfreq( uln:nln, node) & !IN - , cn = cn & !IN - , alpha_c = iwe2_alpha_c(uln:nln, node) & !OUT - , c0 = iwe2_c0( uln:nln, node) & !OUT - , v0 = iwe2_v0( uln:nln, node) & !OUT + nlev = nln-uln+1 & !IN: number of active levels + , coriolis = mesh%coriolis_node( node) & !IN: Coriolis parameter (1/s) + , Nsqr = bvfreq( uln:nln, node) & !IN: buoyancy frequency squared (1/s²) + , cn = cn & !IN: first baroclinic mode speed (m/s) + , alpha_c = iwe2_alpha_c(uln:nln, node) & !OUT: wave-wave dissipation rate (1/s) + , c0 = iwe2_c0( uln:nln, node) & !OUT: vertical representative group speed (m/s) + , v0 = iwe2_v0( uln:nln, node) & !OUT: horizontal representative group speed (m/s) ) ! ! !___________________________________________________________________ ! 3rd. compute dissipation time scales and rates - ! IN VARIABLES: - ! -------------- - ! dtime ... time step - ! lat ... elem lat coordinates - ! coriolis ... coriolis parameter - ! omega_M2 ... M2 frequency (fixed) - ! omega_niw ... NIW frequency (lat dependent) - ! cn ... baroclionic gravity wave speed - ! zbottom ... bottom depth at nodes (depth must be positive, *(-1)) - ! topo_hrms ... root mean square topographic height - ! topo_hlam ... characteristic horiz. length scale of topographic features - ! topo_shelf... .true. if point is considered on shelf - ! - ! OUT VARIABLES: - ! -------------- - ! tau_M2 ... M2 Tidal Dissipation Timescale - ! tau_niw ... NIW Dissipation Timescale - ! alpha_M2_cont... M2 Continuous Dissipation Rate (Background M2 tidal - ! dissipation rate if (idemix2_enable_M2 .or. idemix2_enable_niw) then if (iwe2_topo_dist(node) <= idemix2_shelf_dist) then topo_shelf = .True. @@ -1287,38 +1251,38 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) end if if (idemix2_enable_M2) then call cvmix_idemix2_compute_compart_interact_tscale(& - dtime = dt & !IN - , lat = lat_n_deg & !IN - , coriolis = mesh%coriolis_node( node) & !IN - , cn = cn & !IN - , zbottom = -zbar_n_bot( node) & !IN - , topo_hrms = iwe2_topo_hrms( node) & !IN - , topo_hlam = iwe2_topo_hlam( node) & !IN - , topo_shelf = topo_shelf & !IN - , omega_compart= iwe2_omega_M2 & !IN - , tau_compart = iwe2_M2_tau( node) & !OUT - , compart_name = 'M2' & + dtime = dt & !IN: time step (s) + , lat = lat_n_deg & !IN: latitude (degrees) + , coriolis = mesh%coriolis_node( node) & !IN: Coriolis parameter (1/s) + , cn = cn & !IN: first baroclinic mode speed (m/s) + , zbottom = -zbar_n_bot( node) & !IN: bottom depth, positive (m) + , topo_hrms = iwe2_topo_hrms( node) & !IN: RMS topographic height (m) + , topo_hlam = iwe2_topo_hlam( node) & !IN: characteristic topographic length scale (m) + , topo_shelf = topo_shelf & !IN: .true. if node is on shelf + , omega_compart= iwe2_omega_M2 & !IN: M2 tidal frequency (1/s) + , tau_compart = iwe2_M2_tau( node) & !OUT: M2 bottom scattering timescale (1/s) + , compart_name = 'M2' & !IN: compartment name ) call cvmix_idemix2_compute_M2_dissipation( & - lat = lat_n_deg & !IN - , cn = cn & !IN - , zbottom = -zbar_n_bot( node) & !IN - , alpha_M2_c = iwe2_alpha_M2_c( node) & !OUT - ) + lat = lat_n_deg & !IN: latitude (degrees) + , cn = cn & !IN: first baroclinic mode speed (m/s) + , zbottom = -zbar_n_bot( node) & !IN: bottom depth, positive (m) + , alpha_M2_c = iwe2_alpha_M2_c( node) & !OUT: M2 continuous (PSI) dissipation rate (1/s) + ) end if if (idemix2_enable_niw) then call cvmix_idemix2_compute_compart_interact_tscale(& - dtime = dt & !IN - , lat = lat_n_deg & !IN - , coriolis = mesh%coriolis_node( node) & !IN - , cn = cn & !IN - , zbottom = -zbar_n_bot( node) & !IN - , topo_hrms = iwe2_topo_hrms( node) & !IN - , topo_hlam = iwe2_topo_hlam( node) & !IN - , topo_shelf = topo_shelf & !IN - , omega_compart= iwe2_omega_niw( node) & !IN - , tau_compart = iwe2_niw_tau( node) & !OUT - , compart_name = 'niw' & + dtime = dt & !IN: time step (s) + , lat = lat_n_deg & !IN: latitude (degrees) + , coriolis = mesh%coriolis_node( node) & !IN: Coriolis parameter (1/s) + , cn = cn & !IN: first baroclinic mode speed (m/s) + , zbottom = -zbar_n_bot( node) & !IN: bottom depth, positive (m) + , topo_hrms = iwe2_topo_hrms( node) & !IN: RMS topographic height (m) + , topo_hlam = iwe2_topo_hlam( node) & !IN: characteristic topographic length scale (m) + , topo_shelf = topo_shelf & !IN: .true. if node is on shelf + , omega_compart= iwe2_omega_niw( node) & !IN: NIW frequency (lat-dependent, 1/s) + , tau_compart = iwe2_niw_tau( node) & !OUT: NIW bottom scattering timescale (1/s) + , compart_name = 'niw' & !IN: compartment name ) end if end if @@ -1327,53 +1291,39 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! !___________________________________________________________________ ! 4th. compute structure function for M2 and NIW energy - ! IN VARIABLES: - ! -------------- - ! nlev ... number of full depth levels - ! dzw ... layyer thickness, distance between full depth levels - ! coriolis ... coriolis parameter - ! omega_M2 ... M2 frequency (fixed) - ! omega_niw ... NIW frequency (lat dependent) - ! cn ... baroclionic gravity wave speed - ! Nsqr ... squared buoyancy frequency - ! - ! OUT VARIABLES: - ! -------------- - ! E_struct_M2 ... structure function for M2 energy - ! E_struct_niw... structure function for NIW energy if ((idemix2_enable_M2) .and. (idemix2_enable_niw)) then call cvmix_idemix2_compute_vert_struct_fct( & - nlev = nln-uln+1 & !IN - , dzw = hnode( uln:nln-1, node) & !IN - , coriolis = mesh%coriolis_node( node) & !IN - , cn = cn & !IN - , Nsqr = bvfreq( uln:nln, node) & !IN - , omega_M2 = iwe2_omega_M2 & !IN - , omega_niw = iwe2_omega_niw( node) & !IN - , E_struct_M2 = iwe2_E_M2_struct( uln:nln, node) & !OUT - , E_struct_niw= iwe2_E_niw_struct(uln:nln, node) & !OUT + nlev = nln-uln+1 & !IN: number of active levels + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , coriolis = mesh%coriolis_node( node) & !IN: Coriolis parameter (1/s) + , cn = cn & !IN: first baroclinic mode speed (m/s) + , Nsqr = bvfreq( uln:nln, node) & !IN: buoyancy frequency squared (1/s²) + , omega_M2 = iwe2_omega_M2 & !IN: M2 tidal frequency (1/s) + , omega_niw = iwe2_omega_niw( node) & !IN: NIW frequency, lat-dependent (1/s) + , E_struct_M2 = iwe2_E_M2_struct( uln:nln, node) & !INOUT: M2 energy vertical structure function + , E_struct_niw= iwe2_E_niw_struct(uln:nln, node) & !INOUT: NIW energy vertical structure function ) else if (idemix2_enable_M2) then call cvmix_idemix2_compute_vert_struct_fct( & - nlev = nln-uln+1 & !IN - , dzw = hnode( uln:nln-1, node) & !IN - , coriolis = mesh%coriolis_node( node) & !IN - , cn = cn & !IN - , Nsqr = bvfreq( uln:nln, node) & !IN - , omega_M2 = iwe2_omega_M2 & !IN - , E_struct_M2 = iwe2_E_M2_struct( uln:nln, node) & !OUT + nlev = nln-uln+1 & !IN: number of active levels + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , coriolis = mesh%coriolis_node( node) & !IN: Coriolis parameter (1/s) + , cn = cn & !IN: first baroclinic mode speed (m/s) + , Nsqr = bvfreq( uln:nln, node) & !IN: buoyancy frequency squared (1/s²) + , omega_M2 = iwe2_omega_M2 & !IN: M2 tidal frequency (1/s) + , E_struct_M2 = iwe2_E_M2_struct( uln:nln, node) & !INOUT: M2 energy vertical structure function ) else if (idemix2_enable_niw) then call cvmix_idemix2_compute_vert_struct_fct( & - nlev = nln-uln+1 & !IN - , dzw = hnode( uln:nln-1, node) & !IN - , coriolis = mesh%coriolis_node( node) & !IN - , cn = cn & !IN - , Nsqr = bvfreq( uln:nln, node) & !IN - , omega_niw = iwe2_omega_niw( node) & !IN - , E_struct_niw= iwe2_E_niw_struct(uln:nln, node) & !OUT + nlev = nln-uln+1 & !IN: number of active levels + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , coriolis = mesh%coriolis_node( node) & !IN: Coriolis parameter (1/s) + , cn = cn & !IN: first baroclinic mode speed (m/s) + , Nsqr = bvfreq( uln:nln, node) & !IN: buoyancy frequency squared (1/s²) + , omega_niw = iwe2_omega_niw( node) & !IN: NIW frequency, lat-dependent (1/s) + , E_struct_niw= iwe2_E_niw_struct(uln:nln, node) & !INOUT: NIW energy vertical structure function ) end if @@ -1382,288 +1332,254 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) t1 = MPI_Wtime() time_params = t1 - t0 - !_______________________________________________________________________ - ! 2. Compute idemix2 group velocites for M2 an NIW - t1 = MPI_Wtime() - do elem = 1, myDim_elem2D - nln = nlevels(elem)-1 - uln = ulevels(elem) - elnodes = elem2d_nodes(:,elem) - lat_e_deg = sum(geo_coord_nod2D(2,elnodes)) / (3.0_WP*rad) - area_third = elem_area(elem) / 3.0_WP - if (idemix2_enable_M2) w_M2_e(:) = 0.0_WP - if (idemix2_enable_niw) w_niw_e(:) = 0.0_WP - - !___________________________________________________________________ - ! compute baroclionic gravity wave speed on elements - cn_e = sum(iwe2_cn(elnodes))/3.0 - - ! compute gradient of baroclionic gkdot_x_M2 = sqrt(fxa)/omega_M2*cn_gradxravity wave speed on elements - cn_gradx_e = sum(gradient_sca(1:3,elem)*iwe2_cn(elnodes)) - cn_grady_e = sum(gradient_sca(4:6,elem)*iwe2_cn(elnodes)) - -! iwe2_cn_e(elem) = cn_e -! iwe2_cn_gradx(elem) = cn_gradx_e -! iwe2_cn_grady(elem) = cn_grady_e - - ! average to elem - if (idemix2_enable_niw) omega_niw_e = sum(iwe2_omega_niw(elnodes))/3.0 - - ! - ! - !___________________________________________________________________ - ! IN VARIABLES: - ! -------------- - ! nlev ... number of mid-depth levels - ! nfbin ... number of spectral bins used for the M2 tidal and - ! near-inertial wave (niw) - ! dtime ... time step - ! coriolis ... coriolis parameter - ! grady_coriol ... lat gradient of coriolis paramter - ! coslat ... cosine of latitude @elem - ! Nsqr ... squared buoyancy frequency - ! omega_M2 ... M2 frequency (fixed) - ! omega_niw ... NIW frequency (lat dependent) - ! cn ... baroclionic gravity wave speed - ! cn_gradx ... zonal gradient of baroclionic gravity wave speed - ! cn_grady ... merid gradient of baroclionic gravity wave speed - ! phit ... edge of the k-th spectral bin - ! phiu ... center of the k-th spectral bin - ! - ! OUT VARIABLES: - ! -------------- - ! alpha_c ... 3d enery dissipation coefficient - ! c0 ... 3d horizontal group velocities (m/s) for the continuous - ! z internal wave spectrum - ! v0 ... 3d vertical group velocities (m/s) for the continuous - ! internal wave spectrum - ! cg_M2 ... 2d group velocity of M2 internal tidal waves - ! cg_niw ... 2d group velocity of near-inertial waves (NIW) - ! u_M2 ... zonal component of M2 internal tide group velocity - ! v_M2 ... meridional component of M2 internal tide group velocity - ! w_M2 ... cross spectral propagation of M2 internal tide group velocity - ! u_niw ... zonal component of NIW internal group velocity - ! v_niw ... meridional component of NIW internal group velocity - ! w_niw ... cross spectral propagation of NIW internal group velocity - if (idemix2_enable_M2) then - call cvmix_idemix2_compute_compart_groupvel( & - nfbin = idemix2_nfbin & !IN - , coriolis = mesh%coriolis( elem) & !IN - , coriol_grady = iwe2_grady_coriol( elem) & !IN - , coslat = mesh%elem_cos( elem) & !IN - , cn = cn_e & !IN - , cn_gradx = cn_gradx_e & !IN - , cn_grady = cn_grady_e & !IN - , phit = iwe2_phit & !IN - , phiu = iwe2_phiu & !IN - , omega_compart= iwe2_omega_M2 & !IN - , u_compart = iwe2_M2_uv(1, :, elem) & !OUT - , v_compart = iwe2_M2_uv(2, :, elem) & !OUT - , w_compart = w_M2_e( : ) & !OUT - ) - ! --> here w_M2_e and w_niw_e are still on elements but for the proper - ! finite volume advection implementation we need them on nodes ! - do k=1,3 - iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + w_M2_e(:)*area_third - end do + !___________________________________________________________________________ + if (idemix2_enable_M2 .or. idemix2_enable_niw) then + !_______________________________________________________________________ + ! 2. Compute idemix2 group velocites for M2 an NIW + t1 = MPI_Wtime() + do elem = 1, myDim_elem2D + nln = nlevels(elem)-1 + uln = ulevels(elem) + elnodes = elem2d_nodes(:,elem) + lat_e_deg = sum(geo_coord_nod2D(2,elnodes)) / (3.0_WP*rad) + area_third = elem_area(elem) / 3.0_WP + if (idemix2_enable_M2) w_M2_e(:) = 0.0_WP + if (idemix2_enable_niw) w_niw_e(:) = 0.0_WP - end if - if (idemix2_enable_niw) then - call cvmix_idemix2_compute_compart_groupvel( & - nfbin = idemix2_nfbin & !IN - , coriolis = mesh%coriolis( elem) & !IN - , coriol_grady = iwe2_grady_coriol( elem) & !IN - , coslat = mesh%elem_cos( elem) & !IN - , cn = cn_e & !IN - , cn_gradx = cn_gradx_e & !IN - , cn_grady = cn_grady_e & !IN - , phit = iwe2_phit & !IN - , phiu = iwe2_phiu & !IN - , omega_compart= omega_niw_e & !IN - , u_compart = iwe2_niw_uv(1, :, elem) & !OUT - , v_compart = iwe2_niw_uv(2, :, elem) & !OUT - , w_compart = w_niw_e( : ) & !OUT - ) + !___________________________________________________________________ + ! compute baroclionic gravity wave speed on elements + cn_e = sum(iwe2_cn(elnodes))/3.0 - ! Mask out NIW velocities near equator where physics is singular - if (abs(lat_e_deg) < 5.0_WP) then ! ~5° latitude - iwe2_niw_uv( :, :, elem) = 0.0_WP - w_niw_e( : ) = 0.0_WP - end if + ! compute gradient of baroclionic gkdot_x_M2 = sqrt(fxa)/omega_M2*cn_gradxravity wave speed on elements + cn_gradx_e = sum(gradient_sca(1:3,elem)*iwe2_cn(elnodes)) + cn_grady_e = sum(gradient_sca(4:6,elem)*iwe2_cn(elnodes)) + + ! average iwe2_omega_niw to elem + if (idemix2_enable_niw) omega_niw_e = sum(iwe2_omega_niw(elnodes))/3.0 - do k=1,3 - iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*area_third + !___________________________________________________________________ + if (idemix2_enable_M2) then + call cvmix_idemix2_compute_compart_groupvel( & + nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , coriolis = mesh%coriolis( elem) & !IN: Coriolis parameter at element (1/s) + , coriol_grady = iwe2_grady_coriol( elem) & !IN: meridional gradient of Coriolis (1/(m·s)) + , coslat = mesh%elem_cos( elem) & !IN: cosine of latitude at element + , cn = cn_e & !IN: first baroclinic mode speed at element (m/s) + , cn_gradx = cn_gradx_e & !IN: zonal gradient of cn at element (1/s) + , cn_grady = cn_grady_e & !IN: meridional gradient of cn at element (1/s) + , phit = iwe2_phit & !IN: angular bin edges (rad) + , phiu = iwe2_phiu & !IN: angular bin centres (rad) + , omega_compart= iwe2_omega_M2 & !IN: M2 tidal frequency (1/s) + , u_compart = iwe2_M2_uv(1, :, elem) & !OUT: zonal group velocity per bin (m/s) + , v_compart = iwe2_M2_uv(2, :, elem) & !OUT: meridional group velocity per bin (m/s) + , w_compart = w_M2_e( : ) & !OUT: cross-spectral propagation rate per bin (1/s) + ) + ! --> here w_M2_e and w_niw_e are still on elements but for the proper + ! finite volume advection implementation we need them on nodes ! + do k=1,3 + iwe2_M2_w(:, elnodes(k)) = iwe2_M2_w(:, elnodes(k)) + w_M2_e(:)*area_third + end do + + end if + if (idemix2_enable_niw) then + call cvmix_idemix2_compute_compart_groupvel( & + nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , coriolis = mesh%coriolis( elem) & !IN: Coriolis parameter at element (1/s) + , coriol_grady = iwe2_grady_coriol( elem) & !IN: meridional gradient of Coriolis (1/(m·s)) + , coslat = mesh%elem_cos( elem) & !IN: cosine of latitude at element + , cn = cn_e & !IN: first baroclinic mode speed at element (m/s) + , cn_gradx = cn_gradx_e & !IN: zonal gradient of cn at element (1/s) + , cn_grady = cn_grady_e & !IN: meridional gradient of cn at element (1/s) + , phit = iwe2_phit & !IN: angular bin edges (rad) + , phiu = iwe2_phiu & !IN: angular bin centres (rad) + , omega_compart= omega_niw_e & !IN: NIW frequency, elem-averaged (1/s) + , u_compart = iwe2_niw_uv(1, :, elem) & !OUT: zonal group velocity per bin (m/s) + , v_compart = iwe2_niw_uv(2, :, elem) & !OUT: meridional group velocity per bin (m/s) + , w_compart = w_niw_e( : ) & !OUT: cross-spectral propagation rate per bin (1/s) + ) + + ! Mask out NIW velocities near equator where physics is singular + if (abs(lat_e_deg) < 5.0_WP) then ! ~5° latitude + iwe2_niw_uv( :, :, elem) = 0.0_WP + w_niw_e( : ) = 0.0_WP + end if + + do k=1,3 + iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*area_third + end do + end if + ! --> at the end we still need to normalize iwe2_M2_w and iwe2_niw_w + ! with the scalararea! + end do ! --> do elem = 1, myDim_elem2D + t2 = MPI_Wtime() + time_groupvel = t2 - t1 + + ! finalize elem2node averaging of iwe2_M2_w and iwe2_niw_w + ! cross spectral exachange has to be related to nodes, since general advection + ! is related to nodes independent of the volume + if (idemix2_enable_M2) then + call exchange_elem_fbin(iwe2_M2_uv, partit) + call exchange_nod_fbin(iwe2_M2_w, partit) + !$OMP PARALLEL DO PRIVATE(node, inv_area) + do node=1, myDim_nod2D+eDim_nod2D + inv_area = 1.0_WP / area(1, node) + iwe2_M2_w(:, node) = iwe2_M2_w(:, node) * inv_area end do + !$OMP END PARALLEL DO end if - ! --> at the end we still need to normalize iwe2_M2_w and iwe2_niw_w - ! with the scalararea! - end do ! --> do elem = 1, myDim_elem2D - t2 = MPI_Wtime() - time_groupvel = t2 - t1 - - ! finalize elem2node averaging of iwe2_M2_w and iwe2_niw_w - ! cross spectral exachange has to be related to nodes, since general advection - ! is related to nodes independent of the volume - if (idemix2_enable_M2) then - call exchange_elem_fbin(iwe2_M2_uv, partit) - call exchange_nod_fbin(iwe2_M2_w, partit) -!$OMP PARALLEL DO PRIVATE(node, inv_area) - do node=1, myDim_nod2D+eDim_nod2D - inv_area = 1.0_WP / area(1, node) - iwe2_M2_w(:, node) = iwe2_M2_w(:, node) * inv_area - end do -!$OMP END PARALLEL DO - end if - if (idemix2_enable_niw) then - call exchange_elem_fbin(iwe2_niw_uv, partit) - call exchange_nod_fbin(iwe2_niw_w, partit) -!$OMP PARALLEL DO PRIVATE(node, inv_area) - do node=1, myDim_nod2D+eDim_nod2D - inv_area = 1.0_WP / area(1, node) - iwe2_niw_w(:, node) = iwe2_niw_w(:, node) * inv_area - end do -!$OMP END PARALLEL DO - end if - - - !_______________________________________________________________________ - ! 3. Horizontal spectral integrate energy compartment E_M2^(n+1) and - ! E_niw^(n+1) equation. - ! dE/dt = -div(vec_u * E) - tau*E + Forc - ! E^(n+1) = E^n + dt*( -div(vec_u^n*E^n) - tau*E^n + Forc^n) - t3 = MPI_Wtime() - if (idemix2_enable_M2) then - if (idemix2_diag_Ecompart) then - call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & - , 'M2' & - , iwe2_E_M2 & - , iwe2_E_M2_divh & - , iwe2_E_M2_divs & - , iwe2_M2_uv & - , iwe2_M2_w & - , iwe2_fM2 & - , iwe2_M2_tau & - , iwe2_dphit & - , iwe2_gradxy_e & - , iwe2_gradxy_n & - , iwe2_flx_uv & - , iwe2_flx_w & - , iwe2_refl_bin & - , iwe2_refl_sgn & - , iwe2_refl_src & - , iwe2_refl_node & - , vol_nodB2T & - , partit & - , mesh & - , .True. & ! flag_AB2, do 2nd order adams-bashfort in time - , iwe2_E_M2_dt & ! optional: diagnostic - , iwe2_E_M2_advh & ! optional: diagnostic - , iwe2_E_M2_advs & ! optional: diagnostic - , iwe2_E_M2_diss & ! optional: diagnostic - , iwe2_E_M2_forc & ! optional: diagnostic - , iwe2_E_M2_refl & ! optional: diagnostic - ) - else - call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & - , 'M2' & - , iwe2_E_M2 & - , iwe2_E_M2_divh & - , iwe2_E_M2_divs & - , iwe2_M2_uv & - , iwe2_M2_w & - , iwe2_fM2 & - , iwe2_M2_tau & - , iwe2_dphit & - , iwe2_gradxy_e & - , iwe2_gradxy_n & - , iwe2_flx_uv & - , iwe2_flx_w & - , iwe2_refl_bin & - , iwe2_refl_sgn & - , iwe2_refl_src & - , iwe2_refl_node & - , vol_nodB2T & - , partit & - , mesh & - , .True. & ! flag_AB2, do 2nd order adams-bashfort in time - ) + if (idemix2_enable_niw) then + call exchange_elem_fbin(iwe2_niw_uv, partit) + call exchange_nod_fbin(iwe2_niw_w, partit) + !$OMP PARALLEL DO PRIVATE(node, inv_area) + do node=1, myDim_nod2D+eDim_nod2D + inv_area = 1.0_WP / area(1, node) + iwe2_niw_w(:, node) = iwe2_niw_w(:, node) * inv_area + end do + !$OMP END PARALLEL DO end if - ! Compute global total NIW energy for conservation check - ! call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') - ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'M2') - end if - t4 = MPI_Wtime() - time_M2_integ = t4 - t3 + + + !_______________________________________________________________________ + ! 3. Horizontal spectral integrate energy compartment E_M2^(n+1) and + ! E_niw^(n+1) equation. + ! dE/dt = -div(vec_u * E) - tau*E + Forc + ! E^(n+1) = E^n + dt*( -div(vec_u^n*E^n) - tau*E^n + Forc^n) + t3 = MPI_Wtime() + if (idemix2_enable_M2) then + if (idemix2_diag_Ecompart) then + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & ! IN: time indices (n-1, n, n+1) + , 'M2' & ! IN: compartment name + , iwe2_E_M2 & ! INOUT: energy array [3,nfbin,node] + , iwe2_E_M2_divh & ! INOUT: horizontal divergence flux accumulator + , iwe2_E_M2_divs & ! INOUT: cross-spectral divergence accumulator + , iwe2_M2_uv & ! IN: horizontal group velocities on elements + , iwe2_M2_w & ! INOUT: cross-spectral propagation speed on nodes + , iwe2_fM2 & ! IN: M2 tidal surface forcing + , iwe2_M2_tau & ! IN: M2 dissipation timescale per node + , iwe2_dphit & ! IN: angular bin widths + , iwe2_gradxy_e & ! INOUT: energy gradient on elements (work array) + , iwe2_gradxy_n & ! INOUT: energy gradient on nodes (work array) + , iwe2_flx_uv & ! INOUT: horizontal edge flux (work array) + , iwe2_flx_w & ! INOUT: cross-spectral flux (work array) + , iwe2_refl_bin & ! IN: mirror bin lookup table + , iwe2_refl_sgn & ! IN: coast edge sign + , iwe2_refl_src & ! INOUT: reflect source accumulator + , iwe2_refl_node & ! IN: coast-adjacent node mask + , vol_nodB2T & ! IN: scalar cell volumes bottom-to-top + , partit & ! INOUT + , mesh & ! IN + , idemix2_enable_AB & ! IN: enable AB2 time stepping + , iwe2_E_M2_dt & ! INOUT: optional diagnostic: total tendency + , iwe2_E_M2_advh & ! INOUT: optional diagnostic: horiz. advection + , iwe2_E_M2_advs & ! INOUT: optional diagnostic: spectral advection + , iwe2_E_M2_diss & ! INOUT: optional diagnostic: dissipation + , iwe2_E_M2_forc & ! INOUT: optional diagnostic: forcing + , iwe2_E_M2_refl & ! INOUT: optional diagnostic: coast reflection + ) + else + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & ! IN: time indices (n-1, n, n+1) + , 'M2' & ! IN: compartment name + , iwe2_E_M2 & ! INOUT: energy array [3,nfbin,node] + , iwe2_E_M2_divh & ! INOUT: horizontal divergence flux accumulator + , iwe2_E_M2_divs & ! INOUT: cross-spectral divergence accumulator + , iwe2_M2_uv & ! IN: horizontal group velocities on elements + , iwe2_M2_w & ! INOUT: cross-spectral propagation speed on nodes + , iwe2_fM2 & ! IN: M2 tidal surface forcing + , iwe2_M2_tau & ! IN: M2 dissipation timescale per node + , iwe2_dphit & ! IN: angular bin widths + , iwe2_gradxy_e & ! INOUT: energy gradient on elements (work array) + , iwe2_gradxy_n & ! INOUT: energy gradient on nodes (work array) + , iwe2_flx_uv & ! INOUT: horizontal edge flux (work array) + , iwe2_flx_w & ! INOUT: cross-spectral flux (work array) + , iwe2_refl_bin & ! IN: mirror bin lookup table + , iwe2_refl_sgn & ! IN: coast edge sign + , iwe2_refl_src & ! INOUT: reflect source accumulator + , iwe2_refl_node & ! IN: coast-adjacent node mask + , vol_nodB2T & ! IN: scalar cell volumes bottom-to-top + , partit & ! INOUT + , mesh & ! IN + , idemix2_enable_AB & ! IN: enable AB2 time stepping + ) + end if + ! Compute global total NIW energy for conservation check + ! call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') + ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'M2') + end if + t4 = MPI_Wtime() + time_M2_integ = t4 - t3 + + t4 = MPI_Wtime() + if (idemix2_enable_niw) then + ! create complete Ecomaprt diagnostic + if (idemix2_diag_Ecompart) then + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & ! IN: time indices (n-1, n, n+1) + , 'NIW' & ! IN: compartment name + , iwe2_E_niw & ! INOUT: energy array [3,nfbin,node] + , iwe2_E_niw_divh & ! INOUT: horizontal divergence flux accumulator + , iwe2_E_niw_divs & ! INOUT: cross-spectral divergence accumulator + , iwe2_niw_uv & ! IN: horizontal group velocities on elements + , iwe2_niw_w & ! INOUT: cross-spectral propagation speed on nodes + , iwe2_fniw & ! IN: NIW surface forcing + , iwe2_niw_tau & ! IN: NIW dissipation timescale per node + , iwe2_dphit & ! IN: angular bin widths + , iwe2_gradxy_e & ! INOUT: energy gradient on elements (work array) + , iwe2_gradxy_n & ! INOUT: energy gradient on nodes (work array) + , iwe2_flx_uv & ! INOUT: horizontal edge flux (work array) + , iwe2_flx_w & ! INOUT: cross-spectral flux (work array) + , iwe2_refl_bin & ! IN: mirror bin lookup table + , iwe2_refl_sgn & ! IN: coast edge sign + , iwe2_refl_src & ! INOUT: reflect source accumulator + , iwe2_refl_node & ! IN: coast-adjacent node mask + , vol_nodB2T & ! IN: scalar cell volumes bottom-to-top + , partit & ! INOUT + , mesh & ! IN + , idemix2_enable_AB & ! IN: enable AB2 time stepping + , iwe2_E_niw_dt & ! INOUT: optional diagnostic: total tendency + , iwe2_E_niw_advh & ! INOUT: optional diagnostic: horiz. advection + , iwe2_E_niw_advs & ! INOUT: optional diagnostic: spectral advection + , iwe2_E_niw_diss & ! INOUT: optional diagnostic: dissipation + , iwe2_E_niw_forc & ! INOUT: optional diagnostic: forcing + , iwe2_E_niw_refl & ! INOUT: optional diagnostic: coast reflection + ) + else + call hsintegrate_Ecompart( & + iwe2_taum1, iwe2_tau, iwe2_taup1 & ! IN: time indices (n-1, n, n+1) + , 'NIW' & ! IN: compartment name + , iwe2_E_niw & ! INOUT: energy array [3,nfbin,node] + , iwe2_E_niw_divh & ! INOUT: horizontal divergence flux accumulator + , iwe2_E_niw_divs & ! INOUT: cross-spectral divergence accumulator + , iwe2_niw_uv & ! IN: horizontal group velocities on elements + , iwe2_niw_w & ! INOUT: cross-spectral propagation speed on nodes + , iwe2_fniw & ! IN: NIW surface forcing + , iwe2_niw_tau & ! IN: NIW dissipation timescale per node + , iwe2_dphit & ! IN: angular bin widths + , iwe2_gradxy_e & ! INOUT: energy gradient on elements (work array) + , iwe2_gradxy_n & ! INOUT: energy gradient on nodes (work array) + , iwe2_flx_uv & ! INOUT: horizontal edge flux (work array) + , iwe2_flx_w & ! INOUT: cross-spectral flux (work array) + , iwe2_refl_bin & ! IN: mirror bin lookup table + , iwe2_refl_sgn & ! IN: coast edge sign + , iwe2_refl_src & ! INOUT: reflect source accumulator + , iwe2_refl_node & ! IN: coast-adjacent node mask + , vol_nodB2T & ! IN: scalar cell volumes bottom-to-top + , partit & ! INOUT + , mesh & ! IN + , idemix2_enable_AB & ! IN: enable AB2 time stepping + ) + end if + ! Compute global total NIW energy for conservation check + ! call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') + ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'niw') + end if + t5 = MPI_Wtime() + time_niw_integ = t5 - t4 + + end if ! --> if (idemix2_enable_M2 .or. idemix2_enable_niw) then - t4 = MPI_Wtime() - if (idemix2_enable_niw) then - ! create complete Ecomaprt diagnostic - if (idemix2_diag_Ecompart) then - call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & - , 'NIW' & - , iwe2_E_niw & - , iwe2_E_niw_divh & - , iwe2_E_niw_divs & - , iwe2_niw_uv & - , iwe2_niw_w & - , iwe2_fniw & - , iwe2_niw_tau & - , iwe2_dphit & - , iwe2_gradxy_e & - , iwe2_gradxy_n & - , iwe2_flx_uv & - , iwe2_flx_w & - , iwe2_refl_bin & - , iwe2_refl_sgn & - , iwe2_refl_src & - , iwe2_refl_node & - , vol_nodB2T & - , partit & - , mesh & - , .True. & ! flag_AB2, do 2nd order adams-bashfort in time - , iwe2_E_niw_dt & ! optional: diagnostic - , iwe2_E_niw_advh & ! optional: diagnostic - , iwe2_E_niw_advs & ! optional: diagnostic - , iwe2_E_niw_diss & ! optional: diagnostic - , iwe2_E_niw_forc & ! optional: diagnostic - , iwe2_E_niw_refl & ! optional: diagnostic - ) - else - call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & - , 'NIW' & - , iwe2_E_niw & - , iwe2_E_niw_divh & - , iwe2_E_niw_divs & - , iwe2_niw_uv & - , iwe2_niw_w & - , iwe2_fniw & - , iwe2_niw_tau & - , iwe2_dphit & - , iwe2_gradxy_e & - , iwe2_gradxy_n & - , iwe2_flx_uv & - , iwe2_flx_w & - , iwe2_refl_bin & - , iwe2_refl_sgn & - , iwe2_refl_src & - , iwe2_refl_node & - , vol_nodB2T & - , partit & - , mesh & - , .True. & ! flag_AB2, do 2nd order adams-bashfort in time - ) - end if - ! Compute global total NIW energy for conservation check - ! call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') - ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'niw') - end if - t5 = MPI_Wtime() - time_niw_integ = t5 - t4 !_______________________________________________________________________ ! 4. Integrate IDEMIX equation vertical, solve vertical diffusion and @@ -1677,34 +1593,34 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) if (idemix2_diag_Eiw) then - call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & - nlev = nln-uln+1 & - , dzw = hnode( uln:nln-1, node) & - , dt = dt & - , c0 = iwe2_c0( uln:nln , node) & - , alpha_c = iwe2_alpha_c( uln:nln , node) & - , fsrf = iwe2_fsrf( node) & - , fbot = iwe2_fbot( uln:nln , node) & - , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & - , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & - , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & - , Eiw_dt = iwe2_E_iw_dt( uln:nln , node) & ! optional: diagnostic - , Eiw_vdif = iwe2_E_iw_vdif( uln:nln , node) & ! optional: diagnostic - , Eiw_srf = iwe2_E_iw_fsrf( node) & ! optional: diagnostic - , Eiw_bot = iwe2_E_iw_fbot( uln:nln , node) & ! optional: diagnostic + call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & + nlev = nln-uln+1 & !IN: number of active levels + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dt = dt & !IN: time step (s) + , c0 = iwe2_c0( uln:nln , node) & !IN: first baroclinic mode speed (m/s) + , alpha_c = iwe2_alpha_c( uln:nln , node) & !IN: wave-wave dissipation rate (1/s) + , fsrf = iwe2_fsrf( node) & !IN: surface IW energy flux (m²/s³) + , fbot = iwe2_fbot( uln:nln , node) & !IN: bottom tidal energy flux (m²/s³) + , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & !IN: IW energy at current time (m²/s²) + , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & !OUT: IW energy at next time (m²/s²) + , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & !OUT: IW dissipation rate for TKE coupling (m²/s³) + , Eiw_dt = iwe2_E_iw_dt( uln:nln , node) & !OUT: optional diagnostic: total tendency + , Eiw_vdif = iwe2_E_iw_vdif( uln:nln , node) & !OUT: optional diagnostic: vertical diffusion tendency + , Eiw_srf = iwe2_E_iw_fsrf( node) & !OUT: optional diagnostic: surface forcing + , Eiw_bot = iwe2_E_iw_fbot( uln:nln , node) & !OUT: optional diagnostic: bottom forcing ) else - call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & - nlev = nln-uln+1 & - , dzw = hnode( uln:nln-1, node) & - , dt = dt & - , c0 = iwe2_c0( uln:nln , node) & - , alpha_c = iwe2_alpha_c( uln:nln , node) & - , fsrf = iwe2_fsrf( node) & - , fbot = iwe2_fbot( uln:nln , node) & - , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & - , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & - , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & + call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & + nlev = nln-uln+1 & !IN: number of active levels + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dt = dt & !IN: time step (s) + , c0 = iwe2_c0( uln:nln , node) & !IN: first baroclinic mode speed (m/s) + , alpha_c = iwe2_alpha_c( uln:nln , node) & !IN: wave-wave dissipation rate (1/s) + , fsrf = iwe2_fsrf( node) & !IN: surface IW energy flux (m²/s³) + , fbot = iwe2_fbot( uln:nln , node) & !IN: bottom tidal energy flux (m²/s³) + , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & !IN: IW energy at current time (m²/s²) + , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & !OUT: IW energy at next time (m²/s²) + , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & !OUT: IW dissipation rate for TKE coupling (m²/s³) ) end if end do ! --> do node = 1, myDim_nod2D @@ -1726,24 +1642,24 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) end if if (idemix2_enable_hor_diffusion) then if (idemix2_diag_Eiw) then - call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_tau , :, :) & - , iwe2_E_iw(iwe2_taup1, :, :) & - , iwe2_v0 & - , 1 & - , partit & - , mesh & - , Eiw_dt = iwe2_E_iw_dt & - , Eiw_hdif = iwe2_E_iw_hdif & + call compute_hdiff_Eiw( & + iwe2_E_iw(iwe2_tau , :, :) & ! IN: IW energy at current time + , iwe2_E_iw(iwe2_taup1, :, :) & ! INOUT: IW energy updated by horizontal diffusion + , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) + , 1 & ! IN: number of horizontal diffusion iterations + , partit & ! INOUT + , mesh & ! IN + , Eiw_dt = iwe2_E_iw_dt & ! INOUT: optional diagnostic: total tendency + , Eiw_hdif = iwe2_E_iw_hdif & ! INOUT: optional diagnostic: horiz. diffusion tendency ) else - call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_tau , :, :) & - , iwe2_E_iw(iwe2_taup1, :, :) & - , iwe2_v0 & - , 1 & - , partit & - , mesh & + call compute_hdiff_Eiw( & + iwe2_E_iw(iwe2_tau , :, :) & ! IN: IW energy at current time + , iwe2_E_iw(iwe2_taup1, :, :) & ! INOUT: IW energy updated by horizontal diffusion + , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) + , 1 & ! IN: number of horizontal diffusion iterations + , partit & ! INOUT + , mesh & ! IN ) end if end if @@ -1757,23 +1673,23 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) do iter=1, idemix2_hor_diff_niter if (idemix2_diag_Eiw) then call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_taup1, :, :) & - , iwe2_E_iw(iwe2_taup1, :, :) & - , iwe2_v0 & - , idemix2_hor_diff_niter & - , partit & - , mesh & - , Eiw_dt = iwe2_E_iw_dt & - , Eiw_hdif = iwe2_E_iw_hdif & + iwe2_E_iw(iwe2_taup1, :, :) & ! IN: IW energy from previous iteration + , iwe2_E_iw(iwe2_taup1, :, :) & ! INOUT: IW energy updated in-place (iterative) + , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) + , idemix2_hor_diff_niter & ! IN: total number of diffusion iterations + , partit & ! INOUT + , mesh & ! IN + , Eiw_dt = iwe2_E_iw_dt & ! INOUT: optional diagnostic: total tendency + , Eiw_hdif = iwe2_E_iw_hdif & ! INOUT: optional diagnostic: horiz. diffusion tendency ) else call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_taup1, :, :) & - , iwe2_E_iw(iwe2_taup1, :, :) & - , iwe2_v0 & - , idemix2_hor_diff_niter & - , partit & - , mesh & + iwe2_E_iw(iwe2_taup1, :, :) & ! IN: IW energy from previous iteration + , iwe2_E_iw(iwe2_taup1, :, :) & ! INOUT: IW energy updated in-place (iterative) + , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) + , idemix2_hor_diff_niter & ! IN: total number of diffusion iterations + , partit & ! INOUT + , mesh & ! IN ) end if end do @@ -1792,125 +1708,125 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !_______________________________________________________________ if (idemix2_enable_M2 .and. idemix2_enable_niw) then if (idemix2_diag_WWI) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , flag_posdef = .True. & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & - , E_M2_struct = iwe2_E_M2_struct( : , node) & - , alpha_M2_c = iwe2_alpha_M2_c( node) & - , tau_M2 = iwe2_M2_tau( node) & - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & - , E_niw_struct = iwe2_E_niw_struct( : , node) & - , tau_niw = iwe2_niw_tau( node) & - , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic - , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & ! optional: diagnostic - , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & ! optional: diagnostic - , E_M2_dt = iwe2_E_M2_dt( : , node) & ! optional: diagnostic - , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & ! optional: diagnostic + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & !IN: M2 compartment energy at current time (m²/s²) + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & !INOUT: M2 compartment energy updated + , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate + , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & !IN: NIW compartment energy at current time (m²/s²) + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & !INOUT: NIW compartment energy updated + , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) + , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave + , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from M2 + , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from NIW + , E_M2_dt = iwe2_E_M2_dt( : , node) & !INOUT: optional diagnostic: M2 tendency from wave-wave + , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & !INOUT: optional diagnostic: M2 dissipation from wave-wave ) else - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , flag_posdef = .True. & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & - , E_M2_struct = iwe2_E_M2_struct( : , node) & - , alpha_M2_c = iwe2_alpha_M2_c( node) & - , tau_M2 = iwe2_M2_tau( node) & - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & - , E_niw_struct = iwe2_E_niw_struct( : , node) & - , tau_niw = iwe2_niw_tau( node) & + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & !IN: M2 compartment energy at current time (m²/s²) + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & !INOUT: M2 compartment energy updated + , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate + , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & !IN: NIW compartment energy at current time (m²/s²) + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & !INOUT: NIW compartment energy updated + , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) ) - end if - - elseif (idemix2_enable_M2) then + end if + + elseif (idemix2_enable_M2) then if (idemix2_diag_WWI) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , flag_posdef = .True. & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & - , E_M2_struct = iwe2_E_M2_struct( : , node) & - , alpha_M2_c = iwe2_alpha_M2_c( node) & - , tau_M2 = iwe2_M2_tau( node) & - , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic - , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & ! optional: diagnostic - , E_M2_dt = iwe2_E_M2_dt( : , node) & ! optional: diagnostic - , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & ! optional: diagnostic + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & !IN: M2 compartment energy at current time (m²/s²) + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & !INOUT: M2 compartment energy updated + , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate + , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) + , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave + , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from M2 + , E_M2_dt = iwe2_E_M2_dt( : , node) & !INOUT: optional diagnostic: M2 tendency from wave-wave + , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & !INOUT: optional diagnostic: M2 dissipation from wave-wave ) else - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , flag_posdef = .True. & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & - , E_M2_struct = iwe2_E_M2_struct( : , node) & - , alpha_M2_c = iwe2_alpha_M2_c( node) & - , tau_M2 = iwe2_M2_tau( node) & + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & !IN: M2 compartment energy at current time (m²/s²) + , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & !INOUT: M2 compartment energy updated + , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate + , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) ) - end if - elseif (idemix2_enable_niw) then + end if + elseif (idemix2_enable_niw) then if (idemix2_diag_WWI) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , flag_posdef = .True. & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & - , E_niw_struct = iwe2_E_niw_struct( : , node) & - , tau_niw = iwe2_niw_tau( node) & - , E_iw_dt = iwe2_E_iw_dt( : , node) & ! optional: diagnostic - , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & ! optional: diagnostic + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & !IN: NIW compartment energy at current time (m²/s²) + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & !INOUT: NIW compartment energy updated + , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) + , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave + , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from NIW ) else - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & - , nfbin = idemix2_nfbin & - , dzw = hnode( uln:nln-1, node) & - , dphi = iwe2_dphit & - , dt = dt & - , flag_posdef = .True. & - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & - , E_niw_struct = iwe2_E_niw_struct( : , node) & - , tau_niw = iwe2_niw_tau( node) & - ) - end if - end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & !IN: NIW compartment energy at current time (m²/s²) + , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & !INOUT: NIW compartment energy updated + , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) + ) + end if + end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then end do ! --> for node = 1, myDim_nod2D !$OMP END PARALLEL DO end if ! --> if (idemix2_enable_M2 .or . idemix2_enable_niw) then @@ -1932,11 +1848,11 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !_______________________________________________________________ ! convert Eiw disspation into Kv and Av on vertices call cvmix_idemix2_compute_Eiw_diss2KvAv( & - nlev = nln-uln+1 & - , Eiw_diss= iwe2_E_iw_diss(uln:nln, node) & - , Nsqr = bvfreq( uln:nln, node) & - , KappaH = Kv( uln:nln, node) & - , KappaM = iwe2_Av( uln:nln, node) & + nlev = nln-uln+1 & !IN: number of active levels + , Eiw_diss= iwe2_E_iw_diss(uln:nln, node) & !IN: IW dissipation rate (m²/s³) + , Nsqr = bvfreq( uln:nln, node) & !IN: buoyancy frequency squared (1/s²) + , KappaH = Kv( uln:nln, node) & !INOUT: diapycnal diffusivity (m²/s) + , KappaM = iwe2_Av( uln:nln, node) & !INOUT: vertical viscosity (m²/s) ) end do !$OMP END PARALLEL DO @@ -2543,17 +2459,17 @@ end function slimiter_superbee ! v ! E^(n+1) = E^(n) + dt/V^n * ( - Flx_hv + Forc*V^n) ! |--> Flx_hv = Flx_h + Flx_v - subroutine adv_Ecompart_flx2tra_spctrl( & - flx_h , & - flx_v , & - refl_src , & - refl_node , & - div_h , & - div_v , & - dphit , & - vol_s , & - partit , & - mesh & + subroutine adv_Ecompart_flx2tra_spctrl(& + flx_h & + , flx_v & + , refl_src & + , refl_node & + , div_h & + , div_v & + , dphit & + , vol_s & + , partit & + , mesh & ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ From 823a276b4f3da3914ca8534c8d58696e89a6901b Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 5 Jun 2026 16:33:43 +0200 Subject: [PATCH 42/63] fix the restart for IDEMIX2 --- src/io_fesom_file.F90 | 21 +++++++++++++----- src/io_restart.F90 | 24 ++++++++++++++++++-- src/io_restart_file_group.F90 | 41 ++++++++++++++++++++--------------- 3 files changed, 61 insertions(+), 25 deletions(-) diff --git a/src/io_fesom_file.F90 b/src/io_fesom_file.F90 index 1706f0cec..9b1bd6053 100644 --- a/src/io_fesom_file.F90 +++ b/src/io_fesom_file.F90 @@ -56,7 +56,8 @@ module io_fesom_file_module integer, save :: m_nod2d integer, save :: m_elem2d integer, save :: m_nl - integer, save :: m_ncat + integer, save :: m_ncat + integer, save :: m_nfbin = 0 type fesom_file_type_ptr @@ -106,7 +107,7 @@ function time_dimindex(this) result(x) end function time_dimindex - subroutine init(this, mesh_nod2d, mesh_elem2d, mesh_nl, partit, mesh_ncat) ! todo: would like to call it initialize but Fortran is rather cluncky with overwriting base type procedures + subroutine init(this, mesh_nod2d, mesh_elem2d, mesh_nl, partit, mesh_ncat, mesh_nfbin) ! todo: would like to call it initialize but Fortran is rather cluncky with overwriting base type procedures use io_netcdf_workaround_module use io_gather_module use MOD_PARTIT @@ -115,6 +116,7 @@ subroutine init(this, mesh_nod2d, mesh_elem2d, mesh_nl, partit, mesh_ncat) ! tod integer mesh_elem2d integer mesh_nl integer, optional :: mesh_ncat + integer, optional :: mesh_nfbin type(t_partit), target :: partit ! EO parameters type(fesom_file_type_ptr), allocatable :: tmparr(:) @@ -129,11 +131,16 @@ subroutine init(this, mesh_nod2d, mesh_elem2d, mesh_nl, partit, mesh_ncat) ! tod m_elem2d = mesh_elem2d m_nl = mesh_nl !PS mesh_ncat ... icepack number of ice thickness classes, - if (present(mesh_ncat)) then + if (present(mesh_ncat)) then m_ncat = mesh_ncat - else + else m_ncat = 0 - end if + end if + if (present(mesh_nfbin)) then + m_nfbin = mesh_nfbin + else + m_nfbin = 0 + end if call this%netcdf_file_type%initialize() @@ -593,7 +600,9 @@ function obtain_diminfo(this, len) result(info) else if(len == m_nl ) then info = dim_info( idx=this%add_dim('nz' , len), len=len) else if(len == m_ncat ) then - info = dim_info( idx=this%add_dim('ncat', len), len=len) + info = dim_info( idx=this%add_dim('ncat', len), len=len) + else if(len == m_nfbin .and. m_nfbin > 0) then + info = dim_info( idx=this%add_dim('nfbin', len), len=len) else print *, "error in line ",__LINE__, __FILE__," can not find dimension with size",len stop 1 diff --git a/src/io_restart.F90 b/src/io_restart.F90 index 1bd47e833..bd7caa296 100644 --- a/src/io_restart.F90 +++ b/src/io_restart.F90 @@ -156,7 +156,20 @@ subroutine ini_ocean_io(dynamics, tracers, partit, mesh) endif if (mix_scheme_nmb==6 .or. mix_scheme_nmb==56) then call oce_files%def_elem_var_optional('iwe', 'Internal Wave Energy' , 'm2/s2', iwe(:,:), mesh, partit) - endif + endif + if (mod(mix_scheme_nmb,10)==7) then + call oce_files%def_node_var_optional('iwe2_Eiw' , 'IDEMIX2 low-mode IW energy' , 'm2/s2', iwe2_E_iw(:,:,1), mesh, partit) + if (idemix2_enable_M2) then + call oce_files%def_node_var_optional('iwe2_EM2' , 'IDEMIX2 M2 spectral energy' , 'm2/s2', iwe2_E_M2(:,:,1), mesh, partit, nfbin=idemix2_nfbin) + call oce_files%def_node_var_optional('iwe2_EM2divh' , 'IDEMIX2 M2 horiz div (AB2 prev)' , 'm2/s3', iwe2_E_M2_divh(:,:,1), mesh, partit, nfbin=idemix2_nfbin) + call oce_files%def_node_var_optional('iwe2_EM2divs' , 'IDEMIX2 M2 spec div (AB2 prev)' , 'm2/s3', iwe2_E_M2_divs(:,:,1), mesh, partit, nfbin=idemix2_nfbin) + end if + if (idemix2_enable_niw) then + call oce_files%def_node_var_optional('iwe2_Eniw' , 'IDEMIX2 NIW spectral energy' , 'm2/s2', iwe2_E_niw(:,:,1), mesh, partit, nfbin=idemix2_nfbin) + call oce_files%def_node_var_optional('iwe2_Eniwdivh', 'IDEMIX2 NIW horiz div (AB2 prev)', 'm2/s3', iwe2_E_niw_divh(:,:,1), mesh, partit, nfbin=idemix2_nfbin) + call oce_files%def_node_var_optional('iwe2_Eniwdivs', 'IDEMIX2 NIW spec div (AB2 prev)', 'm2/s3', iwe2_E_niw_divs(:,:,1), mesh, partit, nfbin=idemix2_nfbin) + end if + endif #endif if (dynamics%opt_visc==8) then call oce_files%def_elem_var_optional('uke', 'unresolved kinetic energy', 'm2/s2', uke(:,:), mesh, partit) @@ -427,8 +440,12 @@ subroutine read_initial_conditions(which_readr, ice, dynamics, tracers, partit, end if #endif +#if defined (__cvmix) + if (mod(mix_scheme_nmb,10)==7) call apply_idemix2_restart() +#endif + end if - + end subroutine read_initial_conditions !-------------------------------------------------------------------------------------------- @@ -545,6 +562,9 @@ subroutine write_initial_conditions(istep, nstart, ntotal, which_readr, ice, dyn ! Write restart files if(is_portable_restart_write) then +#if defined (__cvmix) + if (mod(mix_scheme_nmb,10)==7) call prepare_idemix2_restart() +#endif ! Write OCEAN restart if (partit%mype==RAW_RESTART_METADATA_RANK) print *, achar(27)//'[1;33m'//' --> write restarts to netcdf file: ocean'//achar(27)//'[0m' call write_netcdf_restarts(write_oce_path, oce_files, istep) diff --git a/src/io_restart_file_group.F90 b/src/io_restart_file_group.F90 index 27e34a5f7..663877b06 100644 --- a/src/io_restart_file_group.F90 +++ b/src/io_restart_file_group.F90 @@ -103,38 +103,41 @@ subroutine def_elem_var_3d(this, name, longname, units, local_data, mesh, partit end subroutine def_elem_var_3d - subroutine add_file(g, name, must_exist_on_read, mesh_nod2d, mesh_elem2d, mesh_nl, partit, mesh_ncat) + subroutine add_file(g, name, must_exist_on_read, mesh_nod2d, mesh_elem2d, mesh_nl, partit, mesh_ncat, mesh_nfbin) class(restart_file_group), target, intent(inout) :: g character(len=*), intent(in) :: name logical must_exist_on_read integer mesh_nod2d, mesh_elem2d, mesh_nl type(t_partit), intent(in) :: partit - !PS mesh_ncat ... icepack number of ice thickness classes, do it here as optional - !PS parameter, i assume is the less intrusive option. Therefore it must be + !PS mesh_ncat ... icepack number of ice thickness classes, do it here as optional + !PS parameter, i assume is the less intrusive option. Therefore it must be !PS at the end of the argumnent input list - integer, optional :: mesh_ncat + integer, optional :: mesh_ncat + integer, optional :: mesh_nfbin ! EO parameters type(restart_file_type), pointer :: f call assert(g%nfiles < size(g%files), __LINE__) g%nfiles = g%nfiles+1 f => g%files(g%nfiles) - + f%path = "" allocate(f%varname,source=name) f%must_exist_on_read = must_exist_on_read - - if (present(mesh_ncat)) then - call f%fesom_file_type%init(mesh_nod2d, mesh_elem2d, mesh_nl, partit, mesh_ncat) - ! make sure we can identify a 2d icepackvariable, problem here is, We have a new - ! dimension ncat number of ice thickness categories and icepack 2d vars have + + if (present(mesh_ncat)) then + call f%fesom_file_type%init(mesh_nod2d, mesh_elem2d, mesh_nl, partit, mesh_ncat=mesh_ncat) + ! make sure we can identify a 2d icepackvariable, problem here is, We have a new + ! dimension ncat number of ice thickness categories and icepack 2d vars have ! dimensions (nod2, ncat) but fesom IO expects (ncat, nod2) --> means we ! need to sneek in a matrix transpose somehow!!! + else if (present(mesh_nfbin)) then + call f%fesom_file_type%init(mesh_nod2d, mesh_elem2d, mesh_nl, partit, mesh_nfbin=mesh_nfbin) else call f%fesom_file_type%init(mesh_nod2d, mesh_elem2d, mesh_nl, partit) end if ! this is specific for a restart file - f%iter_varindex = f%add_var_int('iter', [f%time_dimindex()]) + f%iter_varindex = f%add_var_int('iter', [f%time_dimindex()]) end subroutine add_file @@ -152,7 +155,7 @@ subroutine def_node_var_2d_optional(this, name, longname, units, local_data, mes call this%files(this%nfiles)%specify_node_var(name, longname, units, local_data) end subroutine def_node_var_2d_optional - subroutine def_node_var_3d_optional(this, name, longname, units, local_data, mesh, partit, ncat) + subroutine def_node_var_3d_optional(this, name, longname, units, local_data, mesh, partit, ncat, nfbin) use mod_mesh class(restart_file_group), intent(inout) :: this character(len=*) , intent(in) :: name @@ -161,18 +164,22 @@ subroutine def_node_var_3d_optional(this, name, longname, units, local_data, mes type(t_mesh) , intent(in) :: mesh type(t_partit) , intent(in) :: partit integer , intent(in) , optional :: ncat + integer , intent(in) , optional :: nfbin ! EO parameters - if (present(ncat)) then + if (present(ncat)) then !PS add a seprate case for icepack since here i need to write a 2d vertice file - !PS over the dimension of number of ice thickness classes. Additional input + !PS over the dimension of number of ice thickness classes. Additional input !PS parameter ncat - call add_file(this, name, .false., mesh%nod2d, mesh%elem2d, mesh%nl, partit, ncat) + call add_file(this, name, .false., mesh%nod2d, mesh%elem2d, mesh%nl, partit, mesh_ncat=ncat) call this%files(this%nfiles)%specify_node_var(name, longname, units, local_data, ncat) + else if (present(nfbin)) then + call add_file(this, name, .false., mesh%nod2d, mesh%elem2d, mesh%nl, partit, mesh_nfbin=nfbin) + call this%files(this%nfiles)%specify_node_var(name, longname, units, local_data) else call add_file(this, name, .false., mesh%nod2d, mesh%elem2d, mesh%nl, partit) call this%files(this%nfiles)%specify_node_var(name, longname, units, local_data) - end if - + end if + end subroutine def_node_var_3d_optional From e7a6566f65d03e578e91ab51859497201b64ee05 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 5 Jun 2026 16:35:23 +0200 Subject: [PATCH 43/63] move time index to last index position, reduce the saving to 2 timeslices, to save memory --- .../gen_modules_cvmix_idemix2.F90 | 493 ++++++++++-------- src/cvmix_driver/gen_modules_cvmix_tke.F90 | 4 +- 2 files changed, 272 insertions(+), 225 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 0c2bc4d00..391e5e463 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -237,7 +237,7 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:) :: iwe2_grady_coriol, aux real(kind=WP), allocatable, dimension(:,:,:):: iwe2_gradxy_e, iwe2_gradxy_n real(kind=WP), allocatable, dimension(:,: ):: iwe2_flx_uv, iwe2_flx_w - integer :: iwe2_taum1=1, iwe2_tau=2, iwe2_taup1=3, otaum1 + integer :: iwe2_ti=1, iwe2_tip1=2 ! reflective coastal BC: for each edge touching exactly one coast node, ! iwe2_bc_reflect_bin stores the mirror spectral bin (0 = edge not flagged), @@ -368,8 +368,8 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_alpha_c(:,:) = 0.0_WP ! initialise Eiw - internal wave energy variables - ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) - allocate(iwe2_E_iw( 3, nl, node_size)) + ! index (..., 1:3) timestep index E^(n-1), E^(n), E^(n+1) + allocate(iwe2_E_iw( nl, node_size, 2)) iwe2_E_iw( :,:,:)= 0.0_WP allocate(iwe2_E_iw_diss(nl, node_size)) @@ -418,10 +418,10 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_fM2(:,:) = 0.0_WP ! M2 wave energy, and divergence of M2 wave energy - ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) - allocate( iwe2_E_M2( 3, nfbin, node_size) & - , iwe2_E_M2_divh(3, nfbin, node_size) & - , iwe2_E_M2_divs(3, nfbin, node_size) & + ! index (..., 1:3) timestep index E^(n-1), E^(n), E^(n+1) + allocate( iwe2_E_M2( nfbin, node_size, 2) & + , iwe2_E_M2_divh(nfbin, node_size, 2) & + , iwe2_E_M2_divs(nfbin, node_size, 2) & ) iwe2_E_M2( :,:,:)= 0.0_WP iwe2_E_M2_divh( :,:,:)= 0.0_WP @@ -487,10 +487,10 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_fniw(:,:) = 0.0_WP ! niw wave energy, and divergence of niw wave energy - ! index (1:3,...) timestep index E^(n-1), E^(n), E^(n+1) - allocate( iwe2_E_niw( 3, nfbin, node_size) & - , iwe2_E_niw_divh(3, nfbin, node_size) & - , iwe2_E_niw_divs(3, nfbin, node_size) & + ! index (..., 1:3) timestep index E^(n-1), E^(n), E^(n+1) + allocate( iwe2_E_niw( nfbin, node_size, 2) & + , iwe2_E_niw_divh(nfbin, node_size, 2) & + , iwe2_E_niw_divs(nfbin, node_size, 2) & ) iwe2_E_niw( :,:,:)= 0.0_WP iwe2_E_niw_divh( :,:,:)= 0.0_WP @@ -1179,12 +1179,9 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) t_start = MPI_Wtime() !_______________________________________________________________________ - ! do tau timestepping indices shift - otaum1= iwe2_taum1 - iwe2_taum1 = iwe2_tau - iwe2_tau = iwe2_taup1 - iwe2_taup1 = otaum1; - ! if (mype==0) write(*,*) " --> taum1, tau, taup1: ", iwe2_taum1, iwe2_tau, iwe2_taup1 + ! do tau timestepping indices shift (2-slot: ti and tip1 alternate 1<->2) + iwe2_ti = iwe2_tip1 + iwe2_tip1 = 3 - iwe2_ti !_______________________________________________________________________ ! compute scalar cell volume from top to bottom @@ -1449,9 +1446,9 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) if (idemix2_enable_M2) then if (idemix2_diag_Ecompart) then call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & ! IN: time indices (n-1, n, n+1) + iwe2_ti, iwe2_tip1 & ! IN: current and next time indices , 'M2' & ! IN: compartment name - , iwe2_E_M2 & ! INOUT: energy array [3,nfbin,node] + , iwe2_E_M2 & ! INOUT: energy array [2,nfbin,node] , iwe2_E_M2_divh & ! INOUT: horizontal divergence flux accumulator , iwe2_E_M2_divs & ! INOUT: cross-spectral divergence accumulator , iwe2_M2_uv & ! IN: horizontal group velocities on elements @@ -1480,9 +1477,9 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) else call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & ! IN: time indices (n-1, n, n+1) + iwe2_ti, iwe2_tip1 & ! IN: current and next time indices , 'M2' & ! IN: compartment name - , iwe2_E_M2 & ! INOUT: energy array [3,nfbin,node] + , iwe2_E_M2 & ! INOUT: energy array [2,nfbin,node] , iwe2_E_M2_divh & ! INOUT: horizontal divergence flux accumulator , iwe2_E_M2_divs & ! INOUT: cross-spectral divergence accumulator , iwe2_M2_uv & ! IN: horizontal group velocities on elements @@ -1505,8 +1502,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) end if ! Compute global total NIW energy for conservation check - ! call check_global_energy(iwe2_E_M2, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') - ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'M2') + ! call check_global_energy(iwe2_E_M2, iwe2_tip1, iwe2_dphit, vol_nodB2T, iwe2_fM2, iwe2_M2_tau, partit, mesh, 'M2') + ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_ti, iwe2_dphit, vol_nodB2T, partit, mesh, 'M2') end if t4 = MPI_Wtime() time_M2_integ = t4 - t3 @@ -1516,9 +1513,9 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! create complete Ecomaprt diagnostic if (idemix2_diag_Ecompart) then call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & ! IN: time indices (n-1, n, n+1) + iwe2_ti, iwe2_tip1 & ! IN: current and next time indices , 'NIW' & ! IN: compartment name - , iwe2_E_niw & ! INOUT: energy array [3,nfbin,node] + , iwe2_E_niw & ! INOUT: energy array [2,nfbin,node] , iwe2_E_niw_divh & ! INOUT: horizontal divergence flux accumulator , iwe2_E_niw_divs & ! INOUT: cross-spectral divergence accumulator , iwe2_niw_uv & ! IN: horizontal group velocities on elements @@ -1547,9 +1544,9 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) else call hsintegrate_Ecompart( & - iwe2_taum1, iwe2_tau, iwe2_taup1 & ! IN: time indices (n-1, n, n+1) + iwe2_ti, iwe2_tip1 & ! IN: current and next time indices , 'NIW' & ! IN: compartment name - , iwe2_E_niw & ! INOUT: energy array [3,nfbin,node] + , iwe2_E_niw & ! INOUT: energy array [2,nfbin,node] , iwe2_E_niw_divh & ! INOUT: horizontal divergence flux accumulator , iwe2_E_niw_divs & ! INOUT: cross-spectral divergence accumulator , iwe2_niw_uv & ! IN: horizontal group velocities on elements @@ -1572,8 +1569,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) end if ! Compute global total NIW energy for conservation check - ! call check_global_energy(iwe2_E_niw, iwe2_taup1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') - ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_tau, iwe2_dphit, vol_nodB2T, partit, mesh, 'niw') + ! call check_global_energy(iwe2_E_niw, iwe2_tip1, iwe2_dphit, vol_nodB2T, iwe2_fniw, iwe2_niw_tau, partit, mesh, 'niw') + ! call check_flux_conservation( iwe2_E_niw_divh, iwe2_E_niw_divs, iwe2_ti, iwe2_dphit, vol_nodB2T, partit, mesh, 'niw') end if t5 = MPI_Wtime() time_niw_integ = t5 - t4 @@ -1601,8 +1598,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , alpha_c = iwe2_alpha_c( uln:nln , node) & !IN: wave-wave dissipation rate (1/s) , fsrf = iwe2_fsrf( node) & !IN: surface IW energy flux (m²/s³) , fbot = iwe2_fbot( uln:nln , node) & !IN: bottom tidal energy flux (m²/s³) - , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & !IN: IW energy at current time (m²/s²) - , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & !OUT: IW energy at next time (m²/s²) + , Eiw_old = iwe2_E_iw(uln:nln , node, iwe2_ti) & !IN: IW energy at current time (m²/s²) + , Eiw_new = iwe2_E_iw(uln:nln , node, iwe2_tip1) & !OUT: IW energy at next time (m²/s²) , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & !OUT: IW dissipation rate for TKE coupling (m²/s³) , Eiw_dt = iwe2_E_iw_dt( uln:nln , node) & !OUT: optional diagnostic: total tendency , Eiw_vdif = iwe2_E_iw_vdif( uln:nln , node) & !OUT: optional diagnostic: vertical diffusion tendency @@ -1618,8 +1615,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , alpha_c = iwe2_alpha_c( uln:nln , node) & !IN: wave-wave dissipation rate (1/s) , fsrf = iwe2_fsrf( node) & !IN: surface IW energy flux (m²/s³) , fbot = iwe2_fbot( uln:nln , node) & !IN: bottom tidal energy flux (m²/s³) - , Eiw_old = iwe2_E_iw(iwe2_tau , uln:nln , node) & !IN: IW energy at current time (m²/s²) - , Eiw_new = iwe2_E_iw(iwe2_taup1, uln:nln , node) & !OUT: IW energy at next time (m²/s²) + , Eiw_old = iwe2_E_iw(uln:nln , node, iwe2_ti) & !IN: IW energy at current time (m²/s²) + , Eiw_new = iwe2_E_iw(uln:nln , node, iwe2_tip1) & !OUT: IW energy at next time (m²/s²) , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & !OUT: IW dissipation rate for TKE coupling (m²/s³) ) end if @@ -1630,7 +1627,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !_______________________________________________________________________ ! Exchange E_iw after vertical diffusion - needed for horizontal diffusion gradients - call exchange_nod(iwe2_E_iw, partit) + call exchange_nod(iwe2_E_iw(:, :, iwe2_tip1), partit) !_______________________________________________________________________ ! 5. add lateral diffusion term (see. Olbers D., Eden C., 2013, A Global Model @@ -1643,8 +1640,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) if (idemix2_enable_hor_diffusion) then if (idemix2_diag_Eiw) then call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_tau , :, :) & ! IN: IW energy at current time - , iwe2_E_iw(iwe2_taup1, :, :) & ! INOUT: IW energy updated by horizontal diffusion + iwe2_E_iw(:, :, iwe2_ti) & ! IN: IW energy at current time + , iwe2_E_iw(:, :, iwe2_tip1) & ! INOUT: IW energy updated by horizontal diffusion , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) , 1 & ! IN: number of horizontal diffusion iterations , partit & ! INOUT @@ -1654,8 +1651,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) else call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_tau , :, :) & ! IN: IW energy at current time - , iwe2_E_iw(iwe2_taup1, :, :) & ! INOUT: IW energy updated by horizontal diffusion + iwe2_E_iw(:, :, iwe2_ti) & ! IN: IW energy at current time + , iwe2_E_iw(:, :, iwe2_tip1) & ! INOUT: IW energy updated by horizontal diffusion , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) , 1 & ! IN: number of horizontal diffusion iterations , partit & ! INOUT @@ -1673,8 +1670,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) do iter=1, idemix2_hor_diff_niter if (idemix2_diag_Eiw) then call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_taup1, :, :) & ! IN: IW energy from previous iteration - , iwe2_E_iw(iwe2_taup1, :, :) & ! INOUT: IW energy updated in-place (iterative) + iwe2_E_iw(:, :, iwe2_tip1) & ! IN: IW energy from previous iteration + , iwe2_E_iw(:, :, iwe2_tip1) & ! INOUT: IW energy updated in-place (iterative) , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) , idemix2_hor_diff_niter & ! IN: total number of diffusion iterations , partit & ! INOUT @@ -1684,8 +1681,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) else call compute_hdiff_Eiw( & - iwe2_E_iw(iwe2_taup1, :, :) & ! IN: IW energy from previous iteration - , iwe2_E_iw(iwe2_taup1, :, :) & ! INOUT: IW energy updated in-place (iterative) + iwe2_E_iw(:, :, iwe2_tip1) & ! IN: IW energy from previous iteration + , iwe2_E_iw(:, :, iwe2_tip1) & ! INOUT: IW energy updated in-place (iterative) , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) , idemix2_hor_diff_niter & ! IN: total number of diffusion iterations , partit & ! INOUT @@ -1706,125 +1703,125 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) !_______________________________________________________________ - if (idemix2_enable_M2 .and. idemix2_enable_niw) then + if (idemix2_enable_M2 .and. idemix2_enable_niw) then if (idemix2_diag_WWI) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & !IN: number of active levels - , nfbin = idemix2_nfbin & !IN: number of spectral angular bins - , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) - , dphi = iwe2_dphit & !IN: angular bin widths - , dt = dt & !IN: time step (s) - , flag_posdef = .True. & !IN: enforce positive-definiteness - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & !IN: M2 compartment energy at current time (m²/s²) - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & !INOUT: M2 compartment energy updated - , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function - , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate - , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & !IN: NIW compartment energy at current time (m²/s²) - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & !INOUT: NIW compartment energy updated - , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function - , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) - , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave - , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from M2 - , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from NIW - , E_M2_dt = iwe2_E_M2_dt( : , node) & !INOUT: optional diagnostic: M2 tendency from wave-wave - , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & !INOUT: optional diagnostic: M2 dissipation from wave-wave - ) + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( uln:nln, node, iwe2_ti) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_M2_old = iwe2_E_M2( : , node, iwe2_ti) & !IN: M2 compartment energy at current time (m²/s²) + , E_M2_new = iwe2_E_M2( : , node, iwe2_tip1) & !INOUT: M2 compartment energy updated + , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate + , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) + , E_niw_old = iwe2_E_niw(: , node, iwe2_ti) & !IN: NIW compartment energy at current time (m²/s²) + , E_niw_new = iwe2_E_niw(: , node, iwe2_tip1) & !INOUT: NIW compartment energy updated + , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) + , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave + , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from M2 + , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from NIW + , E_M2_dt = iwe2_E_M2_dt( : , node) & !INOUT: optional diagnostic: M2 tendency from wave-wave + , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & !INOUT: optional diagnostic: M2 dissipation from wave-wave + ) else - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & !IN: number of active levels - , nfbin = idemix2_nfbin & !IN: number of spectral angular bins - , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) - , dphi = iwe2_dphit & !IN: angular bin widths - , dt = dt & !IN: time step (s) - , flag_posdef = .True. & !IN: enforce positive-definiteness - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & !IN: M2 compartment energy at current time (m²/s²) - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & !INOUT: M2 compartment energy updated - , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function - , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate - , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & !IN: NIW compartment energy at current time (m²/s²) - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & !INOUT: NIW compartment energy updated - , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function - , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) - ) + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( uln:nln, node, iwe2_ti) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_M2_old = iwe2_E_M2( : , node, iwe2_ti) & !IN: M2 compartment energy at current time (m²/s²) + , E_M2_new = iwe2_E_M2( : , node, iwe2_tip1) & !INOUT: M2 compartment energy updated + , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate + , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) + , E_niw_old = iwe2_E_niw(: , node, iwe2_ti) & !IN: NIW compartment energy at current time (m²/s²) + , E_niw_new = iwe2_E_niw(: , node, iwe2_tip1) & !INOUT: NIW compartment energy updated + , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) + ) end if elseif (idemix2_enable_M2) then if (idemix2_diag_WWI) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & !IN: number of active levels - , nfbin = idemix2_nfbin & !IN: number of spectral angular bins - , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) - , dphi = iwe2_dphit & !IN: angular bin widths - , dt = dt & !IN: time step (s) - , flag_posdef = .True. & !IN: enforce positive-definiteness - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & !IN: M2 compartment energy at current time (m²/s²) - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & !INOUT: M2 compartment energy updated - , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function - , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate - , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) - , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave - , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from M2 - , E_M2_dt = iwe2_E_M2_dt( : , node) & !INOUT: optional diagnostic: M2 tendency from wave-wave - , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & !INOUT: optional diagnostic: M2 dissipation from wave-wave - ) + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( uln:nln, node, iwe2_ti) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_M2_old = iwe2_E_M2( : , node, iwe2_ti) & !IN: M2 compartment energy at current time (m²/s²) + , E_M2_new = iwe2_E_M2( : , node, iwe2_tip1) & !INOUT: M2 compartment energy updated + , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate + , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) + , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave + , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from M2 + , E_M2_dt = iwe2_E_M2_dt( : , node) & !INOUT: optional diagnostic: M2 tendency from wave-wave + , E_M2_diss_wwi = iwe2_E_M2_diss_wwi( : , node) & !INOUT: optional diagnostic: M2 dissipation from wave-wave + ) else - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & !IN: number of active levels - , nfbin = idemix2_nfbin & !IN: number of spectral angular bins - , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) - , dphi = iwe2_dphit & !IN: angular bin widths - , dt = dt & !IN: time step (s) - , flag_posdef = .True. & !IN: enforce positive-definiteness - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction - , E_M2_old = iwe2_E_M2( iwe2_tau , : , node) & !IN: M2 compartment energy at current time (m²/s²) - , E_M2_new = iwe2_E_M2( iwe2_taup1, : , node) & !INOUT: M2 compartment energy updated - , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function - , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate - , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) - ) + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( uln:nln, node, iwe2_ti) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_M2_old = iwe2_E_M2( : , node, iwe2_ti) & !IN: M2 compartment energy at current time (m²/s²) + , E_M2_new = iwe2_E_M2( : , node, iwe2_tip1) & !INOUT: M2 compartment energy updated + , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate + , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) + ) end if elseif (idemix2_enable_niw) then if (idemix2_diag_WWI) then - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & !IN: number of active levels - , nfbin = idemix2_nfbin & !IN: number of spectral angular bins - , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) - , dphi = iwe2_dphit & !IN: angular bin widths - , dt = dt & !IN: time step (s) - , flag_posdef = .True. & !IN: enforce positive-definiteness - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & !IN: NIW compartment energy at current time (m²/s²) - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & !INOUT: NIW compartment energy updated - , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function - , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) - , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave - , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from NIW - ) + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( uln:nln, node, iwe2_ti) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_niw_old = iwe2_E_niw(: , node, iwe2_ti) & !IN: NIW compartment energy at current time (m²/s²) + , E_niw_new = iwe2_E_niw(: , node, iwe2_tip1) & !INOUT: NIW compartment energy updated + , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) + , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave + , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from NIW + ) else - call cvmix_idemix2_compute_Eiw_waveinteract( & - nlev = nln-uln+1 & !IN: number of active levels - , nfbin = idemix2_nfbin & !IN: number of spectral angular bins - , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) - , dphi = iwe2_dphit & !IN: angular bin widths - , dt = dt & !IN: time step (s) - , flag_posdef = .True. & !IN: enforce positive-definiteness - , E_iw_old = iwe2_E_iw( iwe2_tau , uln:nln, node) & !IN: IDEMIX1 IW energy at current time (m²/s²) - , E_iw_new = iwe2_E_iw( iwe2_taup1, uln:nln, node) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction - , E_niw_old = iwe2_E_niw(iwe2_tau , : , node) & !IN: NIW compartment energy at current time (m²/s²) - , E_niw_new = iwe2_E_niw(iwe2_taup1, : , node) & !INOUT: NIW compartment energy updated - , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function - , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) - ) + call cvmix_idemix2_compute_Eiw_waveinteract( & + nlev = nln-uln+1 & !IN: number of active levels + , nfbin = idemix2_nfbin & !IN: number of spectral angular bins + , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) + , dphi = iwe2_dphit & !IN: angular bin widths + , dt = dt & !IN: time step (s) + , flag_posdef = .True. & !IN: enforce positive-definiteness + , E_iw_old = iwe2_E_iw( uln:nln, node, iwe2_ti) & !IN: IDEMIX1 IW energy at current time (m²/s²) + , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction + , E_niw_old = iwe2_E_niw(: , node, iwe2_ti) & !IN: NIW compartment energy at current time (m²/s²) + , E_niw_new = iwe2_E_niw(: , node, iwe2_tip1) & !INOUT: NIW compartment energy updated + , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) + ) end if end if ! --> (idemix2_enable_M2 .and. idemix2_enable_niw) then end do ! --> for node = 1, myDim_nod2D @@ -2684,8 +2681,8 @@ end subroutine adv_Ecompart_flx2tra_spctrl ! !___________________________________________________________________________ ! integrate equation for wave energy compartments - subroutine hsintegrate_Ecompart( & - tim1, ti, tip1 & + subroutine hsintegrate_Ecompart( & + ti, tip1 & , Ename & , E & , Edivh & @@ -2718,11 +2715,11 @@ subroutine hsintegrate_Ecompart( & !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit) , intent(inout), target :: partit type(t_mesh) , intent(in ), target :: mesh - integer , intent(in ) :: ti, tim1, tip1 + integer , intent(in ) :: ti, tip1 character(len=*), intent(in ) :: Ename - real(kind=WP) , intent(inout) :: E( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: Edivh( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) - real(kind=WP) , intent(inout) :: Edivs( 3, idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: E( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D, 2) + real(kind=WP) , intent(inout) :: Edivh(idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D, 2) + real(kind=WP) , intent(inout) :: Edivs(idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D, 2) real(kind=WP) , intent(in ) :: vel( 2, idemix2_nfbin, partit%myDim_elem2D+partit%eDim_elem2D) real(kind=WP) , intent(inout) :: cs( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) real(kind=WP) , intent(in ) :: forc( idemix2_nfbin, partit%myDim_nod2D +partit%eDim_nod2D) @@ -2759,44 +2756,44 @@ subroutine hsintegrate_Ecompart( & iwe2_flx_w( :,:) = 0.0 !_______________________________________________________________________ - ! Exchange all 3 time levels (minimal overhead, avoids array slicing issues) - call exchange_nod_fbin(E, partit) - + ! Exchange current timelevel (contiguous with timelevel-last layout) + call exchange_nod_fbin(E(:, :, ti), partit) + !_______________________________________________________________________ ! compute gradient of iwe2_E on nodes - call tracer_gradient_elements(E(ti,:,:), gradxy_e, partit, mesh, .False.) + call tracer_gradient_elements(E(:,:,ti), gradxy_e, partit, mesh, .False.) call exchange_elem_fbin(gradxy_e, partit) call interp_e2n(gradxy_e, gradxy_n, mesh, partit, .False.) call exchange_nod_fbin(gradxy_n, partit) - + !_______________________________________________________________________ - ! compute horizontal superbee advected tracer flux + ! compute horizontal superbee advected tracer flux call adv_Ecompart_hor_spctrl_superbee( & vel & - , E(ti,:,:) & + , E(:,:,ti) & , gradxy_n & , flx_uv & , partit & , mesh & , .True. & ! do 2nd order in space & time - , .True. & ! enforce positive definit + , .True. & ! enforce positive definit ) - + ! apply reflective coastal BC: redirect coast-directed fluxes into mirror bins - call apply_reflect_bc_spctrl( flx_uv & + call apply_reflect_bc_spctrl( flx_uv & , refl_src & , refl_bin & - , refl_sgn & + , refl_sgn & , vol_s & , partit & - , mesh & + , mesh & ) - + !_______________________________________________________________________ ! compute cross spectral superbee advected tracer flux call adv_Ecompart_crss_spctrl_superbee( & cs & - , E(ti,:,:) & + , E(:,:,ti) & , dphit & , flx_cs & , partit & @@ -2804,16 +2801,16 @@ subroutine hsintegrate_Ecompart( & , .True. & ! do 2nd order in space & time , .True. & ! enforce positive definit ) - + !_______________________________________________________________________ - ! compute flux divergence + ! compute flux divergence call adv_Ecompart_flx2tra_spctrl( & flx_uv & ,flx_cs & ,refl_src & ,refl_node & - ,Edivh(ti,:,:) & - ,Edivs(ti,:,:) & + ,Edivh(:,:,ti) & + ,Edivs(:,:,ti) & ,dphit & ,vol_s & ,partit & @@ -2841,18 +2838,18 @@ subroutine hsintegrate_Ecompart( & do node= 1, myDim_nod2d inv_denom = 1.0_WP / (1.0_WP + dt*tauE(node)) do fbini=2,nfbin-1 - E(tip1, fbini, node) = ( E(ti, fbini, node) & + E(fbini, node, tip1) = ( E(fbini, node, ti) & + dt * ( & - + (1.5_WP+idemix2_AB_epsilon)*Edivh(ti , fbini, node) & - - (0.5_WP+idemix2_AB_epsilon)*Edivh(tim1, fbini, node) & - + (1.5_WP+idemix2_AB_epsilon)*Edivs(ti , fbini, node) & - - (0.5_WP+idemix2_AB_epsilon)*Edivs(tim1, fbini, node) & - + forc( fbini, node) & + + (1.5_WP+idemix2_AB_epsilon)*Edivh(fbini, node, ti ) & + - (0.5_WP+idemix2_AB_epsilon)*Edivh(fbini, node, tip1) & + + (1.5_WP+idemix2_AB_epsilon)*Edivs(fbini, node, ti ) & + - (0.5_WP+idemix2_AB_epsilon)*Edivs(fbini, node, tip1) & + + forc( fbini, node) & ) & ) * inv_denom end do - E(tip1, 1, node) = E(tip1, nfbin-1, node) - E(tip1, nfbin, node) = E(tip1, 2, node) + E( 1, node, tip1) = E(nfbin-1, node, tip1) + E(nfbin, node, tip1) = E( 2, node, tip1) end do !_______________________________________________________________________ ! Forward Euler + implicit dissipation @@ -2860,49 +2857,49 @@ subroutine hsintegrate_Ecompart( & do node= 1, myDim_nod2d inv_denom = 1.0_WP / (1.0_WP + dt*tauE(node)) do fbini=2,nfbin-1 - E(tip1, fbini, node) = ( E(ti, fbini, node) & + E(fbini, node, tip1) = ( E(fbini, node, ti) & + dt * ( & - + Edivh(ti, fbini, node) & ! div(c_uv*E^n) - + Edivs(ti, fbini, node) & ! d/dphi (w*E^n) - + forc( fbini, node) & ! forc + + Edivh(fbini, node, ti) & ! div(c_uv*E^n) + + Edivs(fbini, node, ti) & ! d/dphi (w*E^n) + + forc( fbini, node) & ! forc ) & ) * inv_denom end do - E(tip1, 1, node) = E(tip1, nfbin-1, node) - E(tip1, nfbin, node) = E(tip1, 2, node) + E( 1, node, tip1) = E(nfbin-1, node, tip1) + E(nfbin, node, tip1) = E( 2, node, tip1) end do - end if - + end if + !_______________________________________________________________________ ! additional diagnostics - if (present(Edt)) Edt(:,:) = (E(tip1, :, 1:myDim_nod2D)-E(ti, :, 1:myDim_nod2D)) - - if (present(Eadvh)) then - if (flag_AB2) then - Eadvh(:,:) = ((1.5+idemix2_AB_epsilon)*Edivh(ti , :, 1:myDim_nod2D) & - - (0.5+idemix2_AB_epsilon)*Edivh(tim1, :, 1:myDim_nod2D)) - else - Eadvh(:,:) = Edivh(ti, :, 1:myDim_nod2D) - end if - end if - - if (present(Eadvs)) then - if (flag_AB2) then - Eadvs(:,:) = ((1.5+idemix2_AB_epsilon)*Edivs(ti , :, 1:myDim_nod2D) & - - (0.5+idemix2_AB_epsilon)*Edivs(tim1, :, 1:myDim_nod2D)) - else - Eadvs(:,:) = Edivs(ti, :, 1:myDim_nod2D) + if (present(Edt)) Edt(:,:) = (E(:, 1:myDim_nod2D, tip1)-E(:, 1:myDim_nod2D, ti)) + + if (present(Eadvh)) then + if (flag_AB2) then + Eadvh(:,:) = ((1.5+idemix2_AB_epsilon)*Edivh(:, 1:myDim_nod2D, ti ) & + - (0.5+idemix2_AB_epsilon)*Edivh(:, 1:myDim_nod2D, tip1)) + else + Eadvh(:,:) = Edivh(:, 1:myDim_nod2D, ti) end if - end if - + end if + + if (present(Eadvs)) then + if (flag_AB2) then + Eadvs(:,:) = ((1.5+idemix2_AB_epsilon)*Edivs(:, 1:myDim_nod2D, ti ) & + - (0.5+idemix2_AB_epsilon)*Edivs(:, 1:myDim_nod2D, tip1)) + else + Eadvs(:,:) = Edivs(:, 1:myDim_nod2D, ti) + end if + end if + if (present(Ediss)) then do node= 1, myDim_nod2d - Ediss(:,node) = - tauE(node)*E(tip1, :, node) + Ediss(:,node) = - tauE(node)*E(:, node, tip1) end do - end if - + end if + if (present(Eforc)) Eforc(:,:) = forc(:, 1:myDim_nod2D) - + if (present(Erefl)) Erefl(:,:) = refl_src(:, 1:myDim_nod2D) end subroutine hsintegrate_Ecompart @@ -3442,8 +3439,8 @@ subroutine check_flux_conservation(div_h, div_s, ti, dphit, vol_s, partit, mesh, implicit none type(t_partit), intent(inout), target :: partit type(t_mesh), intent(in), target :: mesh - real(kind=WP), intent(in) :: div_h(3, idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) - real(kind=WP), intent(in) :: div_s(3, idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: div_h(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D, 3) + real(kind=WP), intent(in) :: div_s(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D, 3) integer, intent(in) :: ti real(kind=WP), intent(in) :: dphit(idemix2_nfbin) real(kind=WP), intent(in) :: vol_s(partit%myDim_nod2D+partit%eDim_nod2D) @@ -3463,15 +3460,15 @@ subroutine check_flux_conservation(div_h, div_s, ti, dphit, vol_s, partit, mesh, lcl_divh_sum = 0.0_WP do node = 1, myDim_nod2D + eDim_nod2D ! Full extended domain: telescoping holds locally per rank do fbini = 2, idemix2_nfbin-1 ! Exclude ghost bins - lcl_divh_sum = lcl_divh_sum + div_h(ti, fbini, node)*vol_s(node) + lcl_divh_sum = lcl_divh_sum + div_h(fbini, node, ti)*vol_s(node) end do end do ! write(*,*) lcl_divh_sum, mype - + lcl_divs_sum = 0.0_WP do node = 1, myDim_nod2D ! Full extended domain: telescoping holds locally per rank do fbini = 2, idemix2_nfbin-1 ! Exclude ghost bins - lcl_divs_sum = lcl_divs_sum + div_s(ti, fbini, node)*dphit(fbini) + lcl_divs_sum = lcl_divs_sum + div_s(fbini, node, ti)*dphit(fbini) end do end do @@ -3499,7 +3496,7 @@ subroutine check_global_energy(Ecompart, ti, dphit, vol_s, forc, tauE, partit, m implicit none type(t_partit), intent(inout), target :: partit type(t_mesh), intent(in), target :: mesh - real(kind=WP), intent(in) :: Ecompart(3, idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP), intent(in) :: Ecompart(idemix2_nfbin, partit%myDim_nod2D+partit%eDim_nod2D, 3) real(kind=WP), intent(in) :: vol_s(partit%myDim_nod2D+partit%eDim_nod2D) integer, intent(in) :: ti real(kind=WP), intent(in) :: dphit(idemix2_nfbin) @@ -3526,11 +3523,11 @@ subroutine check_global_energy(Ecompart, ti, dphit, vol_s, forc, tauE, partit, m do node = 1, myDim_nod2D ! Only owned nodes lcl_vol = lcl_vol + vol_s(node) do fbini = 2, idemix2_nfbin-1 ! Exclude ghost bins - lcl_energy = lcl_energy + Ecompart(ti, fbini, node) * dphit(fbini) * vol_s(node) + lcl_energy = lcl_energy + Ecompart(fbini, node, ti) * dphit(fbini) * vol_s(node) lcl_forc = lcl_forc + forc(fbini, node) * dphit(fbini) * vol_s(node) - lcl_diss = lcl_diss + tauE(node) * Ecompart(ti, fbini, node) * dphit(fbini) * vol_s(node) - lcl_maxE = max(lcl_maxE, Ecompart(ti, fbini, node)) - lcl_minE = min(lcl_minE, Ecompart(ti, fbini, node)) + lcl_diss = lcl_diss + tauE(node) * Ecompart(fbini, node, ti) * dphit(fbini) * vol_s(node) + lcl_maxE = max(lcl_maxE, Ecompart(fbini, node, ti)) + lcl_minE = min(lcl_minE, Ecompart(fbini, node, ti)) end do end do @@ -3724,5 +3721,55 @@ end subroutine check_max_cfl ! end subroutine compute_vel_div_consistent +!_______________________________________________________________________________ +! Stage current state into slot 1 before writing restart (call before rotation). +! The two cases are mutually exclusive and complementary: +! tip1==2: fresh E is in slot 2 → copy to slot 1; div already in slot 1 (ti=1) +! tip1==1: fresh E already in slot 1; current div is in slot 2 (ti=2) → copy to slot 1 +! +! the output stream is fixed on location iwe2_E_iw(:, :, 1) thats why we need it to +! update when iwe2_tip1==2 and its a restart writing moment +subroutine prepare_idemix2_restart() + if (iwe2_tip1 == 2) then + iwe2_E_iw(:, :, 1) = iwe2_E_iw(:, :, 2) + if (allocated(iwe2_E_M2)) iwe2_E_M2(:, :, 1) = iwe2_E_M2(:, :, 2) + if (allocated(iwe2_E_niw)) iwe2_E_niw(:, :, 1) = iwe2_E_niw(:, :, 2) + else + if (allocated(iwe2_E_M2)) then + iwe2_E_M2_divh(:, :, 1) = iwe2_E_M2_divh(:, :, 2) + iwe2_E_M2_divs(:, :, 1) = iwe2_E_M2_divs(:, :, 2) + end if + if (allocated(iwe2_E_niw)) then + iwe2_E_niw_divh(:, :, 1) = iwe2_E_niw_divh(:, :, 2) + iwe2_E_niw_divs(:, :, 1) = iwe2_E_niw_divs(:, :, 2) + end if + end if +end subroutine prepare_idemix2_restart + + +!_______________________________________________________________________________ +! After loading restart: slot 1 holds saved E and div. +! E: fill slot 2 for AB bootstrap (iwe2_ti=1,iwe2_tip1=2 at restart init). +! Div: saved div goes to slot 2 (=tip1 at init, read as "previous" on first step); +! slot 1 (=ti) zeroed — it will be overwritten fresh in the first step. +subroutine apply_idemix2_restart() + iwe2_E_iw(:, :, 2) = iwe2_E_iw(:, :, 1) + if (allocated(iwe2_E_M2)) then + iwe2_E_M2(:, :, 2) = iwe2_E_M2(:, :, 1) + iwe2_E_M2_divh(:, :, 2) = iwe2_E_M2_divh(:, :, 1) + iwe2_E_M2_divh(:, :, 1) = 0.0_WP + iwe2_E_M2_divs(:, :, 2) = iwe2_E_M2_divs(:, :, 1) + iwe2_E_M2_divs(:, :, 1) = 0.0_WP + end if + if (allocated(iwe2_E_niw)) then + iwe2_E_niw(:, :, 2) = iwe2_E_niw(:, :, 1) + iwe2_E_niw_divh(:, :, 2) = iwe2_E_niw_divh(:, :, 1) + iwe2_E_niw_divh(:, :, 1) = 0.0_WP + iwe2_E_niw_divs(:, :, 2) = iwe2_E_niw_divs(:, :, 1) + iwe2_E_niw_divs(:, :, 1) = 0.0_WP + end if +end subroutine apply_idemix2_restart + + end module g_cvmix_idemix2 diff --git a/src/cvmix_driver/gen_modules_cvmix_tke.F90 b/src/cvmix_driver/gen_modules_cvmix_tke.F90 index 6ecd0d17d..62de6eef8 100644 --- a/src/cvmix_driver/gen_modules_cvmix_tke.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_tke.F90 @@ -20,7 +20,7 @@ module g_cvmix_tke use cvmix_put_get, only: cvmix_put use cvmix_kinds_and_types use g_cvmix_idemix, only: iwe_n, iwe_Tdis_n, iwe_alpha_c_n - use g_cvmix_idemix2, only: iwe2_E_iw, iwe2_E_iw_diss, iwe2_alpha_c, iwe2_taup1 + use g_cvmix_idemix2, only: iwe2_E_iw, iwe2_E_iw_diss, iwe2_alpha_c, iwe2_tip1 !___________________________________________________________________________ ! module calls from FESOM @@ -308,7 +308,7 @@ subroutine calc_cvmix_tke(dynamics, partit, mesh) tke_in3d_iwdis = -iwe_Tdis_n tke_in3d_iwealphac = iwe_alpha_c_n else if (mod(mix_scheme_nmb,10)==7) then - tke_in3d_iwe = iwe2_E_iw(iwe2_taup1,:,:) + tke_in3d_iwe = iwe2_E_iw(:,:,iwe2_tip1) tke_in3d_iwdis = -iwe2_E_iw_diss tke_in3d_iwealphac = iwe2_alpha_c end if From c89f3589e09084c07c83fb85dd4a29f9e0388260 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 5 Jun 2026 16:35:43 +0200 Subject: [PATCH 44/63] move time index to last index position, reduce the saving to 2 timeslices, to save memory --- src/io_meandata.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 98ac3c7c9..2e2e28413 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1727,7 +1727,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) ! IDEMIX2 mixing Internal-Wave-Energy diagnostics CASE ('IDEMIX2 ') if (mod(mix_scheme_nmb,10)==7) then - call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw' , 'internal wave energy ' , 'm^2/s^2', iwe2_E_iw(iwe2_taup1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw' , 'internal wave energy ' , 'm^2/s^2', iwe2_E_iw(:,:,iwe2_tip1) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_diss', 'Eiw production from dissipation', 'm^2/s^3', iwe2_E_iw_diss( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_c0' , 'Eiw vertical group velocity' , 'm/s' , iwe2_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_v0' , 'Eiw horizontal group velocity' , 'm/s' , iwe2_v0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1752,9 +1752,9 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_m2_w' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_m2_u' , 'M2 zonal propag.' , 'm/s' , iwe2_M2_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_m2_v' , 'M2 merid. propag.' , 'm/s' , iwe2_M2_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2' , 'M2 wave energy' , 'm^2/s^2' , iwe2_E_M2( iwe2_taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divh' , 'EM2 horiz wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divh(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divs' , 'EM2 crss spctr wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divs(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2' , 'M2 wave energy' , 'm^2/s^2' , iwe2_E_M2( :,:,iwe2_tip1), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divh' , 'EM2 horiz wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divh(:,:,iwe2_ti ), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_divs' , 'EM2 crss spctr wave energy diverg.' , 'm^2/s^2' , iwe2_E_M2_divs(:,:,iwe2_ti ), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Em2_strct' , 'EM2 structure function energy' , 'm^2/s^2' , iwe2_E_M2_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) ! optional diagnostic if (idemix2_diag_Ecompart) then @@ -1779,9 +1779,9 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_niw_w' , 'niw cross. spectr. propag.' , 'rad/s' , iwe2_niw_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_u' , 'niw zonal propag.' , 'm/s' , iwe2_niw_uv(1,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin,elem2D/),(/idemix2_nfbin,myDim_elem2D/), 'iwe2_niw_v' , 'niw merid. propag.' , 'm/s' , iwe2_niw_uv(2,:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw' , 'niw wave energy' , 'm^2/s^2' , iwe2_E_niw( iwe2_taup1,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divh' , 'Eniw horz wave energy diverg.' , 'm^2/s^2' , iwe2_E_niw_divh(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divs' , 'Eniw crss spctr wave energy diverg.', 'm^2/s^2' , iwe2_E_niw_divs(iwe2_tau ,:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw' , 'niw wave energy' , 'm^2/s^2' , iwe2_E_niw( :,:,iwe2_tip1), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divh' , 'Eniw horz wave energy diverg.' , 'm^2/s^2' , iwe2_E_niw_divh(:,:,iwe2_ti ), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_divs' , 'Eniw crss spctr wave energy diverg.', 'm^2/s^2' , iwe2_E_niw_divs(:,:,iwe2_ti ), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eniw_strct' , 'Eniw structure function energy' , 'm^2/s^2' , iwe2_E_niw_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) ! optional diagnostic if (idemix2_diag_Ecompart) then From e0af5450e2c8258c9493056c7c0080d9d9f29388 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 9 Jun 2026 12:41:36 +0200 Subject: [PATCH 45/63] fix bug in the vertical Eiw diffusion --- src/cvmix_driver/cvmix_idemix2.F90 | 2 +- src/cvmix_driver/gen_modules_cvmix_idemix2.F90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 2a43b8d63..cc21f5208 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -916,7 +916,7 @@ subroutine compute_vdiff_vdiss_Eiw( & dzmid(nz) = dzw(nz)*0.5_cvmix_r8 do nz = 2, nlev-1 - c0_zmid(nz-1) = dt * idemix2_const_in%tau_v * (c0(nz)+c0(nz-1))*0.5_cvmix_r8 / dzw(nz-1) + c0_zmid(nz-1) = idemix2_const_in%tau_v * (c0(nz)+c0(nz-1))*0.5_cvmix_r8 / dzw(nz-1) dzmid(nz) = (dzw(nz) + dzw(nz-1))*0.5_cvmix_r8 end do diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 391e5e463..2fd2cc4a1 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -1446,7 +1446,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) if (idemix2_enable_M2) then if (idemix2_diag_Ecompart) then call hsintegrate_Ecompart( & - iwe2_ti, iwe2_tip1 & ! IN: current and next time indices + iwe2_ti, iwe2_tip1 & ! IN: current and next time indices , 'M2' & ! IN: compartment name , iwe2_E_M2 & ! INOUT: energy array [2,nfbin,node] , iwe2_E_M2_divh & ! INOUT: horizontal divergence flux accumulator @@ -2844,7 +2844,7 @@ subroutine hsintegrate_Ecompart( & - (0.5_WP+idemix2_AB_epsilon)*Edivh(fbini, node, tip1) & + (1.5_WP+idemix2_AB_epsilon)*Edivs(fbini, node, ti ) & - (0.5_WP+idemix2_AB_epsilon)*Edivs(fbini, node, tip1) & - + forc( fbini, node) & + + forc(fbini, node) & ) & ) * inv_denom end do From 6d674fd00ccb4ebf92a8996610f6f5c3c2020622 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jun 2026 16:25:35 +0200 Subject: [PATCH 46/63] fix dissipation srf and bottom --- src/cvmix_driver/cvmix_idemix2.F90 | 24 +++++++++---------- .../gen_modules_cvmix_idemix2.F90 | 10 ++++---- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index cc21f5208..da2f320f4 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -984,21 +984,21 @@ subroutine compute_vdiff_vdiss_Eiw( & ! solve tridiagonal matrix call solve_tridiag(a_tri, b_tri, c_tri, d_tri, Eiw_new, nlev) - do nz=1,nlev - ! if (any(Eiw_new<0.0_cvmix_r8)) then - if (Eiw_new(nz)/=Eiw_new(nz) .or. Eiw_new(nz)<0.0_cvmix_r8) then - write(*,*) " }-))))°> found negative/NaN Eiw_new in vdiff", Eiw_new(nz) - write(*,*) " Eiw_old(nz)=", Eiw_old(nz) - write(*,*) " fsrf =", fsrf - write(*,*) " fbot(nz) =", fbot(nz) - write(*,*) " alpha_c(nz)=", alpha_c(nz) - write(*,*) " Eiw_max(nz)=", Eiw_max(nz) - end if - end do +! do nz=1,nlev +! ! if (any(Eiw_new<0.0_cvmix_r8)) then +! if (Eiw_new(nz)/=Eiw_new(nz) .or. Eiw_new(nz)<0.0_cvmix_r8) then +! write(*,*) " }-))))°> found negative/NaN Eiw_new in vdiff", Eiw_new(nz) +! write(*,*) " Eiw_old(nz)=", Eiw_old(nz) +! write(*,*) " fsrf =", fsrf +! write(*,*) " fbot(nz) =", fbot(nz) +! write(*,*) " alpha_c(nz)=", alpha_c(nz) +! write(*,*) " Eiw_max(nz)=", Eiw_max(nz) +! end if +! end do !___________________________________________________________________________ ! dissipation of E_iw - Eiw_diss(:) = -alpha_c(: )*Eiw_max(:)*Eiw_new(:) + Eiw_diss(2:nlev-1) = -alpha_c(2:nlev-1)*Eiw_max(2:nlev-1)*Eiw_new(2:nlev-1) !___________________________________________________________________________ ! debuggin diagnostics: diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 2fd2cc4a1..5ec0d903f 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -1598,8 +1598,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , alpha_c = iwe2_alpha_c( uln:nln , node) & !IN: wave-wave dissipation rate (1/s) , fsrf = iwe2_fsrf( node) & !IN: surface IW energy flux (m²/s³) , fbot = iwe2_fbot( uln:nln , node) & !IN: bottom tidal energy flux (m²/s³) - , Eiw_old = iwe2_E_iw(uln:nln , node, iwe2_ti) & !IN: IW energy at current time (m²/s²) - , Eiw_new = iwe2_E_iw(uln:nln , node, iwe2_tip1) & !OUT: IW energy at next time (m²/s²) + , Eiw_old = iwe2_E_iw(uln:nln , node, iwe2_ti) & !IN: IW energy at current time (m²/s²) + , Eiw_new = iwe2_E_iw(uln:nln , node, iwe2_tip1) & !OUT: IW energy at next time (m²/s²) , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & !OUT: IW dissipation rate for TKE coupling (m²/s³) , Eiw_dt = iwe2_E_iw_dt( uln:nln , node) & !OUT: optional diagnostic: total tendency , Eiw_vdif = iwe2_E_iw_vdif( uln:nln , node) & !OUT: optional diagnostic: vertical diffusion tendency @@ -1615,8 +1615,8 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , alpha_c = iwe2_alpha_c( uln:nln , node) & !IN: wave-wave dissipation rate (1/s) , fsrf = iwe2_fsrf( node) & !IN: surface IW energy flux (m²/s³) , fbot = iwe2_fbot( uln:nln , node) & !IN: bottom tidal energy flux (m²/s³) - , Eiw_old = iwe2_E_iw(uln:nln , node, iwe2_ti) & !IN: IW energy at current time (m²/s²) - , Eiw_new = iwe2_E_iw(uln:nln , node, iwe2_tip1) & !OUT: IW energy at next time (m²/s²) + , Eiw_old = iwe2_E_iw(uln:nln, node, iwe2_ti) & !IN: IW energy at current time (m²/s²) + , Eiw_new = iwe2_E_iw(uln:nln, node, iwe2_tip1) & !OUT: IW energy at next time (m²/s²) , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & !OUT: IW dissipation rate for TKE coupling (m²/s³) ) end if @@ -1634,6 +1634,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) t7 = MPI_Wtime() ! for the Diapycnal Diffusivity Induced Internal Gravity Waves...) ! Eiw^(t+1) = Eiw^(t+1) + div_h( v_0 * tau_h * grad_h(v_0*E_iw^(t)) ) + ! --> do single disffusion step explicite if ((idemix2_enable_hor_diffusion .or. idemix2_enable_hor_diff_iter) .and. idemix2_diag_Eiw) then iwe2_E_iw_hdif = 0.0_WP end if @@ -1666,6 +1667,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !_______________________________________________________________________ ! 6. add tendency due to lateral diffusion with iterative method in case of ! high resolution + ! --> do iterative disffusion step implicitly if (idemix2_enable_hor_diff_iter) then do iter=1, idemix2_hor_diff_niter if (idemix2_diag_Eiw) then From aff0c5fe6b1a641cd9a2fa1d619f82e350d6cdbc Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 10 Jun 2026 17:32:55 +0200 Subject: [PATCH 47/63] add upper ceiling threshold for internal wave energy Eiw, add smoothing option Eiw_diss, equivalent to the elem-->node interpolation present in idemix1 --- src/cvmix_driver/cvmix_idemix2.F90 | 5 +++ .../gen_modules_cvmix_idemix2.F90 | 45 ++++++++++++++++--- 2 files changed, 43 insertions(+), 7 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index da2f320f4..b5f3b9b9e 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -783,6 +783,7 @@ subroutine compute_vdiff_vdiss_Eiw( & alpha_c , & fsrf , & fbot , & + Eiw_maxthresh , & Eiw_old , & Eiw_new , & Eiw_diss , & @@ -802,6 +803,7 @@ subroutine compute_vdiff_vdiss_Eiw( & real(cvmix_r8) , intent(in) :: fsrf real(cvmix_r8) , intent(in), dimension(nlev) :: fbot ! real(cvmix_r8) , intent(in), dimension(nlev) :: fadd --> in moment no additional forcings + real(cvmix_r8) , intent(in) :: Eiw_maxthresh real(cvmix_r8) , intent(in), dimension(nlev) :: Eiw_old !___Output__________________________________________________________________ @@ -984,6 +986,9 @@ subroutine compute_vdiff_vdiss_Eiw( & ! solve tridiagonal matrix call solve_tridiag(a_tri, b_tri, c_tri, d_tri, Eiw_new, nlev) + !___________________________________________________________________________ + ! build in some upper lower Eiw bounds + Eiw_new = max(0.0_cvmix_r8, min(Eiw_maxthresh, Eiw_new)) ! do nz=1,nlev ! ! if (any(Eiw_new<0.0_cvmix_r8)) then ! if (Eiw_new(nz)/=Eiw_new(nz) .or. Eiw_new(nz)<0.0_cvmix_r8) then diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 5ec0d903f..bc4a4d832 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -44,6 +44,7 @@ module g_cvmix_idemix2 use g_dist2coast, only: compute_dist2coast use find_up_downwind_triangles_interface use par_support_interfaces, only: init_mpi_types_fbin + use gen_support, only: smooth_nod implicit none public @@ -82,7 +83,7 @@ module g_cvmix_idemix2 integer :: idemix2_nfbin=52 ! enable adding of idemix full horizontal tendency from - ! div(grad(Eiw*v0)*v0*tauh) diffusion term + ! div(grad(Eiw*v0)*v0*tauh) diffusion term --> explicit logical :: idemix2_enable_hor_diffusion = .false. ! enable idemix1 functionality of homogenous diffusion into all directions @@ -134,11 +135,18 @@ module g_cvmix_idemix2 ! total global Energy input that should be conserved if 0.0 no conservation is applied real(kind=WP) :: idemix2_botforc_Etot = 0.0_WP ! units W + !___________________________________________________________________________ + ! maximum cutoff value for interal wave energy --> is there for stability + real(kind=WP) :: idemix2_Eiw_maxthresh= 0.1 + ! apply one pass of area-weighted node smoothing to Eiw_diss after the vertical + ! implicit solve -- equivalent to the implicit elem->node smoothing in IDEMIX1 + logical :: idemix2_smooth_Eiw_diss = .false. + !___________________________________________________________________________ ! switch on extended diagnostic - logical :: idemix2_diag_Ecompart = .false. - logical :: idemix2_diag_Eiw = .false. - logical :: idemix2_diag_WWI = .false. + logical :: idemix2_diag_Ecompart= .false. + logical :: idemix2_diag_Eiw = .false. + logical :: idemix2_diag_WWI = .false. ! !___________________________________________________________________________ ! ! enable lee wave source of internal wave energy in IDEMIX2, @@ -174,6 +182,7 @@ module g_cvmix_idemix2 idemix2_enable_bot , idemix2_botforc_file , idemix2_botforc_vname , & idemix2_hrmsforc_file, idemix2_hrmsforc_vname, & idemix2_hlamforc_file, idemix2_hlamforc_vname, & + idemix2_Eiw_maxthresh, idemix2_smooth_Eiw_diss, & idemix2_diag_Ecompart, idemix2_diag_Eiw, idemix2_diag_WWI !___________________________________________________________________________ @@ -310,8 +319,17 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) " ├> idemix2_jstar = ", idemix2_jstar write(*,*) " ├> idemix2_mu0 = ", idemix2_mu0 write(*,*) " │ " -! write(*,*) " ├> idemix2_superbee_adv = ", idemix2_enable_superbee_adv + write(*,*) " ├> idemix2_scal_cn = ", idemix2_scal_cn + write(*,*) " ├> idemix2_Eiw_maxthresh = ", idemix2_Eiw_maxthresh + write(*,*) " ├> idemix2_smooth_Eiw_diss = ", idemix2_smooth_Eiw_diss + write(*,*) " │ " write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB + write(*,*) " │ └> idemix2_AB_epsilon = ", idemix2_AB_epsilon + write(*,*) " │ " + write(*,*) " ├> idemix2_enable_hor_diffusion= ", idemix2_enable_hor_diffusion + write(*,*) " ├> idemix2_enable_hor_diff_iter= ", idemix2_enable_hor_diff_iter + write(*,*) " │ └> idemix2_hor_diff_niter = ", idemix2_hor_diff_niter + write(*,*) " │ " write(*,*) " ├> idemix2_nfbin = ", idemix2_nfbin write(*,*) " │ " write(*,*) " ├> idemix2_enable_M2 = ", idemix2_enable_M2 @@ -339,7 +357,12 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) " ├> idemix2_hlamforc_file = ", trim(idemix2_hlamforc_file) write(*,*) " │ └> idemix2_hlamforc_vname = ", trim(idemix2_hlamforc_vname) write(*,*) " │ " - WRITE(*,*) " └> idemix2_shelf_dist = ", idemix2_shelf_dist + WRITE(*,*) " ├> idemix2_shelf_dist = ", idemix2_shelf_dist + write(*,*) " │ " + write(*,*) " ├> diagnostic switches " + write(*,*) " │ ├> idemix2_diag_Ecompart = ", idemix2_diag_Ecompart + write(*,*) " │ └> idemix2_diag_Eiw = ", idemix2_diag_Eiw + write(*,*) " │ └> idemix2_diag_WWI = ", idemix2_diag_WWI write(*,*) write(*,*) " IDEMIX2 inputs:" end if @@ -1598,6 +1621,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , alpha_c = iwe2_alpha_c( uln:nln , node) & !IN: wave-wave dissipation rate (1/s) , fsrf = iwe2_fsrf( node) & !IN: surface IW energy flux (m²/s³) , fbot = iwe2_fbot( uln:nln , node) & !IN: bottom tidal energy flux (m²/s³) + , Eiw_maxthresh = idemix2_Eiw_maxthresh & !IN: , Eiw_old = iwe2_E_iw(uln:nln , node, iwe2_ti) & !IN: IW energy at current time (m²/s²) , Eiw_new = iwe2_E_iw(uln:nln , node, iwe2_tip1) & !OUT: IW energy at next time (m²/s²) , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & !OUT: IW dissipation rate for TKE coupling (m²/s³) @@ -1615,6 +1639,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , alpha_c = iwe2_alpha_c( uln:nln , node) & !IN: wave-wave dissipation rate (1/s) , fsrf = iwe2_fsrf( node) & !IN: surface IW energy flux (m²/s³) , fbot = iwe2_fbot( uln:nln , node) & !IN: bottom tidal energy flux (m²/s³) + , Eiw_maxthresh = idemix2_Eiw_maxthresh & !IN: , Eiw_old = iwe2_E_iw(uln:nln, node, iwe2_ti) & !IN: IW energy at current time (m²/s²) , Eiw_new = iwe2_E_iw(uln:nln, node, iwe2_tip1) & !OUT: IW energy at next time (m²/s²) , Eiw_diss = iwe2_E_iw_diss( uln:nln , node) & !OUT: IW dissipation rate for TKE coupling (m²/s³) @@ -1624,7 +1649,13 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !$OMP END PARALLEL DO t7 = MPI_Wtime() time_Eiw_vdiff = t7 - t6 - + + !_______________________________________________________________________ + ! One-pass area-weighted node smoothing of Eiw_diss -- equivalent to the + ! implicit elem->node smoothing that IDEMIX1 applies to its dissipation field + ! should benefit long term stability + if (idemix2_smooth_Eiw_diss) call smooth_nod(iwe2_E_iw_diss, 1, partit, mesh) + !_______________________________________________________________________ ! Exchange E_iw after vertical diffusion - needed for horizontal diffusion gradients call exchange_nod(iwe2_E_iw(:, :, iwe2_tip1), partit) From df62f65bab647d79d4b934b416818a46b77b4334 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jun 2026 14:07:47 +0200 Subject: [PATCH 48/63] add smoothing option for Eiw, Eiw_diss and alpha_c, fields that are seen by tke. It turns out that the idemix2 only mode (no EM2, Eniw) suffers from occasionally winter blowup hickups that require the smoothing of these fields to get the blowups away --- config/namelist.cvmix | 29 +++-- .../gen_modules_cvmix_idemix2.F90 | 121 ++++++++++++------ 2 files changed, 105 insertions(+), 45 deletions(-) diff --git a/config/namelist.cvmix b/config/namelist.cvmix index 8f3bad0f4..2d5c9d050 100644 --- a/config/namelist.cvmix +++ b/config/namelist.cvmix @@ -91,20 +91,26 @@ idemix2_jstar = 5.0 ! spectral bandwidth in vertical modes [dim idemix2_mu0 = 0.33333333 ! dissipation parameter [dimensionless] ! --- superbee-spectral advection scheme and Adams-Bashfort timestepping --- -! idemix2_enable_superbee_adv= .false. -idemix2_enable_AB_timestep = .false. +idemix2_enable_AB = .true. +idemix2_AB_epsilon = 0.1_WP ! --- Number of used spectral frequency bins idemix2_nfbin = 52 -! ensures idemix1 functionality -idemix2_enable_hor_diffusion = .false. -idemix2_enable_hor_diff_iter = .false. ! from Pollman et al. (2017) +! --- ensures idemix1 functionality --- +idemix2_enable_hor_diff_expl = .false. +idemix2_enable_hor_diff_impl_iter = .true. ! from Pollman et al. (2017) idemix2_hor_diff_niter = 5 ! --- shelf definition as distance from coast in meters idemix2_shelf_dist = 300.e3 +! --- scal down baroclinic wave speed when not all modes are used --- +idemix2_scal_cn = 1.0 + +! --- maximum cutoff value for interal wave energy --- +idemix2_Eiw_maxthresh= 0.1 + ! --- M2 Forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) --- idemix2_enable_M2 = .false. idemix2_M2forc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_IT_forc_M2modes1-2_aniso.nc' @@ -122,10 +128,10 @@ idemix2_enable_bot = .true. idemix2_botforc_file = '/albedo/pool/FESOM/fesom2.0/forcing/idemix/forcing_idemix_final_bin/FIN_STORMTIDE2_M2_plus_NYCANDER_CnoM2_bin_0.40deg.nc' ! path to bottom forcing file, idemix2_botforc_vname = 'stormt_M2_plus_nycand_CnoM2' ! variable name in bottom forcing file -! --- Lee-Wave Forcing --- -idemix2_enable_leew = .false. -idemix2_leewforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_lee_forc_Eden.nc' -idemix2_leewforc_vname= 'C_lee' +! ! --- Lee-Wave Forcing --- +! idemix2_enable_leew = .false. +! idemix2_leewforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_lee_forc_Eden.nc' +! idemix2_leewforc_vname= 'C_lee' ! --- Root Mean Square Topographic Height forcing --- idemix2_hrmsforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_hrms_Goff2023.nc' @@ -134,6 +140,11 @@ idemix2_hrmsforc_vname= 'HRMS' ! --- Characteristic horizontal length scale of topographic feature --- idemix2_hlamforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_lambda_Goff2010.nc' idemix2_hlamforc_vname= 'LAMBDA' + +! --- diagnostics +idemix2_diag_Ecompart = .false. +idemix2_diag_Eiw = .false. +idemix2_diag_WWI = .false. / ! ============================================================================ diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index bc4a4d832..d7449ae6d 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -44,7 +44,7 @@ module g_cvmix_idemix2 use g_dist2coast, only: compute_dist2coast use find_up_downwind_triangles_interface use par_support_interfaces, only: init_mpi_types_fbin - use gen_support, only: smooth_nod + use g_support, only: smooth_nod implicit none public @@ -84,10 +84,10 @@ module g_cvmix_idemix2 ! enable adding of idemix full horizontal tendency from ! div(grad(Eiw*v0)*v0*tauh) diffusion term --> explicit - logical :: idemix2_enable_hor_diffusion = .false. + logical :: idemix2_enable_hor_diff_expl = .false. ! enable idemix1 functionality of homogenous diffusion into all directions - logical :: idemix2_enable_hor_diff_iter = .false. + logical :: idemix2_enable_hor_diff_impl_iter = .false. integer :: idemix2_hor_diff_niter = 5 ! from Pollman et al. (2017) ! define shelf is defined as distance from coast (default 300km) @@ -138,9 +138,13 @@ module g_cvmix_idemix2 !___________________________________________________________________________ ! maximum cutoff value for interal wave energy --> is there for stability real(kind=WP) :: idemix2_Eiw_maxthresh= 0.1 - ! apply one pass of area-weighted node smoothing to Eiw_diss after the vertical - ! implicit solve -- equivalent to the implicit elem->node smoothing in IDEMIX1 - logical :: idemix2_smooth_Eiw_diss = .false. + ! Option A: smooth IDEMIX2 internal fields to improve long-term stability. + ! All flags default to .false. so Option B (TKE-interface smoothing in + ! gen_modules_cvmix_tke.F90) is tested first. + logical :: idemix2_smooth_Eiw_diss = .false. ! smooth iwe2_E_iw_diss after vertical solve + logical :: idemix2_smooth_Eiw = .false. ! smooth iwe2_E_iw(:,:,tip1) after wave-wave + logical :: idemix2_smooth_alpha_c = .false. ! smooth iwe2_alpha_c after parameter loop + integer :: idemix2_smooth_niter = 1 !___________________________________________________________________________ ! switch on extended diagnostic @@ -173,7 +177,7 @@ module g_cvmix_idemix2 namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, idemix2_scal_cn, & idemix2_enable_AB, idemix2_nfbin, & ! idemix2_enable_superbee_adv - idemix2_enable_hor_diffusion, idemix2_enable_hor_diff_iter, idemix2_hor_diff_niter, & + idemix2_enable_hor_diff_expl, idemix2_enable_hor_diff_impl_iter, idemix2_hor_diff_niter, & idemix2_shelf_dist, & idemix2_botforc_Etot, & idemix2_enable_M2 , idemix2_M2forc_file , idemix2_M2forc_vname , idemix2_M2forc_zname, & @@ -182,7 +186,8 @@ module g_cvmix_idemix2 idemix2_enable_bot , idemix2_botforc_file , idemix2_botforc_vname , & idemix2_hrmsforc_file, idemix2_hrmsforc_vname, & idemix2_hlamforc_file, idemix2_hlamforc_vname, & - idemix2_Eiw_maxthresh, idemix2_smooth_Eiw_diss, & + idemix2_Eiw_maxthresh, & + idemix2_smooth_Eiw_diss, idemix2_smooth_Eiw, idemix2_smooth_alpha_c, idemix2_smooth_niter, & idemix2_diag_Ecompart, idemix2_diag_Eiw, idemix2_diag_WWI !___________________________________________________________________________ @@ -283,7 +288,7 @@ subroutine init_cvmix_idemix2(partit, mesh) character(len=cvmix_strlen) :: nmlfile logical :: file_exist=.False. integer :: node_size, elem_size, elem, node, nfbin, & - fbin_i, elnodes(3), nzmax + fbin_i, elnodes(3), nzmax, nlu, nln, nz real(kind=WP) :: loc_Etot=0.0_WP, glb_Etot=0.0_WP real(kind=WP) :: t0, t1 #include "../associate_part_def.h" @@ -321,13 +326,16 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) " │ " write(*,*) " ├> idemix2_scal_cn = ", idemix2_scal_cn write(*,*) " ├> idemix2_Eiw_maxthresh = ", idemix2_Eiw_maxthresh - write(*,*) " ├> idemix2_smooth_Eiw_diss = ", idemix2_smooth_Eiw_diss + write(*,*) " ├> idemix2_smooth_Eiw_diss = ", idemix2_smooth_Eiw_diss, " (Option A: smooth Eiw_diss after vdiff)" + write(*,*) " ├> idemix2_smooth_Eiw = ", idemix2_smooth_Eiw, " (Option A: smooth Eiw tip1 after wave-wave)" + write(*,*) " ├> idemix2_smooth_alpha_c = ", idemix2_smooth_alpha_c, " (Option A: smooth alpha_c after param loop)" + write(*,*) " │ └> idemix2_smooth_niter = ", idemix2_smooth_niter write(*,*) " │ " write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB write(*,*) " │ └> idemix2_AB_epsilon = ", idemix2_AB_epsilon write(*,*) " │ " - write(*,*) " ├> idemix2_enable_hor_diffusion= ", idemix2_enable_hor_diffusion - write(*,*) " ├> idemix2_enable_hor_diff_iter= ", idemix2_enable_hor_diff_iter + write(*,*) " ├> idemix2_enable_hor_diff_expl= ", idemix2_enable_hor_diff_expl + write(*,*) " ├> idemix2_enable_hor_diff_impl_iter= ", idemix2_enable_hor_diff_impl_iter write(*,*) " │ └> idemix2_hor_diff_niter = ", idemix2_hor_diff_niter write(*,*) " │ " write(*,*) " ├> idemix2_nfbin = ", idemix2_nfbin @@ -940,13 +948,43 @@ subroutine init_cvmix_idemix2(partit, mesh) end if ! --> if (idemix2_enable_M2 .or. idemix2_enable_niw ) then !_______________________________________________________________________ - ! convert elemental bot forcing into nodal bottom forcing + ! convert elemental bot forcing into nodal bottom forcing do elem = 1, myDim_elem2D - nzmax = nlevels(elem) + nzmax = nlevels(elem) elnodes = elem2d_nodes(:,elem) - iwe2_fbot(nzmax, elnodes(:)) = iwe2_fbot(nzmax, elnodes(:)) + iwe2_fbot_e(elem)/3.0 + iwe2_fbot(nzmax, elnodes(:)) = iwe2_fbot(nzmax, elnodes(:)) + iwe2_fbot_e(elem) * elem_area(elem) / 3.0_WP end do - + do node = 1, myDim_nod2D + nlu = nlevels_nod2D_min(node) + nln = nlevels_nod2D(node) + do nz = nlu, nln + if (iwe2_fbot(nz, node)==0.0_WP) cycle + iwe2_fbot(nz,node) = iwe2_fbot(nz, node) / (area(nz-1, node)-area(nz, node)) + end do + end do + +! !_______________________________________________________________________ +! ! diagnostic: compare elemental vs nodal area-weighted total bottom energy +! loc_Etot = 0.0_WP +! do elem = 1, myDim_elem2D +! if (elem2D_nodes(1,elem) <= myDim_nod2D) then +! loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot_e(elem) +! end if +! end do +! call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) +! if (mype==0) write(*,*) ' ├> IDEMIX2 Etot_bot elemental (post-scatter): ', glb_Etot*density_0*1.0e-12, ' TW' +! +! loc_Etot = 0.0_WP +! do node = 1, myDim_nod2D +! nlu =ulevels_nod2D(node)+1 +! nln =nlevels_nod2D(node) +! do nz = nlu, nln +! loc_Etot = loc_Etot + (area(nz-1, node)-area(nz, node))*iwe2_fbot(nz, node) +! end do +! end do +! call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) +! if (mype==0) write(*,*) ' └> IDEMIX2 Etot_bot nodal (post-scatter): ', glb_Etot*density_0*1.0e-12, ' TW' + !_______________________________________________________________________ ! compute centroid distance from nearset coastal point together with ! idemix2_shelf_dist defines what is shelf and what not @@ -987,8 +1025,8 @@ subroutine init_cvmix_idemix2(partit, mesh) , enable_M2 = idemix2_enable_M2 & !IN: activate M2 tidal compartment , enable_niw = idemix2_enable_niw & !IN: activate NIW compartment , enable_AB_timestep = idemix2_enable_AB & !IN: use Adams-Bashforth 2nd-order time stepping - , enable_hor_diffusion= idemix2_enable_hor_diffusion & !IN: enable horizontal Laplacian diffusion - , enable_hor_diff_iter= idemix2_enable_hor_diff_iter & !IN: use iterative horizontal diffusion + , enable_hor_diffusion= idemix2_enable_hor_diff_expl & !IN: enable horizontal Laplacian diffusion + , enable_hor_diff_iter= idemix2_enable_hor_diff_impl_iter & !IN: use iterative horizontal diffusion , hor_diff_niter = idemix2_hor_diff_niter & !IN: number of horizontal diffusion iterations ! enable_superbee_adv = idemix2_enable_superbee_adv & ) @@ -1351,7 +1389,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) !$OMP END PARALLEL DO t1 = MPI_Wtime() time_params = t1 - t0 - + !___________________________________________________________________________ if (idemix2_enable_M2 .or. idemix2_enable_niw) then !_______________________________________________________________________ @@ -1609,7 +1647,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! - alpha_c*Eiw^(t+1) ! + Forc^(t) ] !$OMP PARALLEL DO PRIVATE(node, uln, nln) - do node = 1, myDim_nod2D + do node = 1, myDim_nod2D+eDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) if (idemix2_diag_Eiw) then @@ -1651,14 +1689,10 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) time_Eiw_vdiff = t7 - t6 !_______________________________________________________________________ - ! One-pass area-weighted node smoothing of Eiw_diss -- equivalent to the - ! implicit elem->node smoothing that IDEMIX1 applies to its dissipation field - ! should benefit long term stability - if (idemix2_smooth_Eiw_diss) call smooth_nod(iwe2_E_iw_diss, 1, partit, mesh) - - !_______________________________________________________________________ - ! Exchange E_iw after vertical diffusion - needed for horizontal diffusion gradients - call exchange_nod(iwe2_E_iw(:, :, iwe2_tip1), partit) + ! Exchange E_iw(..., tp1) after vertical diffusion - needed for horizontal diffusion gradients + if (idemix2_enable_hor_diff_expl .or. idemix2_enable_hor_diff_impl_iter) then + call exchange_nod(iwe2_E_iw(:, :, iwe2_tip1), partit) + end if !_______________________________________________________________________ ! 5. add lateral diffusion term (see. Olbers D., Eden C., 2013, A Global Model @@ -1666,10 +1700,14 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! for the Diapycnal Diffusivity Induced Internal Gravity Waves...) ! Eiw^(t+1) = Eiw^(t+1) + div_h( v_0 * tau_h * grad_h(v_0*E_iw^(t)) ) ! --> do single disffusion step explicite - if ((idemix2_enable_hor_diffusion .or. idemix2_enable_hor_diff_iter) .and. idemix2_diag_Eiw) then + if ((idemix2_enable_hor_diff_expl .or. idemix2_enable_hor_diff_impl_iter) .and. idemix2_diag_Eiw) then iwe2_E_iw_hdif = 0.0_WP end if - if (idemix2_enable_hor_diffusion) then + if (idemix2_enable_hor_diff_expl) then + ! Exchange E_iw(...,ti) halo after vertical diffusion - needed for explicite + ! horizontal diffusion gradients + call exchange_nod(iwe2_E_iw(:, :, iwe2_ti), partit) + if (idemix2_diag_Eiw) then call compute_hdiff_Eiw( & iwe2_E_iw(:, :, iwe2_ti) & ! IN: IW energy at current time @@ -1693,13 +1731,11 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) end if end if - - !_______________________________________________________________________ ! 6. add tendency due to lateral diffusion with iterative method in case of ! high resolution ! --> do iterative disffusion step implicitly - if (idemix2_enable_hor_diff_iter) then + if (idemix2_enable_hor_diff_impl_iter) then do iter=1, idemix2_hor_diff_niter if (idemix2_diag_Eiw) then call compute_hdiff_Eiw( & @@ -1722,6 +1758,10 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , mesh & ! IN ) end if + + ! refresh iwe2_E_iw(:, :, iwe2_tip1) halo for the next diffusive + ! iteration call + call exchange_nod(iwe2_E_iw(:, :, iwe2_tip1), partit) end do end if t8 = MPI_Wtime() @@ -1732,7 +1772,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) t8 = MPI_Wtime() if (idemix2_enable_M2 .or. idemix2_enable_niw) then !$OMP PARALLEL DO PRIVATE(node, uln, nln) - do node = 1, myDim_nod2D + do node = 1, myDim_nod2D+eDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) !_______________________________________________________________ @@ -1783,7 +1823,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) ) end if - + elseif (idemix2_enable_M2) then if (idemix2_diag_WWI) then call cvmix_idemix2_compute_Eiw_waveinteract( & @@ -1863,6 +1903,15 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) t9 = MPI_Wtime() time_waveint = t9 - t8 + !_______________________________________________________________________ + ! Option A: smooth IDEMIX2 internal fields before TKE reads them. + ! No prior exchange needed: vdiff and wave-wave loops are extended to + ! myDim_nod2D+eDim_nod2D so all three fields carry fresh halo values. + ! smooth_nod calls exchange_nod internally at its end. + if (idemix2_smooth_Eiw) call smooth_nod(iwe2_E_iw(:, :, iwe2_tip1) , idemix2_smooth_niter, partit, mesh) + if (idemix2_smooth_Eiw_diss) call smooth_nod(iwe2_E_iw_diss , idemix2_smooth_niter, partit, mesh) + if (idemix2_smooth_alpha_c) call smooth_nod(iwe2_alpha_c , idemix2_smooth_niter, partit, mesh) + !_______________________________________________________________________ ! 8. write IDEMIX2 diffusivities and viscositie to FESOM only when IDEMIX2 is t9 = MPI_Wtime() @@ -3403,7 +3452,7 @@ subroutine compute_hdiff_Eiw( & end if end do - end if + end if end subroutine compute_hdiff_Eiw From ca3f0e6bb5c0527faa57c869b239ea85f74769e8 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jun 2026 14:09:55 +0200 Subject: [PATCH 49/63] add smoothing option for Eiw, Eiw_diss and alpha_c, fields that are seen by tke. It turns out that the idemix2 only mode (no EM2, Eniw) suffers from occasionally winter blowup hickups that require the smoothing of these fields to get the blowups away --- config/namelist.cvmix | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/config/namelist.cvmix b/config/namelist.cvmix index 2d5c9d050..8c195e84f 100644 --- a/config/namelist.cvmix +++ b/config/namelist.cvmix @@ -141,6 +141,13 @@ idemix2_hrmsforc_vname= 'HRMS' idemix2_hlamforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_lambda_Goff2010.nc' idemix2_hlamforc_vname= 'LAMBDA' +! --- apply one pass of area-weighted node smoothin after wave-wave interaction +! --- the idemix2 only mode (no EM2 or Eniw) needs some additional smoothing otherwise instable +idemix2_smooth_Eiw_diss= .false. +idemix2_smooth_Eiw = .false. ! smooth iwe2_E_iw(:,:,tip1) after wave-wave +idemix2_smooth_alpha_c = .false. ! smooth iwe2_alpha_c after parameter loop +idemix2_smooth_niter = 1 + ! --- diagnostics idemix2_diag_Ecompart = .false. idemix2_diag_Eiw = .false. From 3292eef395ba4f99b21d3bf9da262e13cf52bcfb Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jun 2026 14:19:28 +0200 Subject: [PATCH 50/63] delete comment from namelist --- config/namelist.cvmix | 5 ----- 1 file changed, 5 deletions(-) diff --git a/config/namelist.cvmix b/config/namelist.cvmix index 8c195e84f..96e9130d3 100644 --- a/config/namelist.cvmix +++ b/config/namelist.cvmix @@ -128,11 +128,6 @@ idemix2_enable_bot = .true. idemix2_botforc_file = '/albedo/pool/FESOM/fesom2.0/forcing/idemix/forcing_idemix_final_bin/FIN_STORMTIDE2_M2_plus_NYCANDER_CnoM2_bin_0.40deg.nc' ! path to bottom forcing file, idemix2_botforc_vname = 'stormt_M2_plus_nycand_CnoM2' ! variable name in bottom forcing file -! ! --- Lee-Wave Forcing --- -! idemix2_enable_leew = .false. -! idemix2_leewforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_lee_forc_Eden.nc' -! idemix2_leewforc_vname= 'C_lee' - ! --- Root Mean Square Topographic Height forcing --- idemix2_hrmsforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_hrms_Goff2023.nc' idemix2_hrmsforc_vname= 'HRMS' From 3aeb3d0e86bdea26f1aec1040a06852fa92bfc4c Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 12 Jun 2026 15:52:59 +0200 Subject: [PATCH 51/63] fix minor issues --- .../gen_modules_cvmix_idemix2.F90 | 170 +++++++----------- src/io_meandata.F90 | 2 +- 2 files changed, 63 insertions(+), 109 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index d7449ae6d..ac116ad4f 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -176,7 +176,7 @@ module g_cvmix_idemix2 character(MAX_PATH):: idemix2_hlamforc_vname= 'LAMBDA_G10' namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, idemix2_scal_cn, & - idemix2_enable_AB, idemix2_nfbin, & ! idemix2_enable_superbee_adv + idemix2_enable_AB, idemix2_AB_epsilon, idemix2_nfbin, & ! idemix2_enable_superbee_adv idemix2_enable_hor_diff_expl, idemix2_enable_hor_diff_impl_iter, idemix2_hor_diff_niter, & idemix2_shelf_dist, & idemix2_botforc_Etot, & @@ -241,13 +241,12 @@ module g_cvmix_idemix2 ! --- forcing realted variables --- real(kind=WP), allocatable, dimension(:) :: iwe2_topo_hrms, iwe2_topo_hlam, iwe2_topo_dist - real(kind=WP), allocatable, dimension(:) :: iwe2_fbot_e, iwe2_fleew, iwe2_fsrf + real(kind=WP), allocatable, dimension(:) :: iwe2_fleew, iwe2_fsrf, iwe2_fbot_n real(kind=WP), allocatable, dimension(:,:) :: iwe2_fbot ! --- support variables --- real(kind=WP), allocatable, dimension(:) :: vol_nodB2T real(kind=WP), allocatable, dimension(:,:) :: vol_wcelli - integer , allocatable, dimension(:,:) :: edge_up_dn_tri real(kind=WP), allocatable, dimension(:) :: iwe2_grady_coriol, aux real(kind=WP), allocatable, dimension(:,:,:):: iwe2_gradxy_e, iwe2_gradxy_n real(kind=WP), allocatable, dimension(:,: ):: iwe2_flx_uv, iwe2_flx_w @@ -428,26 +427,26 @@ subroutine init_cvmix_idemix2(partit, mesh) ! M2 energy dissipation allocate(iwe2_alpha_M2_c(node_size)) iwe2_alpha_M2_c(:) = 0.0_WP - + ! M2 dissipation timescale allocate(iwe2_M2_tau(node_size)) iwe2_M2_tau(:) = 0.0_WP - + ! M2 cross spectral propagation at elements allocate(w_M2_e(nfbin)) w_M2_e(:) = 0.0_WP - + ! M2 zonal/merid group velocity, and cross spectral propagation ! at vertices allocate(iwe2_M2_uv(2, nfbin,elem_size)) allocate(iwe2_M2_w( nfbin,node_size)) iwe2_M2_uv(:,:,:) = 0.0_WP iwe2_M2_w(:,:) = 0.0_WP - + ! M2 forcing allocate(iwe2_fM2(nfbin, node_size)) iwe2_fM2(:,:) = 0.0_WP - + ! M2 wave energy, and divergence of M2 wave energy ! index (..., 1:3) timestep index E^(n-1), E^(n), E^(n+1) allocate( iwe2_E_M2( nfbin, node_size, 2) & @@ -457,19 +456,19 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_M2( :,:,:)= 0.0_WP iwe2_E_M2_divh( :,:,:)= 0.0_WP iwe2_E_M2_divs( :,:,:)= 0.0_WP - + ! structure function for M2 energy allocate(iwe2_E_M2_struct(nl, node_size)) iwe2_E_M2_struct(:,:) = 0.0_WP - + ! Diagnostics if (idemix2_diag_Ecompart) then ! diagnostic for M2 spectral energy advection - allocate( iwe2_E_M2_advh(nfbin, myDim_nod2D) & - , iwe2_E_M2_advs(nfbin, myDim_nod2D) & - , iwe2_E_M2_diss(nfbin, myDim_nod2D) & - , iwe2_E_M2_forc(nfbin, myDim_nod2D) & - , iwe2_E_M2_refl(nfbin, myDim_nod2D) ) + allocate( iwe2_E_M2_advh(nfbin, node_size) & + , iwe2_E_M2_advs(nfbin, node_size) & + , iwe2_E_M2_diss(nfbin, node_size) & + , iwe2_E_M2_forc(nfbin, node_size) & + , iwe2_E_M2_refl(nfbin, node_size) ) iwe2_E_M2_advh(:,:) = 0.0_WP iwe2_E_M2_advs(:,:) = 0.0_WP iwe2_E_M2_diss(:,:) = 0.0_WP @@ -479,14 +478,14 @@ subroutine init_cvmix_idemix2(partit, mesh) if (idemix2_diag_Ecompart .or. idemix2_diag_WWI) then ! diagnostic for M2 spectral energy advection - allocate( iwe2_E_M2_dt( nfbin, myDim_nod2D) ) + allocate( iwe2_E_M2_dt( nfbin, node_size) ) iwe2_E_M2_dt( :,:) = 0.0_WP end if if (idemix2_diag_WWI) then ! diagnostic for M2 wave-wave interaction allocate( iwe2_E_iw_diss_M2( nl , node_size ) & - , iwe2_E_M2_diss_wwi(nfbin, myDim_nod2D) ) + , iwe2_E_M2_diss_wwi(nfbin, node_size) ) iwe2_E_iw_diss_M2( :,:) = 0.0_WP iwe2_E_M2_diss_wwi(:,:) = 0.0_WP end if @@ -497,26 +496,26 @@ subroutine init_cvmix_idemix2(partit, mesh) ! niw frequency allocate(iwe2_omega_niw(node_size)) iwe2_omega_niw(:) = 0.0_WP - + ! niw dissipation timescale allocate(iwe2_niw_tau(node_size)) iwe2_niw_tau(:) = 0.0_WP - + ! niw cross spectral propagation at elements allocate(w_niw_e(nfbin)) w_niw_e(:) = 0.0_WP - + ! niw zonal/merid group velocity, and cross spectral propagation ! at vertices allocate(iwe2_niw_uv(2, nfbin,elem_size)) allocate(iwe2_niw_w( nfbin,node_size)) iwe2_niw_uv(:,:,:) = 0.0_WP iwe2_niw_w(:,:) = 0.0_WP - + ! niw forcing allocate(iwe2_fniw(nfbin, node_size)) iwe2_fniw(:,:) = 0.0_WP - + ! niw wave energy, and divergence of niw wave energy ! index (..., 1:3) timestep index E^(n-1), E^(n), E^(n+1) allocate( iwe2_E_niw( nfbin, node_size, 2) & @@ -526,29 +525,29 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_niw( :,:,:)= 0.0_WP iwe2_E_niw_divh( :,:,:)= 0.0_WP iwe2_E_niw_divs( :,:,:)= 0.0_WP - + ! structure function for niw energy allocate(iwe2_E_niw_struct(nl, node_size)) iwe2_E_niw_struct(:,:) = 0.0_WP - + ! Diagnostics if (idemix2_diag_Ecompart) then ! diagnostic for niw spectral energy advection - allocate( iwe2_E_niw_advh(nfbin, myDim_nod2D) & - , iwe2_E_niw_advs(nfbin, myDim_nod2D) & - , iwe2_E_niw_diss(nfbin, myDim_nod2D) & - , iwe2_E_niw_forc(nfbin, myDim_nod2D) & - , iwe2_E_niw_refl(nfbin, myDim_nod2D) ) + allocate( iwe2_E_niw_advh(nfbin, node_size) & + , iwe2_E_niw_advs(nfbin, node_size) & + , iwe2_E_niw_diss(nfbin, node_size) & + , iwe2_E_niw_forc(nfbin, node_size) & + , iwe2_E_niw_refl(nfbin, node_size) ) iwe2_E_niw_advh(:,:) = 0.0_WP iwe2_E_niw_advs(:,:) = 0.0_WP iwe2_E_niw_diss(:,:) = 0.0_WP iwe2_E_niw_forc(:,:) = 0.0_WP iwe2_E_niw_refl(:,:) = 0.0_WP end if - + if (idemix2_diag_Ecompart .or. idemix2_diag_WWI) then ! diagnostic for niw spectral energy advection - allocate( iwe2_E_niw_dt( nfbin, myDim_nod2D)) + allocate( iwe2_E_niw_dt( nfbin, node_size)) iwe2_E_niw_dt( :,:) = 0.0_WP end if @@ -587,12 +586,12 @@ subroutine init_cvmix_idemix2(partit, mesh) endif ! forcing fields, M2 tidal forcing (spectral) and NIW forcing (spectral) - allocate( iwe2_fbot_e( myDim_elem2D) & + allocate( iwe2_fbot_n( node_size) & , iwe2_fbot(nl, node_size) & , iwe2_fsrf( node_size) & -! , iwe2_fleew( myDim_elem2D) & +! , iwe2_fleew( myDim_elem2D) & ) - iwe2_fbot_e(:) = 0.0_WP + iwe2_fbot_n(:) = 0.0_WP iwe2_fbot(:,:) = 0.0_WP iwe2_fsrf( :) = 0.0_WP ! iwe2_fleew( :) = 0.0_WP @@ -789,51 +788,38 @@ subroutine init_cvmix_idemix2(partit, mesh) inquire(file=trim(idemix2_botforc_file),exist=file_exist) if (file_exist) then if (mype==0) write(*,*) ' ├> read IDEMIX2 near tidal bottom forcing' - call read_other_NetCDF(trim(idemix2_botforc_file), trim(idemix2_botforc_vname), 1, iwe2_fbot_e, .true., .false., partit, mesh) - ! | - ! .false.=interpolate on element centroids instead of vertices <---+ - + call read_other_NetCDF(trim(idemix2_botforc_file), trim(idemix2_botforc_vname), 1, iwe2_fbot_n, .true., .true., partit, mesh) ! | | + ! .true.=NN for missing values ----------------+ | + ! .true.=interpolate to vertices ----------------------+ + ! make sure forcing is all positive no numerical negative values - iwe2_fbot_e = max(0.0_WP,iwe2_fbot_e) - - - ! check for total tidal energy that is infused through the bottom, see how - ! much is lossed during interpolation and compare with value of the - ! original files + iwe2_fbot_n = max(0.0_WP, iwe2_fbot_n) + + ! check for total tidal energy that is infused through the bottom loc_Etot = 0.0_WP - do elem=1, myDim_elem2D - ! REMEMBER!!!: the partition on elements is not unique there are - ! elements that belong to two CPUs. For unique elements the index - ! of the First trinagle node must be <= myDim_nod2D - if (elem2D_nodes(1,elem)<=myDim_nod2D) then - loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot_e(elem) - end if + do node=1, myDim_nod2D + loc_Etot = loc_Etot + area(1,node)*iwe2_fbot_n(node) end do call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) if (mype==0) write(*,*) " │ └> IDEMIX2 total tidal energy Etot_bot =", glb_Etot*1.0e-12, ' TW' - - ! normalize total tidal energy at bottom with respect to the total - ! tidal energy that is e.g in the original forcing files to accomodate - ! non concerving losses during interpolation. This is only done when + + ! normalize total tidal energy at bottom with respect to the total + ! tidal energy that is e.g in the original forcing files to accomodate + ! non concerving losses during interpolation. This is only done when ! in namelist.cvmix: idemix2_botforc_Etot \= 0.0_WP if (idemix2_botforc_Etot /= 0.0_WP) then - iwe2_fbot_e = iwe2_fbot_e * idemix2_botforc_Etot/glb_Etot - + iwe2_fbot_n = iwe2_fbot_n * idemix2_botforc_Etot/glb_Etot + loc_Etot = 0.0_WP - do elem=1, myDim_elem2D - ! REMEMBER!!!: the partition on elements is not unique there are - ! elements that belong to two CPUs. For unique elements the index - ! of the First trinagle node must be <= myDim_nod2D - if (elem2D_nodes(1,elem)<=myDim_nod2D) then - loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot_e(elem) - end if + do node=1, myDim_nod2D + loc_Etot = loc_Etot + area(1,node)*iwe2_fbot_n(node) end do call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) if (mype==0) write(*,*) " │ └> IDEMIX2 Etot_bot after normalizing =", glb_Etot*1.0e-12, ' TW' - end if - + end if + ! divide by density_0 --> convert from W/m^2 to m^3/s^3 - iwe2_fbot_e = iwe2_fbot_e/density_0 + iwe2_fbot_n = iwe2_fbot_n/density_0 else if (mype==0) then @@ -863,10 +849,10 @@ subroutine init_cvmix_idemix2(partit, mesh) ! if (mype==0) write(*,*) ' ├> read IDEMIX2 lee wave forcing --> add to bottom forcing' ! call read_other_NetCDF(trim(idemix2_leewforc_file), trim(idemix2_leewforc_vname), 1, iwe2_fleew, .true., .false., partit, mesh) ! -! iwe2_fbot_e = iwe2_fbot_e + iwe2_fleew -! ! | -! ! +-> no dividion by density_0, Lee wave Forcing -! ! already in units of m^3/s^3 +! iwe2_fbot_n = iwe2_fbot_n + iwe2_fleew +! ! | +! ! +-> no division by density_0, Lee wave Forcing +! ! already in units of m^3/s^3 ! else ! if (mype==0) then ! print *, achar(27)//'[33m' @@ -948,43 +934,16 @@ subroutine init_cvmix_idemix2(partit, mesh) end if ! --> if (idemix2_enable_M2 .or. idemix2_enable_niw ) then !_______________________________________________________________________ - ! convert elemental bot forcing into nodal bottom forcing - do elem = 1, myDim_elem2D - nzmax = nlevels(elem) - elnodes = elem2d_nodes(:,elem) - iwe2_fbot(nzmax, elnodes(:)) = iwe2_fbot(nzmax, elnodes(:)) + iwe2_fbot_e(elem) * elem_area(elem) / 3.0_WP - end do - do node = 1, myDim_nod2D + ! distribute nodal bottom flux across staircase depth levels using cap + ! area fractions: iwe2_fbot(nz,n) = fbot_n * (area(nz-1,n)-area(nz,n)) / area(1,n) + do node = 1, myDim_nod2D+eDim_nod2D nlu = nlevels_nod2D_min(node) nln = nlevels_nod2D(node) do nz = nlu, nln - if (iwe2_fbot(nz, node)==0.0_WP) cycle - iwe2_fbot(nz,node) = iwe2_fbot(nz, node) / (area(nz-1, node)-area(nz, node)) + iwe2_fbot(nz, node) = iwe2_fbot_n(node) * (area(nz-1, node) - area(nz, node)) / area(1, node) end do end do - -! !_______________________________________________________________________ -! ! diagnostic: compare elemental vs nodal area-weighted total bottom energy -! loc_Etot = 0.0_WP -! do elem = 1, myDim_elem2D -! if (elem2D_nodes(1,elem) <= myDim_nod2D) then -! loc_Etot = loc_Etot + elem_area(elem)*iwe2_fbot_e(elem) -! end if -! end do -! call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) -! if (mype==0) write(*,*) ' ├> IDEMIX2 Etot_bot elemental (post-scatter): ', glb_Etot*density_0*1.0e-12, ' TW' -! -! loc_Etot = 0.0_WP -! do node = 1, myDim_nod2D -! nlu =ulevels_nod2D(node)+1 -! nln =nlevels_nod2D(node) -! do nz = nlu, nln -! loc_Etot = loc_Etot + (area(nz-1, node)-area(nz, node))*iwe2_fbot(nz, node) -! end do -! end do -! call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) -! if (mype==0) write(*,*) ' └> IDEMIX2 Etot_bot nodal (post-scatter): ', glb_Etot*density_0*1.0e-12, ' TW' - + !_______________________________________________________________________ ! compute centroid distance from nearset coastal point together with ! idemix2_shelf_dist defines what is shelf and what not @@ -1001,10 +960,6 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_grady_coriol(elem) = sum(gradient_sca(4:6, elem)*mesh%coriolis_node(elnodes)) end do - !_______________________________________________________________________ - ! compute d/dy of coriolis - call find_up_downwind_triangles(partit, mesh, mesh%edge_up_dn_tri) - !_______________________________________________________________________ ! compute scalar cell volume from top to bottom ! --> if take the fixed standard levels (zbar) to compute the ocean volume @@ -1028,7 +983,6 @@ subroutine init_cvmix_idemix2(partit, mesh) , enable_hor_diffusion= idemix2_enable_hor_diff_expl & !IN: enable horizontal Laplacian diffusion , enable_hor_diff_iter= idemix2_enable_hor_diff_impl_iter & !IN: use iterative horizontal diffusion , hor_diff_niter = idemix2_hor_diff_niter & !IN: number of horizontal diffusion iterations - ! enable_superbee_adv = idemix2_enable_superbee_adv & ) if (partit%mype==0) write(*,*) diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 2e2e28413..2974e0684 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1732,7 +1732,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_c0' , 'Eiw vertical group velocity' , 'm/s' , iwe2_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_v0' , 'Eiw horizontal group velocity' , 'm/s' , iwe2_v0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_alpha_c' , 'Eiw dissipation coefficien' , 'none' , iwe2_alpha_c(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream( elem2D , myDim_elem2D , 'iwe2_fbot' , 'bottom forcing' , 'm^3/s^3', iwe2_fbot_e(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_fbot' , 'bottom forcing' , 'm^3/s^3', iwe2_fbot_n(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_fsrf' , 'surface forcing' , 'm^3/s^3', iwe2_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_cn' , 'baroclinic velocity' , 'm/s' , iwe2_cn(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) ! optional diagnostic From acfc40c4fbe8a9dadf439cd2ff40118db2cc7983 Mon Sep 17 00:00:00 2001 From: Patrick Date: Mon, 15 Jun 2026 15:34:32 +0200 Subject: [PATCH 52/63] fix bug in upper/lower loop boundaries idemix param and baroclinic velocity computation --- src/cvmix_driver/cvmix_idemix2.F90 | 19 +++++++++++-------- src/cvmix_driver/gen_modules_cvmix_idemix.F90 | 15 ++++++++++++--- .../gen_modules_cvmix_idemix2.F90 | 16 +++++++--------- 3 files changed, 30 insertions(+), 20 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index b5f3b9b9e..98830501e 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -331,11 +331,10 @@ subroutine compute_param( & v0(di) = max(0d0, idemix2_const_in%gamma*cstar*hofx2(fxa)) alpha_c(di) = max( 1d-4, idemix2_const_in%mu0*acosh(max(1d0,fxa))*abs(coriolis)/cstar**2 ) - ! --> ATTENTION: CHECK EFFECT OF THESE LINES !!! - !! set v0 to zero to prevent horizontal iwe propagation in mixed layer - !if ( fxa<1d0 ) then - ! v0(di) = 0d0 - !endif + ! set v0 to zero to prevent horizontal iwe propagation in mixed layer + if ( fxa<1d0 ) then + v0(di) = 0d0 + endif enddo end subroutine compute_param @@ -346,7 +345,7 @@ end subroutine compute_param !_______________________________________________________________________________ ! Compute idemix representative vertical (v0) and horizontal (c0) group velocites ! as well as the enery dissipation coefficient alpha_c -subroutine compute_compart_groupvel( & +subroutine compute_compart_groupvel( & nfbin , & coriolis , & coriol_grady , & @@ -950,12 +949,16 @@ subroutine compute_vdiff_vdiss_Eiw( & !___________________________________________________________________________ ! prepare tridiagonal matrix elements: a,b,c,d + ! alpha_c dissipation is applied only at interior levels (2:nlev-1). + ! Boundary levels (nz=1 surface, nz=nlev bottom) are excluded, consistent + ! with IDEMIX1 (iwe_Tdis(2:nlev)), to avoid feeding Kv/TKE at W-grid + ! boundary cells where forcing BCs already control tracer fluxes. nz = 1 a_tri(nz) = -dt * a_dif(nz) b_tri(nz) = 1.0_cvmix_r8 & + dt * b_dif(nz) c_tri(nz) = -dt * c_dif(nz) - + do nz=2,nlev-1 a_tri(nz) = -dt * a_dif(nz) b_tri(nz) = 1.0_cvmix_r8 & @@ -963,7 +966,7 @@ subroutine compute_vdiff_vdiss_Eiw( & + dt * alpha_c(nz)*Eiw_max(nz) c_tri(nz) = -dt * c_dif(nz) end do - + nz = nlev a_tri(nz) = -dt * a_dif(nz) b_tri(nz) = 1.0_cvmix_r8 & diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix.F90 index 2c32e9a80..45e137d97 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix.F90 @@ -239,8 +239,18 @@ subroutine init_cvmix_idemix(partit, mesh) ! only 20% of the niw-input are available to penetrate into the deeper ocean ! divide by density_0 --> convert from W/m^2 to m^3/s^3 - iwe_fsrf = iwe_fsrf/density_0 * idemix_sforcusage - + iwe_fsrf = iwe_fsrf/density_0 * idemix_sforcusage + + ! check for total surface energy that is infused, compare with IDEMIX2 Etot_srf + loc_Etot = 0.0_WP + do elem=1, myDim_elem2D + if (elem2D_nodes(1,elem)<=myDim_nod2D) then + loc_Etot = loc_Etot + elem_area(elem)*iwe_fsrf(elem)*density_0 + end if + end do + call MPI_AllREDUCE(loc_Etot, glb_Etot, 1, MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_FESOM, MPIerr) + if (mype==0) write(*,*) " --> IDEMIX total srf. energy Etot_srf =", glb_Etot*1.0e-12, ' TW' + else if (mype==0) then write(*,*) '____________________________________________________________________' @@ -301,7 +311,6 @@ subroutine init_cvmix_idemix(partit, mesh) ! divide by density_0 --> convert from W/m^2 to m^3/s^3 iwe_fbot = iwe_fbot/density_0 - else if (mype==0) then write(*,*) '____________________________________________________________________' diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index ac116ad4f..80c09f251 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -716,7 +716,7 @@ subroutine init_cvmix_idemix2(partit, mesh) trim(idemix2_niwforc_vname) , & 1 , & iwe2_fsrf , & - .false. , & ! NN for missing values + .true. , & ! NN for missing values .true. , & ! interpolate to vertices partit , & mesh & @@ -1212,6 +1212,10 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) t0 = MPI_Wtime() !$OMP PARALLEL DO PRIVATE(node, lat_n_deg, nln, uln, nz, cn, topo_shelf) do node=1, myDim_nod2D+eDim_nod2D + !___________________________________________________________________ + uln = ulevels_nod2D(node) + nln = nlevels_nod2D(node) + !___________________________________________________________________ ! re-initialse cross spectral velocites, for later accumulation through ! elemental values @@ -1222,16 +1226,10 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) lat_n_deg = geo_coord_nod2D(2,node) / rad !___________________________________________________________________ - ! compute baroclinic gravity wave speed - nln = mesh%nl - uln = 1 - do nz=1, nod_in_elem2D_num(node) - nln=min(nln, nlevels(nod_in_elem2D(nz, node))) - uln=max(uln, ulevels(nod_in_elem2D(nz, node))) - end do + ! compute baroclinic gravity wave speed cn=0.0_WP do nz=uln, nln-1 - cn=cn+hnode(nz,node)*sqrt(max(bvfreq(nz,node), 0._WP) + max(bvfreq(nz+1,node), 0._WP))/2._WP + cn=cn+hnode(nz,node)*(sqrt(max(bvfreq(nz,node), 0._WP)) + sqrt(max(bvfreq(nz+1,node), 0._WP)))/2._WP end do cn = cn/pi * idemix2_scal_cn iwe2_cn(node)=cn From c4566c5e39b869ec76596c6366165c6d32387077 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 16 Jun 2026 12:36:05 +0200 Subject: [PATCH 53/63] introduce lower cap for cn baroclinic gravity wave speed in instable stratified regions where N<0 --- .../gen_modules_cvmix_idemix2.F90 | 62 ++++++++++++------- 1 file changed, 38 insertions(+), 24 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 80c09f251..cc07a3663 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -96,6 +96,10 @@ module g_cvmix_idemix2 ! scal down baroclinic wave speed when not all modes are used real(kind=WP) :: idemix2_scal_cn = 1.0 + ! minimum cn floor: prevents cg_compart→0 in convective columns near the M2 critical latitude (~74.5°N). + ! Recommended value: 0.1 m/s (symmetric with the cstar=max(1e-2,...) floor already applied for Eiw). + real(kind=WP) :: idemix2_cn_min = 0.0 + !___________________________________________________________________________ ! enable M2 tidal component as significant source of internal wave energy in IDEMIX2, ! lower frequency modes @@ -175,7 +179,7 @@ module g_cvmix_idemix2 character(MAX_PATH):: idemix2_hlamforc_file = './idemix2_forcing_t-scattering_1deg.nc' character(MAX_PATH):: idemix2_hlamforc_vname= 'LAMBDA_G10' - namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, idemix2_scal_cn, & + namelist /param_idemix2/ idemix2_tau_v, idemix2_tau_h, idemix2_gamma, idemix2_jstar, idemix2_mu0, idemix2_scal_cn, idemix2_cn_min, & idemix2_enable_AB, idemix2_AB_epsilon, idemix2_nfbin, & ! idemix2_enable_superbee_adv idemix2_enable_hor_diff_expl, idemix2_enable_hor_diff_impl_iter, idemix2_hor_diff_niter, & idemix2_shelf_dist, & @@ -316,40 +320,40 @@ subroutine init_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ if (mype==0) then - write(*,*) " IDEMIX2 parameters:" - write(*,*) " ├> idemix2_tau_v = ", idemix2_tau_v - write(*,*) " ├> idemix2_tau_h = ", idemix2_tau_h - write(*,*) " ├> idemix2_gamma = ", idemix2_gamma - write(*,*) " ├> idemix2_jstar = ", idemix2_jstar - write(*,*) " ├> idemix2_mu0 = ", idemix2_mu0 - write(*,*) " │ " - write(*,*) " ├> idemix2_scal_cn = ", idemix2_scal_cn - write(*,*) " ├> idemix2_Eiw_maxthresh = ", idemix2_Eiw_maxthresh - write(*,*) " ├> idemix2_smooth_Eiw_diss = ", idemix2_smooth_Eiw_diss, " (Option A: smooth Eiw_diss after vdiff)" - write(*,*) " ├> idemix2_smooth_Eiw = ", idemix2_smooth_Eiw, " (Option A: smooth Eiw tip1 after wave-wave)" - write(*,*) " ├> idemix2_smooth_alpha_c = ", idemix2_smooth_alpha_c, " (Option A: smooth alpha_c after param loop)" - write(*,*) " │ └> idemix2_smooth_niter = ", idemix2_smooth_niter + write(*,*) " IDEMIX2:" + write(*,*) " ├> parameter " + write(*,*) " │ ┌──────────────────────────── " + write(*,*) " │ ├> idemix2_tau_v = ", idemix2_tau_v + write(*,*) " │ ├> idemix2_tau_h = ", idemix2_tau_h + write(*,*) " │ ├> idemix2_gamma = ", idemix2_gamma + write(*,*) " │ ├> idemix2_jstar = ", idemix2_jstar + write(*,*) " │ ├> idemix2_mu0 = ", idemix2_mu0 + write(*,*) " │ ├> idemix2_scal_cn = ", idemix2_scal_cn + write(*,*) " │ ├> idemix2_cn_min = ", idemix2_cn_min + write(*,*) " │ ├> idemix2_Eiw_maxthresh = ", idemix2_Eiw_maxthresh + write(*,*) " │ ├> idemix2...hor_diff_expl = ", idemix2_enable_hor_diff_expl + write(*,*) " │ └> idemix2...hor_diff_impl_iter= ", idemix2_enable_hor_diff_impl_iter + write(*,*) " │ └> idemix2_hor_diff_niter= ", idemix2_hor_diff_niter write(*,*) " │ " write(*,*) " ├> idemix2_AB_timestep = ", idemix2_enable_AB write(*,*) " │ └> idemix2_AB_epsilon = ", idemix2_AB_epsilon write(*,*) " │ " - write(*,*) " ├> idemix2_enable_hor_diff_expl= ", idemix2_enable_hor_diff_expl - write(*,*) " ├> idemix2_enable_hor_diff_impl_iter= ", idemix2_enable_hor_diff_impl_iter - write(*,*) " │ └> idemix2_hor_diff_niter = ", idemix2_hor_diff_niter - write(*,*) " │ " write(*,*) " ├> idemix2_nfbin = ", idemix2_nfbin write(*,*) " │ " write(*,*) " ├> idemix2_enable_M2 = ", idemix2_enable_M2 + write(*,*) " │ ┌──────────────────────────── " write(*,*) " │ └> idemix2_M2forc_file = ", trim(idemix2_M2forc_file) write(*,*) " │ ├> idemix2_M2forc_vname = ", trim(idemix2_M2forc_vname) write(*,*) " │ └> idemix2_M2forc_zname = ", trim(idemix2_M2forc_zname) write(*,*) " │ " write(*,*) " ├> idemix2_enable_niw = ", idemix2_enable_niw + write(*,*) " │ ┌──────────────────────────── " write(*,*) " │ ├> idemix2_fniw_usage = ", idemix2_fniw_usage write(*,*) " │ └> idemix2_niwforc_file = ", trim(idemix2_niwforc_file) write(*,*) " │ └> idemix2_niwforc_vname = ", trim(idemix2_niwforc_vname) write(*,*) " │ " write(*,*) " ├> idemix2_enable_bot = ", idemix2_enable_bot + write(*,*) " │ ┌──────────────────────────── " write(*,*) " │ └> idemix2_botforc_file = ", trim(idemix2_botforc_file) write(*,*) " │ ├> idemix2_botforc_vname = ", trim(idemix2_botforc_vname) write(*,*) " │ └> idemix2_botforc_Etot = ", idemix2_botforc_Etot @@ -358,17 +362,26 @@ subroutine init_cvmix_idemix2(partit, mesh) ! write(*,*) " │ └> idemix2_leewforc_file = ", trim(idemix2_leewforc_file) ! write(*,*) " │ └> idemix2_leewforc_vname= ", trim(idemix2_leewforc_vname) ! write(*,*) " │ " - write(*,*) " ├> idemix2_hrmsforc_file = ", trim(idemix2_hrmsforc_file) - write(*,*) " │ └> idemix2_hrmsforc_vname = ", trim(idemix2_hrmsforc_vname) - write(*,*) " │ " - write(*,*) " ├> idemix2_hlamforc_file = ", trim(idemix2_hlamforc_file) - write(*,*) " │ └> idemix2_hlamforc_vname = ", trim(idemix2_hlamforc_vname) + write(*,*) " ├> topographic height forcing " + write(*,*) " │ ┌──────────────────────────── " + write(*,*) " │ ├> idemix2_hrmsforc_file = ", trim(idemix2_hrmsforc_file) + write(*,*) " │ │ └> idemix2_hrmsforc_vname= ", trim(idemix2_hrmsforc_vname) + write(*,*) " │ └> idemix2_hlamforc_file = ", trim(idemix2_hlamforc_file) + write(*,*) " │ └> idemix2_hlamforc_vname= ", trim(idemix2_hlamforc_vname) write(*,*) " │ " WRITE(*,*) " ├> idemix2_shelf_dist = ", idemix2_shelf_dist write(*,*) " │ " + write(*,*) " ├> smoothing switches " + write(*,*) " │ ┌──────────────────────────── " + write(*,*) " │ ├> idemix2_smooth_Eiw_diss = ", idemix2_smooth_Eiw_diss + write(*,*) " │ ├> idemix2_smooth_Eiw = ", idemix2_smooth_Eiw + write(*,*) " │ ├> idemix2_smooth_alpha_c = ", idemix2_smooth_alpha_c + write(*,*) " │ └> idemix2_smooth_niter = ", idemix2_smooth_niter + write(*,*) " │ " write(*,*) " ├> diagnostic switches " + write(*,*) " │ ┌──────────────────────────── " write(*,*) " │ ├> idemix2_diag_Ecompart = ", idemix2_diag_Ecompart - write(*,*) " │ └> idemix2_diag_Eiw = ", idemix2_diag_Eiw + write(*,*) " │ ├> idemix2_diag_Eiw = ", idemix2_diag_Eiw write(*,*) " │ └> idemix2_diag_WWI = ", idemix2_diag_WWI write(*,*) write(*,*) " IDEMIX2 inputs:" @@ -1232,6 +1245,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) cn=cn+hnode(nz,node)*(sqrt(max(bvfreq(nz,node), 0._WP)) + sqrt(max(bvfreq(nz+1,node), 0._WP)))/2._WP end do cn = cn/pi * idemix2_scal_cn + cn = max(cn, idemix2_cn_min) iwe2_cn(node)=cn ! From cb43dc220d585066557d6bf4aae1eb567aa82453 Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 16 Jun 2026 15:23:42 +0200 Subject: [PATCH 54/63] fix IDEMIX2 smoothing: move smooth_nod from prognostic Eiw to TKE-interface copies MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problem ------- The idemix2_smooth_Eiw / _Eiw_diss / _alpha_c options were introduced to suppress a recurring cflz blowup at ~72-75°N in February caused by the following chain: deep winter mixed layer → Eiw builds to cap (Eiw_maxthresh = 0.1 m²/s²) → alpha_c spikes at ML base (quadratic dissipation: alpha_c × Eiw_old × Eiw_new) → Eiw_diss ≈ Eiw_maxthresh / dt ≈ 3.7e-5 m²/s³ at a single node → tke_in3d_iwdis → TKE source spike → Kv → cflz The three smooth_nod calls were applied inside gen_modules_cvmix_idemix2.F90 directly to the prognostic state iwe2_E_iw(:,:,tip1) and to the diagnostic fields iwe2_E_iw_diss and iwe2_alpha_c. This suppressed the blowup but had a catastrophic side effect: smooth_nod applied every timestep to a prognostic field is mathematically equivalent to adding a horizontal diffusion term with effective diffusivity D_eff ≈ Δx² / dt ≈ (50 km)² / 2700 s ≈ 930 m²/s The physical horizontal Eiw diffusion in the model is D_h = v0² × tau_h ≈ (0.009 m/s)² × 1.296×10⁶ s ≈ 105 m²/s (ML floor) ≈ 3×10⁴ m²/s (pycnocline) The artificial smoothing is therefore 10–10000× stronger than the physical horizontal diffusion. Over the years of spin-up integration, it diffuses Eiw laterally over hundreds of kilometres, homogenising the field and reducing the global Eiw integral by roughly an order of magnitude — well below IDEMIX1 — and destroying all horizontal heterogeneity that IDEMIX2 is supposed to produce from locally variable N² and bottom forcing patterns. Root cause ---------- Applying smooth_nod to iwe2_E_iw(:,:,tip1) every timestep is cumulative: the smoothed state becomes the initial condition for the next step, which is smoothed again, and so on. This accumulates over thousands of timesteps. By contrast, iwe2_E_iw_diss and iwe2_alpha_c are diagnostic fields recomputed from scratch from N² at every timestep. Smoothing them in-place before TKE reads them has no memory and does not accumulate — but smoothing them ALSO had no effect on preventing blowup, because TKE reads these fields only after the IDEMIX2 step is complete, at which point the spike in Eiw_diss originates from the unsmoothed iwe2_E_iw. Fix --- Move all three smooth_nod calls from gen_modules_cvmix_idemix2.F90 into gen_modules_cvmix_tke.F90, where they are applied to the TKE-interface copies (tke_in3d_iwe, tke_in3d_iwdis, tke_in3d_iwealphac) immediately after these arrays are filled from the IDEMIX2 module variables: tke_in3d_iwe = iwe2_E_iw(:,:,iwe2_tip1) tke_in3d_iwdis = -iwe2_E_iw_diss tke_in3d_iwealphac = iwe2_alpha_c if (idemix2_smooth_Eiw) smooth_nod(tke_in3d_iwe, ...) if (idemix2_smooth_Eiw_diss) smooth_nod(tke_in3d_iwdis, ...) if (idemix2_smooth_alpha_c) smooth_nod(tke_in3d_iwealphac, ...) These three tke_in3d_* arrays are temporary diagnostic copies refilled from scratch every timestep. Smoothing them damps the Eiw_diss spike seen by TKE without touching the prognostic iwe2_E_iw field. There is no accumulation, no effective diffusion of Eiw, and no memory across timesteps. The prognostic Eiw field is never modified by smooth_nod under this scheme. Result ------ - February 1959 cflz blowup at 72-75°N fully suppressed with idemix2_smooth_Eiw = .true., idemix2_smooth_Eiw_diss = .true. (niter=1) - Global Eiw field recovers the horizontal heterogeneity of the unsmoothed IDEMIX2 run: spatial structure at ridge, boundary current and tidal hotspot scales is preserved - IDEMIX2 Eiw consistently higher than IDEMIX1 over most of the ocean (idemix1 - idemix2 difference predominantly positive), as expected physically from the additional spectral structure in IDEMIX2 - All three smoothing flags (idemix2_smooth_Eiw, idemix2_smooth_Eiw_diss, idemix2_smooth_alpha_c) and idemix2_smooth_niter remain fully functional from the namelist; their semantics are unchanged --- src/cvmix_driver/gen_modules_cvmix_idemix2.F90 | 9 --------- src/cvmix_driver/gen_modules_cvmix_tke.F90 | 13 +++++++++++-- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index cc07a3663..4e15054d6 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -1869,15 +1869,6 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) t9 = MPI_Wtime() time_waveint = t9 - t8 - !_______________________________________________________________________ - ! Option A: smooth IDEMIX2 internal fields before TKE reads them. - ! No prior exchange needed: vdiff and wave-wave loops are extended to - ! myDim_nod2D+eDim_nod2D so all three fields carry fresh halo values. - ! smooth_nod calls exchange_nod internally at its end. - if (idemix2_smooth_Eiw) call smooth_nod(iwe2_E_iw(:, :, iwe2_tip1) , idemix2_smooth_niter, partit, mesh) - if (idemix2_smooth_Eiw_diss) call smooth_nod(iwe2_E_iw_diss , idemix2_smooth_niter, partit, mesh) - if (idemix2_smooth_alpha_c) call smooth_nod(iwe2_alpha_c , idemix2_smooth_niter, partit, mesh) - !_______________________________________________________________________ ! 8. write IDEMIX2 diffusivities and viscositie to FESOM only when IDEMIX2 is t9 = MPI_Wtime() diff --git a/src/cvmix_driver/gen_modules_cvmix_tke.F90 b/src/cvmix_driver/gen_modules_cvmix_tke.F90 index 62de6eef8..268405508 100644 --- a/src/cvmix_driver/gen_modules_cvmix_tke.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_tke.F90 @@ -20,7 +20,10 @@ module g_cvmix_tke use cvmix_put_get, only: cvmix_put use cvmix_kinds_and_types use g_cvmix_idemix, only: iwe_n, iwe_Tdis_n, iwe_alpha_c_n - use g_cvmix_idemix2, only: iwe2_E_iw, iwe2_E_iw_diss, iwe2_alpha_c, iwe2_tip1 + use g_cvmix_idemix2, only: iwe2_E_iw, iwe2_E_iw_diss, iwe2_alpha_c, iwe2_tip1, & + idemix2_smooth_Eiw, idemix2_smooth_Eiw_diss, & + idemix2_smooth_alpha_c, idemix2_smooth_niter + use g_support, only: smooth_nod !___________________________________________________________________________ ! module calls from FESOM @@ -311,7 +314,13 @@ subroutine calc_cvmix_tke(dynamics, partit, mesh) tke_in3d_iwe = iwe2_E_iw(:,:,iwe2_tip1) tke_in3d_iwdis = -iwe2_E_iw_diss tke_in3d_iwealphac = iwe2_alpha_c - end if + ! Smooth TKE-interface copies only — never the prognostic Eiw state. + ! All three arrays are recomputed each step so smoothing here has no + ! memory and does not accumulate: Eiw heterogeneity is fully preserved. + if (idemix2_smooth_Eiw) call smooth_nod(tke_in3d_iwe, idemix2_smooth_niter, partit, mesh) + if (idemix2_smooth_Eiw_diss) call smooth_nod(tke_in3d_iwdis, idemix2_smooth_niter, partit, mesh) + if (idemix2_smooth_alpha_c) call smooth_nod(tke_in3d_iwealphac, idemix2_smooth_niter, partit, mesh) + end if endif !_______________________________________________________________________ From c655a4bb21c9c197b6a3e225539103df72fa860c Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 16 Jun 2026 15:45:46 +0200 Subject: [PATCH 55/63] fix iwe2_E_iw_hdif diagnostic always zero in iterative implicit hdiff mode MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bug --- iwe2_E_iw_hdif (horizontal Eiw diffusion tendency) was always zero when idemix2_enable_hor_diff_impl_iter = .true., even with idemix2_diag_Eiw = .true. Root cause: Fortran aliasing in compute_hdiff_Eiw. The iterative implicit call passes the same array for both the Eiw_old (intent IN) and Eiw (intent INOUT) arguments: call compute_hdiff_Eiw(iwe2_E_iw(:,:,iwe2_tip1), ! Eiw_old iwe2_E_iw(:,:,iwe2_tip1), ! Eiw — same array ...) The edge loop updates Eiw in-place. The end-of-subroutine diagnostic then computed Eiw - Eiw_old, but since both point to the same memory, all differences were identically zero. The explicit mode (Eiw_old = iwe2_ti, Eiw = iwe2_tip1) would not have had this problem, but idemix2_enable_hor_- diff_expl is always .false. in practice. Fix --- Removed the optional Eiw_dt and Eiw_hdif arguments from compute_hdiff_Eiw entirely and deleted the aliasing-prone end-of-subroutine diagnostic block. Diagnostics are now computed at the driver level using a before/after difference on iwe2_E_iw(:,:,iwe2_tip1): ! before both diffusion modes: iwe2_E_iw_hdif = -iwe2_E_iw(:,:,iwe2_tip1) ! save negated pre-state ! ... explicit and/or iterative compute_hdiff_Eiw calls ... ! after both diffusion modes: iwe2_E_iw_hdif = (iwe2_E_iw_hdif + iwe2_E_iw(:,:,iwe2_tip1)) / dt iwe2_E_iw_dt += iwe2_E_iw_hdif This gives iwe2_E_iw_hdif = (Eiw_after - Eiw_before) / dt in m²/s³, correct for both explicit (single-pass) and iterative implicit modes, and without any aliasing issue. Refactor -------- The previously separate sections 5 (explicit) and 6 (iterative) and their duplicated if (idemix2_diag_Eiw) / else branches are consolidated into a single section 5+6 with one shared before/after diagnostic wrapper. compute_hdiff_Eiw is now a pure physics routine with no optional arguments. --- .../gen_modules_cvmix_idemix2.F90 | 135 ++++++------------ 1 file changed, 44 insertions(+), 91 deletions(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 4e15054d6..76911ae19 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -1661,75 +1661,55 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) end if !_______________________________________________________________________ - ! 5. add lateral diffusion term (see. Olbers D., Eden C., 2013, A Global Model - t7 = MPI_Wtime() - ! for the Diapycnal Diffusivity Induced Internal Gravity Waves...) - ! Eiw^(t+1) = Eiw^(t+1) + div_h( v_0 * tau_h * grad_h(v_0*E_iw^(t)) ) - ! --> do single disffusion step explicite - if ((idemix2_enable_hor_diff_expl .or. idemix2_enable_hor_diff_impl_iter) .and. idemix2_diag_Eiw) then - iwe2_E_iw_hdif = 0.0_WP - end if - if (idemix2_enable_hor_diff_expl) then - ! Exchange E_iw(...,ti) halo after vertical diffusion - needed for explicite - ! horizontal diffusion gradients + ! 5+6. Horizontal Eiw diffusion (explicit single-pass or iterative implicit) + ! Eiw^(t+1) += div_h( v_0 * tau_h * grad_h(v_0 * Eiw) ) + t7 = MPI_Wtime() + ! Diagnostic: capture negated pre-diffusion iwe2_tip1 state. + ! The before/after approach is used for both modes because the iterative + ! implicit call aliases Eiw_old and Eiw to the same array, making any + ! in-subroutine Eiw-Eiw_old difference zero (Fortran aliasing bug). + if ((idemix2_enable_hor_diff_expl .or. idemix2_enable_hor_diff_impl_iter) .and. idemix2_diag_Eiw) then + iwe2_E_iw_hdif = -iwe2_E_iw(:, :, iwe2_tip1) + end if + + if (idemix2_enable_hor_diff_expl) then + ! Exchange E_iw(...,ti) halo - needed for explicit horizontal diffusion gradients call exchange_nod(iwe2_E_iw(:, :, iwe2_ti), partit) - - if (idemix2_diag_Eiw) then - call compute_hdiff_Eiw( & - iwe2_E_iw(:, :, iwe2_ti) & ! IN: IW energy at current time - , iwe2_E_iw(:, :, iwe2_tip1) & ! INOUT: IW energy updated by horizontal diffusion - , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) - , 1 & ! IN: number of horizontal diffusion iterations - , partit & ! INOUT - , mesh & ! IN - , Eiw_dt = iwe2_E_iw_dt & ! INOUT: optional diagnostic: total tendency - , Eiw_hdif = iwe2_E_iw_hdif & ! INOUT: optional diagnostic: horiz. diffusion tendency - ) - else - call compute_hdiff_Eiw( & - iwe2_E_iw(:, :, iwe2_ti) & ! IN: IW energy at current time - , iwe2_E_iw(:, :, iwe2_tip1) & ! INOUT: IW energy updated by horizontal diffusion - , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) - , 1 & ! IN: number of horizontal diffusion iterations - , partit & ! INOUT - , mesh & ! IN - ) - end if + call compute_hdiff_Eiw( & + iwe2_E_iw(:, :, iwe2_ti) & ! IN: IW energy at current time + , iwe2_E_iw(:, :, iwe2_tip1)& ! INOUT: IW energy updated by horizontal diffusion + , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) + , 1 & ! IN: number of horizontal diffusion iterations + , partit & ! INOUT + , mesh & ! IN + ) end if - - !_______________________________________________________________________ - ! 6. add tendency due to lateral diffusion with iterative method in case of - ! high resolution - ! --> do iterative disffusion step implicitly + if (idemix2_enable_hor_diff_impl_iter) then do iter=1, idemix2_hor_diff_niter - if (idemix2_diag_Eiw) then - call compute_hdiff_Eiw( & - iwe2_E_iw(:, :, iwe2_tip1) & ! IN: IW energy from previous iteration - , iwe2_E_iw(:, :, iwe2_tip1) & ! INOUT: IW energy updated in-place (iterative) - , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) - , idemix2_hor_diff_niter & ! IN: total number of diffusion iterations - , partit & ! INOUT - , mesh & ! IN - , Eiw_dt = iwe2_E_iw_dt & ! INOUT: optional diagnostic: total tendency - , Eiw_hdif = iwe2_E_iw_hdif & ! INOUT: optional diagnostic: horiz. diffusion tendency - ) - else - call compute_hdiff_Eiw( & - iwe2_E_iw(:, :, iwe2_tip1) & ! IN: IW energy from previous iteration - , iwe2_E_iw(:, :, iwe2_tip1) & ! INOUT: IW energy updated in-place (iterative) - , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) - , idemix2_hor_diff_niter & ! IN: total number of diffusion iterations - , partit & ! INOUT - , mesh & ! IN - ) - end if - - ! refresh iwe2_E_iw(:, :, iwe2_tip1) halo for the next diffusive - ! iteration call + call compute_hdiff_Eiw( & + iwe2_E_iw(:, :, iwe2_tip1) & ! IN: IW energy from previous iteration + , iwe2_E_iw(:, :, iwe2_tip1) & ! INOUT: IW energy updated in-place (iterative) + , iwe2_v0 & ! IN: first baroclinic mode group speed (m/s) + , idemix2_hor_diff_niter & ! IN: total number of diffusion iterations + , partit & ! INOUT + , mesh & ! IN + ) call exchange_nod(iwe2_E_iw(:, :, iwe2_tip1), partit) end do end if + + ! Diagnostic: iwe2_E_iw_hdif = (Eiw_after - Eiw_before) / dt [m²/s³] + if ((idemix2_enable_hor_diff_expl .or. idemix2_enable_hor_diff_impl_iter) .and. idemix2_diag_Eiw) then + do node = 1, myDim_nod2D + uln = ulevels_nod2D(node) + nln = nlevels_nod2D(node) + iwe2_E_iw_hdif(uln:nln, node) = (iwe2_E_iw_hdif(uln:nln, node) & + + iwe2_E_iw(uln:nln, node, iwe2_tip1)) / dt + iwe2_E_iw_dt(uln:nln, node) = iwe2_E_iw_dt(uln:nln, node) & + + iwe2_E_iw_hdif(uln:nln, node) + end do + end if t8 = MPI_Wtime() time_Eiw_hdiff = t8 - t7 @@ -3134,15 +3114,13 @@ end subroutine compute_vol_nodB2T_hnode ! ! use Gaussian integral satz ... int(div vec_A)dV = ringint(A*vec_n)dA ! div vec_A = 1/V * sum_i=1...nface( A_i*vec_n_i)*A_i - subroutine compute_hdiff_Eiw( & + subroutine compute_hdiff_Eiw( & Eiw_old , & Eiw , & v0 , & n_hor_iter , & partit , & - mesh , & - Eiw_dt , & - Eiw_hdif & + mesh & ) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ @@ -3152,9 +3130,6 @@ subroutine compute_hdiff_Eiw( & real(kind=WP) , intent(inout) :: Eiw(:,:) real(kind=WP) , intent(in ) :: v0(:,:) integer , intent(in ) :: n_hor_iter - real(kind=WP) , intent(inout),optional:: Eiw_dt(:,:) - real(kind=WP) , intent(inout),optional:: Eiw_hdif(:,:) - !___LOCAL VARIABLES_____________________________________________________ integer :: edge, ednodes(2), edel(2), & elnodes1(3), elnodes2(3), & @@ -3389,28 +3364,6 @@ subroutine compute_hdiff_Eiw( & end do !-->do nz=nl12+1,nl1 end do !-->do edge=1,myDim_edge2D - !_______________________________________________________________________ - ! add to total change in Eiw --> optional diagnsotic - if (present(Eiw_dt) .or. present(Eiw_hdif)) then - do node = 1, myDim_nod2D - nu1 = ulevels_nod2D(node) - nl1 = nlevels_nod2D(node) - - if (present(Eiw_dt)) then - do nz = nu1, nl1 - Eiw_dt(nz, node) = Eiw_dt(nz, node) + (Eiw(nz, node)-Eiw_old(nz, node))/dt - end do - end if - - if (present(Eiw_hdif)) then - do nz = nu1, nl1 - Eiw_hdif(nz, node) = Eiw_hdif(nz, node)+(Eiw(nz, node)-Eiw_old(nz, node)) - end do - end if - - end do - end if - end subroutine compute_hdiff_Eiw From b71aa8a873e6ac253d76f2a702b8cd378a5331ed Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 17 Jun 2026 16:37:24 +0200 Subject: [PATCH 56/63] fix IDEMIX2 horizontal diffusion silent no-op and diagnostic units MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bug 1: compute_hdiff_Eiw always produced zero increments --------------------------------------------------------- vol_wcelli (inverse nodal cell volume) was allocated and zeroed in init_cvmix_idemix2 but compute_vol_wcell() was never called. Every flux increment in compute_hdiff_Eiw multiplies vol_wcelli: Eiw(nz,node) += dt * tau_h / niter * vol_wcelli(nz,node) * vflux With vol_wcelli = 0 everywhere, horizontal diffusion was a silent no-op regardless of Eiw gradients or group velocity. The previous commit (2ca4457d) introduced the correct before/after diagnostic, but the diagnostic faithfully reported zero because hdiff genuinely changed nothing. Fix: call compute_vol_wcell(vol_wcelli, mesh, partit) in calc_idemix2 at the start of each timestep. The call must be per-timestep because compute_vol_wcell uses Z_3d_n and hnode, which evolve under ALE. Bug 2: wrong units in compute_Eiw_waveinteract diagnostics ----------------------------------------------------------- M2_diss is a dissipation rate [m²/s³] — erroneously multiplied by dt, giving units of [m²/s²]. IW_diss is an energy increment [m²/s²] accumulated inside the timestep loop — erroneously stored as-is, giving units of [m²/s²] instead of the required tendency [m²/s³]. Fix: E_M2_dt -= M2_diss (was: -= dt*M2_diss) E_M2_diss_wwi = -M2_diss (was: = -dt*M2_diss) E_iw_dt += IW_diss/dt (was: += IW_diss) E_iw_diss_M2 = IW_diss/dt (was: = IW_diss) E_iw_diss_niw = IW_diss/dt (was: = IW_diss) [NIW branch] Bug 3: Edt tendency missing /dt in hsintegrate_Ecompart -------------------------------------------------------- (E_tip1 - E_ti) is an energy difference [m²/s²]; dividing by dt gives the tendency [m²/s³] that the Edt diagnostic variable represents. Edt = (E_tip1 - E_ti) / dt (was: Edt = E_tip1 - E_ti) --- src/cvmix_driver/cvmix_idemix2.F90 | 12 ++++++------ src/cvmix_driver/gen_modules_cvmix_idemix2.F90 | 10 +++++----- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 98830501e..d2899ce81 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -1139,8 +1139,8 @@ subroutine compute_Eiw_waveinteract( & end do ! optional M2 WWI diagnostic - if (present(E_M2_dt)) E_M2_dt(:) = E_M2_dt(:) - dt*M2_diss(:) - if (present(E_M2_diss_wwi)) E_M2_diss_wwi(:) = -dt*M2_diss(:) + if (present(E_M2_dt)) E_M2_dt(:) = E_M2_dt(:) - M2_diss(:) + if (present(E_M2_diss_wwi)) E_M2_diss_wwi(:) = -M2_diss(:) ! update E_iw from E_M2 through wave-wave-interaction IW_diss(:) = 0.0_cvmix_r8 @@ -1153,8 +1153,8 @@ subroutine compute_Eiw_waveinteract( & end do ! optional E_iw diagnostic - if (present(E_iw_dt)) E_iw_dt = E_iw_dt + IW_diss - if (present(E_iw_diss_M2)) E_iw_diss_M2 = IW_diss + if (present(E_iw_dt)) E_iw_dt = E_iw_dt + IW_diss/dt + if (present(E_iw_diss_M2)) E_iw_diss_M2 = IW_diss/dt end if @@ -1175,8 +1175,8 @@ subroutine compute_Eiw_waveinteract( & end do ! optional E_iw diagnostic - if (present(E_iw_dt)) E_iw_dt = E_iw_dt + IW_diss - if (present(E_iw_diss_niw)) E_iw_diss_niw = IW_diss + if (present(E_iw_dt)) E_iw_dt = E_iw_dt + IW_diss/dt + if (present(E_iw_diss_niw)) E_iw_diss_niw = IW_diss/dt end if end subroutine compute_Eiw_waveinteract diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 76911ae19..37ae007da 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -640,7 +640,6 @@ subroutine init_cvmix_idemix2(partit, mesh) allocate(vol_nodB2T(node_size)) vol_nodB2T(:) = 0.0_WP - !_______________________________________________________________________ ! width of spectral frequency bins iwe2_dphit(:) = 2.0_WP*pi/(nfbin-2) @@ -975,9 +974,6 @@ subroutine init_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ ! compute scalar cell volume from top to bottom - ! --> if take the fixed standard levels (zbar) to compute the ocean volume - ! than only normal numerical drift, ocean volume can be computed at - ! initialisation point call compute_vol_nodB2T_fix(vol_nodB2T, mesh, partit) !_______________________________________________________________________ @@ -1220,6 +1216,10 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! initialisation point ! call compute_vol_nodB2T_hnode(vol_nodB2T, mesh, partit) + ! compute inverse cell volume for horizontal diffusion; uses Z_3d_n and + ! hnode which change every timestep under ALE, so must be updated here + call compute_vol_wcell(vol_wcelli, mesh, partit) + !_______________________________________________________________________ ! 1. Compute IDEMIX2 parameters (cn, alpha_c, v0, c0, tau, struct functions) t0 = MPI_Wtime() @@ -2891,7 +2891,7 @@ subroutine hsintegrate_Ecompart( & !_______________________________________________________________________ ! additional diagnostics - if (present(Edt)) Edt(:,:) = (E(:, 1:myDim_nod2D, tip1)-E(:, 1:myDim_nod2D, ti)) + if (present(Edt)) Edt(:,:) = (E(:, 1:myDim_nod2D, tip1)-E(:, 1:myDim_nod2D, ti)) / dt if (present(Eadvh)) then if (flag_AB2) then From 568263422e90f626ae67000f2db27381385ab325 Mon Sep 17 00:00:00 2001 From: Patrick Date: Thu, 18 Jun 2026 16:55:59 +0200 Subject: [PATCH 57/63] fix IDEMIX2 wave-wave struct slice, tau_compart UB, and IDEMIX1 diagnostic units Bug 1: E_M2_struct / E_niw_struct wrong level slice at wave-wave call sites --------------------------------------------------------------------------- (gen_modules_cvmix_idemix2.F90, section 7, 8 call sites) iwe2_E_M2_struct and iwe2_E_niw_struct are filled at levels (uln:nln, node) by compute_vert_struct_fct, but were passed as (:, node) to compute_Eiw_waveinteract. For nodes with uln > 1 (ice-shelf cavities, steep shelf), the subroutine read level 1 (zero-initialised) as the first active level and missed the deepest active level entirely, silently zeroing the wave-wave energy injection at those nodes. Fixed by passing (uln:nln, node) at all 8 call sites. Bug 2: tau_compart uninitialised before floor application --------------------------------------------------------- (cvmix_idemix2.F90, compute_compart_interact_tscale) tau_compart is declared intent(out); max(1/(50 days), tau_compart) on line 512 was reached without ever assigning tau_compart when omega_compart <= |f| (M2 poleward of ~74.5 N). Fortran standard leaves intent(out) undefined on entry. Fixed by adding tau_compart = 0.0_cvmix_r8 before the conditional block. Bug 3: wrong unit labels for IDEMIX1 tendency diagnostics --------------------------------------------------------- (io_meandata.F90) iwe_Ttot, iwe_Tsur, iwe_Tbot and iwe_Thdi were labeled 'm^2/s^2' (energy per unit mass) instead of 'm^2/s^3' (tendency/production rate). iwe_Tdif and iwe_Tdis were already correct. Fixed unit strings to 'm^2/s^3' for all four diagnostics. --- src/cvmix_driver/cvmix_idemix2.F90 | 1 + src/cvmix_driver/gen_modules_cvmix_idemix.F90 | 10 +++++----- src/cvmix_driver/gen_modules_cvmix_idemix2.F90 | 16 ++++++++-------- src/io_meandata.F90 | 8 ++++---- 4 files changed, 18 insertions(+), 17 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index d2899ce81..c4f4bed09 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -479,6 +479,7 @@ subroutine compute_compart_interact_tscale( & !___________________________________________________________________________ ! compute NIW Dissipation Timescale + tau_compart = 0.0_cvmix_r8 if (zbottom>0) then N0=cn*cvmix_PI/zbottom if ( N0 > abs(coriolis) .and. omega_compart > abs(coriolis) ) then diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix.F90 index 45e137d97..2db0ac8db 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix.F90 @@ -741,11 +741,11 @@ subroutine calc_cvmix_idemix(partit, mesh) end do !___________________________________________________________________ - ! diagnostic: add horizontal propgation to the total production rate - ! of internal wave energy iwe_Tot - do node = 1,node_size - iwe_Thdi(:,node) = ( iwe(:,node) - iwe_Thdi(:,node) )/dt - iwe_Ttot(:,node) = iwe_Ttot(:,node) + iwe_Thdi(:,node) + ! diagnostic: add horizontal propagation to the total production rate + ! of internal wave energy iwe_Ttot + do elem = 1, elem_size + iwe_Thdi(:,elem) = ( iwe(:,elem) - iwe_Thdi(:,elem) )/dt + iwe_Ttot(:,elem) = iwe_Ttot(:,elem) + iwe_Thdi(:,elem) end do end if !-->if (idemix_n_hor_iwe_prop_iter>0) then diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 37ae007da..5c06b3f7d 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -1735,12 +1735,12 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction , E_M2_old = iwe2_E_M2( : , node, iwe2_ti) & !IN: M2 compartment energy at current time (m²/s²) , E_M2_new = iwe2_E_M2( : , node, iwe2_tip1) & !INOUT: M2 compartment energy updated - , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , E_M2_struct = iwe2_E_M2_struct( uln:nln, node) & !IN: M2 vertical structure function , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) , E_niw_old = iwe2_E_niw(: , node, iwe2_ti) & !IN: NIW compartment energy at current time (m²/s²) , E_niw_new = iwe2_E_niw(: , node, iwe2_tip1) & !INOUT: NIW compartment energy updated - , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , E_niw_struct = iwe2_E_niw_struct( uln:nln, node) & !IN: NIW vertical structure function , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave , E_iw_diss_M2 = iwe2_E_iw_diss_M2( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from M2 @@ -1760,12 +1760,12 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction , E_M2_old = iwe2_E_M2( : , node, iwe2_ti) & !IN: M2 compartment energy at current time (m²/s²) , E_M2_new = iwe2_E_M2( : , node, iwe2_tip1) & !INOUT: M2 compartment energy updated - , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , E_M2_struct = iwe2_E_M2_struct( uln:nln, node) & !IN: M2 vertical structure function , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) , E_niw_old = iwe2_E_niw(: , node, iwe2_ti) & !IN: NIW compartment energy at current time (m²/s²) , E_niw_new = iwe2_E_niw(: , node, iwe2_tip1) & !INOUT: NIW compartment energy updated - , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , E_niw_struct = iwe2_E_niw_struct( uln:nln, node) & !IN: NIW vertical structure function , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) ) end if @@ -1783,7 +1783,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction , E_M2_old = iwe2_E_M2( : , node, iwe2_ti) & !IN: M2 compartment energy at current time (m²/s²) , E_M2_new = iwe2_E_M2( : , node, iwe2_tip1) & !INOUT: M2 compartment energy updated - , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , E_M2_struct = iwe2_E_M2_struct( uln:nln, node) & !IN: M2 vertical structure function , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave @@ -1803,7 +1803,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction , E_M2_old = iwe2_E_M2( : , node, iwe2_ti) & !IN: M2 compartment energy at current time (m²/s²) , E_M2_new = iwe2_E_M2( : , node, iwe2_tip1) & !INOUT: M2 compartment energy updated - , E_M2_struct = iwe2_E_M2_struct( : , node) & !IN: M2 vertical structure function + , E_M2_struct = iwe2_E_M2_struct( uln:nln, node) & !IN: M2 vertical structure function , alpha_M2_c = iwe2_alpha_M2_c( node) & !IN: M2 continuous dissipation rate , tau_M2 = iwe2_M2_tau( node) & !IN: M2 interaction timescale (s) ) @@ -1821,7 +1821,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction , E_niw_old = iwe2_E_niw(: , node, iwe2_ti) & !IN: NIW compartment energy at current time (m²/s²) , E_niw_new = iwe2_E_niw(: , node, iwe2_tip1) & !INOUT: NIW compartment energy updated - , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , E_niw_struct = iwe2_E_niw_struct( uln:nln, node) & !IN: NIW vertical structure function , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) , E_iw_dt = iwe2_E_iw_dt( : , node) & !INOUT: optional diagnostic: IDEMIX1 tendency from wave-wave , E_iw_diss_niw = iwe2_E_iw_diss_niw( : , node) & !INOUT: optional diagnostic: IDEMIX1 dissipation from NIW @@ -1838,7 +1838,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , E_iw_new = iwe2_E_iw( uln:nln, node, iwe2_tip1) & !INOUT: IDEMIX1 IW energy updated by wave-wave interaction , E_niw_old = iwe2_E_niw(: , node, iwe2_ti) & !IN: NIW compartment energy at current time (m²/s²) , E_niw_new = iwe2_E_niw(: , node, iwe2_tip1) & !INOUT: NIW compartment energy updated - , E_niw_struct = iwe2_E_niw_struct( : , node) & !IN: NIW vertical structure function + , E_niw_struct = iwe2_E_niw_struct( uln:nln, node) & !IN: NIW vertical structure function , tau_niw = iwe2_niw_tau( node) & !IN: NIW interaction timescale (s) ) end if diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 2974e0684..77a33fd08 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1711,12 +1711,12 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) CASE ('IDEMIX ') if (mod(mix_scheme_nmb,10)==6) then call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe' , 'internal wave energy' , 'm^2/s^2', iwe(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Ttot', 'total production of internal wave energy' , 'm^2/s^2', iwe_Ttot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Ttot', 'total production of internal wave energy' , 'm^2/s^3', iwe_Ttot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tdif', 'IWE production by vertical diffusion' , 'm^2/s^3', iwe_Tdif(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tdis', 'IWE production by dissipation' , 'm^2/s^3', iwe_Tdis(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tsur', 'IWE production from surface forcing' , 'm^2/s^2', iwe_Tsur(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tbot', 'IWE production from bottom forcing' , 'm^2/s^2', iwe_Tbot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Thdi', 'IWE production from hori. diffusion' , 'm^2/s^2', iwe_Thdi(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tsur', 'IWE production from surface forcing' , 'm^2/s^3', iwe_Tsur(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tbot', 'IWE production from bottom forcing' , 'm^2/s^3', iwe_Tbot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Thdi', 'IWE production from hori. diffusion' , 'm^2/s^3', iwe_Thdi(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_c0' , 'IWE vertical group velocity' , 'm/s' , iwe_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_v0' , 'IWE horizontal group velocity' , 'm/s' , iwe_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream(elem2D , myDim_elem2D , 'iwe_fbot', 'IDEMIX bottom forcing' , 'm^3/s^3', iwe_fbot(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) From dbfd056d01fe96744bed043555634e3a45cf9f36 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 19 Jun 2026 12:08:16 +0200 Subject: [PATCH 58/63] fix NIW equatorial kdot artifact and IDEMIX1 iwe_v0 diagnostic Bug 1: NIW spectral refraction kdot inflated x1000 near equator --------------------------------------------------------------- (cvmix_idemix2.F90, compute_compart_groupvel) The phi_dot formula has two structurally different terms: 1st: -cn / sqrt(omega^2-f^2) / omega * f * grad_f <- singular as f->omega, needs floor 2nd: -sqrt(omega^2-f^2) / omega * grad_cn <- non-singular, goes to zero naturally A single shared fxa = sqrt(max(1d-10, omega^2-f^2)) was used for both. The 1d-10 floor is correct for the 1st term (prevents 1/fxa divergence), but applying it to the 2nd term inflates sqrt(fxa) near the equator: for NIW with omega_niw = 1.05|f|, omega_niw^2-f^2 = 0.1025*f^2 -> 0 at equator, but the floor gives fxa = 1e-5 instead of the physical ~0. With omega_niw = 1e-8 at the equator this means fxa/omega = 1000 instead of ~0 -- the cn-gradient kdot term was x1000 too large in the equatorial band. Fix: split into fxa (floored, for the singular 1/fxa term) and fxa2 (physical zero, max(0d0,...), for the sqrt(fxa) terms). Matches pyOM2's idemix_group_vel.f90 exactly, which uses two separate fxa computations with different floors. Bug 2: hard +/-5 deg equatorial mask on NIW velocities causing accumulation band -------------------------------------------------------------------------------- (gen_modules_cvmix_idemix2.F90, section 2 group velocity loop) NIW spatial and spectral velocities were zeroed for all elements with |lat| < 5 deg to avoid the equatorial singularity. This created an energy flux wall at +/-5 deg: NIW energy advecting equatorward from higher latitudes could not cross the boundary, accumulating at the outer edge of the masked region. The accumulated E_niw drove anomalously large iwe2_Eiw_dissniw = tau_niw * sint * E_niw_struct at the +/-5 deg band, visible as sharp stripes in diagnostics at all depth levels. The fix from Bug 1 (fxa2 -> 0 at equator) makes the mask unnecessary. pyOM2 has no such mask; it relies solely on the 1d-10 floor in the singular 1/fxa term. Removed. Bug 3: IDEMIX1 iwe_v0 diagnostic stream pointing to iwe_c0 array ----------------------------------------------------------------- (io_meandata.F90, CASE 'IDEMIX ') The def_stream call for 'iwe_v0' (horizontal group velocity) passed iwe_c0(:,:) as the data array instead of iwe_v0(:,:) -- a copy-paste error from the preceding iwe_c0 registration. Since c0 << v0 (gofx2 << hofx2 for typical N/|f| >> 1), the iwe_v0 output file was ~10-100x smaller than the physically correct values, making IDEMIX1 v0 appear negligible compared to IDEMIX2 iwe2_v0. Fixed to iwe_v0(:,:). --- src/cvmix_driver/cvmix_idemix2.F90 | 19 +++++++++++-------- .../gen_modules_cvmix_idemix2.F90 | 6 ------ src/io_meandata.F90 | 2 +- 3 files changed, 12 insertions(+), 15 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index c4f4bed09..33383c4b0 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -380,7 +380,7 @@ subroutine compute_compart_groupvel( & w_compart !___Local___________________________________________________________________ integer :: di, fbin_i - real(cvmix_r8) :: fxa, intNz, cstar, & + real(cvmix_r8) :: fxa, fxa2, intNz, cstar, & kdot_x, kdot_y, cg_compart type(idemix2_type), pointer :: idemix2_const_in @@ -407,19 +407,22 @@ subroutine compute_compart_groupvel( & ! kdot_M2 = (kdot_x_M2, kdot_y_M2) ! compute: sqrt(omega²-f²) - fxa = sqrt(max(1d-10, omega_compart**2 - coriolis**2 )) - + ! 1st term (Coriolis refraction, cn/fxa singular at f=omega): floor prevents 1/fxa divergence + fxa = sqrt(max(1d-10, omega_compart**2 - coriolis**2 )) + ! 2nd term (cn-gradient refraction, sqrt(fxa) non-singular): no floor, goes to zero naturally + fxa2 = sqrt(max(0d0, omega_compart**2 - coriolis**2 )) + ! 1st part coriolis contribution - ! compute: c_n/omega/sqrt(omega²-f²)) * f * grad_f + ! compute: c_n/omega/sqrt(omega²-f²)) * f * grad_f (uses fxa with floor) ! 2nd part topographic/buoyancy driven contribution - ! compute: sqrt(omega²-f²)/omega * grad_cn + ! compute: sqrt(omega²-f²)/omega * grad_cn (uses fxa2, physical zero at equator) kdot_y = -cn/fxa/omega_compart * coriolis*coriol_grady & - -fxa/omega_compart*cn_grady + -fxa2/omega_compart*cn_grady ! | ! +-> this minus sign is from the -cos(phi) ! - - kdot_x = fxa/omega_compart*cn_gradx + + kdot_x = fxa2/omega_compart*cn_gradx !___________________________________________________________________________ !zonal, meridional and cross-spectral component of M2 internal tide group velocity diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 5c06b3f7d..3d57c6be9 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -1422,12 +1422,6 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) , w_compart = w_niw_e( : ) & !OUT: cross-spectral propagation rate per bin (1/s) ) - ! Mask out NIW velocities near equator where physics is singular - if (abs(lat_e_deg) < 5.0_WP) then ! ~5° latitude - iwe2_niw_uv( :, :, elem) = 0.0_WP - w_niw_e( : ) = 0.0_WP - end if - do k=1,3 iwe2_niw_w(:, elnodes(k)) = iwe2_niw_w(:, elnodes(k)) + w_niw_e(:)*area_third end do diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 77a33fd08..956c0b37d 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1718,7 +1718,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Tbot', 'IWE production from bottom forcing' , 'm^2/s^3', iwe_Tbot(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_Thdi', 'IWE production from hori. diffusion' , 'm^2/s^3', iwe_Thdi(:,:), io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_c0' , 'IWE vertical group velocity' , 'm/s' , iwe_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_v0' , 'IWE horizontal group velocity' , 'm/s' , iwe_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,elem2D/), (/nl,myDim_elem2D/), 'iwe_v0' , 'IWE horizontal group velocity' , 'm/s' , iwe_v0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream(elem2D , myDim_elem2D , 'iwe_fbot', 'IDEMIX bottom forcing' , 'm^3/s^3', iwe_fbot(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream(elem2D , myDim_elem2D , 'iwe_fsrf', 'IDEMIX surface forcing' , 'm^3/s^3', iwe_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) end if From 6471ed4cef7bfc335ec8f81c96b972fafeb81740 Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 19 Jun 2026 14:11:40 +0200 Subject: [PATCH 59/63] small fix, mostly comments and unused variables --- src/cvmix_driver/cvmix_idemix2.F90 | 56 +++++++++---------- .../gen_modules_cvmix_idemix2.F90 | 1 - 2 files changed, 28 insertions(+), 29 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 33383c4b0..c222488f2 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -380,7 +380,7 @@ subroutine compute_compart_groupvel( & w_compart !___Local___________________________________________________________________ integer :: di, fbin_i - real(cvmix_r8) :: fxa, fxa2, intNz, cstar, & + real(cvmix_r8) :: fxa, fxa2, cstar, & kdot_x, kdot_y, cg_compart type(idemix2_type), pointer :: idemix2_const_in @@ -719,20 +719,20 @@ subroutine compute_vert_struct_fct( & E_struct_M2(di) = mask * 0.5_cvmix_r8*( (1.0_cvmix_r8+coriolis**2/omega_M2**2)*phin( di)**2 /(small+cn**2) & +(1.0_cvmix_r8-coriolis**2/omega_M2**2)*dphindz(di)**2 /Nzw(di) ) - if (E_struct_M2(di)/=E_struct_M2(di) .or. E_struct_M2(di)<0.0_cvmix_r8) then - write(*,*) " }-))))°> found negative/NaN E_struct_M2", E_struct_M2(di) - write(*,*) "di = ", di - write(*,*) "mask = ", mask - write(*,*) "coriolis = ", coriolis - write(*,*) "omega_M2 = ", omega_M2 - write(*,*) "phin( di) = ", phin( di) - write(*,*) "dphindz(di) = ", dphindz(di) - write(*,*) "Nzw(di) = ", Nzw(di) - write(*,*) "cn = ", cn - write(*,*) "coriolis**2/omega_M2**2 = ", coriolis**2/omega_M2**2 - write(*,*) "(1.0_cvmix_r8+coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8+coriolis**2/omega_M2**2) - write(*,*) "(1.0_cvmix_r8-coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8-coriolis**2/omega_M2**2) - end if +! if (E_struct_M2(di)/=E_struct_M2(di) .or. E_struct_M2(di)<0.0_cvmix_r8) then +! write(*,*) " }-))))°> found negative/NaN E_struct_M2", E_struct_M2(di) +! write(*,*) "di = ", di +! write(*,*) "mask = ", mask +! write(*,*) "coriolis = ", coriolis +! write(*,*) "omega_M2 = ", omega_M2 +! write(*,*) "phin( di) = ", phin( di) +! write(*,*) "dphindz(di) = ", dphindz(di) +! write(*,*) "Nzw(di) = ", Nzw(di) +! write(*,*) "cn = ", cn +! write(*,*) "coriolis**2/omega_M2**2 = ", coriolis**2/omega_M2**2 +! write(*,*) "(1.0_cvmix_r8+coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8+coriolis**2/omega_M2**2) +! write(*,*) "(1.0_cvmix_r8-coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8-coriolis**2/omega_M2**2) +! end if enddo endif @@ -753,19 +753,19 @@ subroutine compute_vert_struct_fct( & E_struct_niw(di) = mask * 0.5_cvmix_r8*( (1.0_cvmix_r8+coriolis**2/(small+omega_niw**2))*phin( di)**2/(small+cn**2) & +(1.0_cvmix_r8-coriolis**2/(small+omega_niw**2))*dphindz(di)**2/Nzw(di) ) - if (E_struct_niw(di)/=E_struct_niw(di) .or. E_struct_niw(di)<0.0_cvmix_r8) then - write(*,*) " }-))))°> found negative/NaN E_struct_niw", E_struct_niw(di) - write(*,*) "di = ", di - write(*,*) "mask = ", mask - write(*,*) "coriolis = ", coriolis - write(*,*) "omega_niw = ", omega_niw - write(*,*) "phin( di) = ", phin( di) - write(*,*) "dphindz(di) = ", dphindz(di) - write(*,*) "Nzw(di) = ", Nzw(di) - write(*,*) "cn = ", cn - write(*,*) "(1.0_cvmix_r8+coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8+coriolis**2/omega_M2**2) - write(*,*) "(1.0_cvmix_r8-coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8-coriolis**2/omega_M2**2) - end if +! if (E_struct_niw(di)/=E_struct_niw(di) .or. E_struct_niw(di)<0.0_cvmix_r8) then +! write(*,*) " }-))))°> found negative/NaN E_struct_niw", E_struct_niw(di) +! write(*,*) "di = ", di +! write(*,*) "mask = ", mask +! write(*,*) "coriolis = ", coriolis +! write(*,*) "omega_niw = ", omega_niw +! write(*,*) "phin( di) = ", phin( di) +! write(*,*) "dphindz(di) = ", dphindz(di) +! write(*,*) "Nzw(di) = ", Nzw(di) +! write(*,*) "cn = ", cn +! write(*,*) "(1.0_cvmix_r8+coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8+coriolis**2/omega_M2**2) +! write(*,*) "(1.0_cvmix_r8-coriolis**2/omega_M2**2) = ", (1.0_cvmix_r8-coriolis**2/omega_M2**2) +! end if enddo endif diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 3d57c6be9..1afca0df3 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -229,7 +229,6 @@ module g_cvmix_idemix2 ! --- Eiw - internal wave energy related variables --- real(kind=WP), allocatable, dimension(:,:,:):: iwe2_E_iw real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_iw_diss - real(kind=WP), allocatable, dimension(:) :: iwe_E_iw_vint ! optional diagnostic real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_iw_dt, iwe2_E_iw_fbot, & From 869fa70f84f425459bc4b55f36da79d8439234ca Mon Sep 17 00:00:00 2001 From: Patrick Date: Fri, 19 Jun 2026 15:01:47 +0200 Subject: [PATCH 60/63] fix minor issue --- src/cvmix_driver/cvmix_idemix2.F90 | 2 +- src/io_meandata.F90 | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index c222488f2..087c93fba 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -160,7 +160,7 @@ subroutine compute_init(tau_v , & ! time scale for vertical symmet !___ tau_h _________________________________________________________________ if (present(tau_h)) then - if(tau_h.lt. 0.01*864000. .or. tau_h .gt. 100.*86400.) then + if(tau_h.lt. 0.01*86400. .or. tau_h .gt. 100.*86400.) then print*, "ERROR:tau_h can only be allowed_range" stop 1 end if diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index 47f5ec8b0..afe6f8ff4 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1731,7 +1731,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_Eiw_diss', 'Eiw production from dissipation', 'm^2/s^3', iwe2_E_iw_diss( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_c0' , 'Eiw vertical group velocity' , 'm/s' , iwe2_c0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_v0' , 'Eiw horizontal group velocity' , 'm/s' , iwe2_v0(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_alpha_c' , 'Eiw dissipation coefficien' , 'none' , iwe2_alpha_c(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream((/nl,nod2d/), (/nl,myDim_nod2D/), 'iwe2_alpha_c' , 'Eiw dissipation coefficien' , 's/m^2' , iwe2_alpha_c(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_fbot' , 'bottom forcing' , 'm^3/s^3', iwe2_fbot_n(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_fsrf' , 'surface forcing' , 'm^3/s^3', iwe2_fsrf(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_cn' , 'baroclinic velocity' , 'm/s' , iwe2_cn(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1746,7 +1746,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) if (idemix2_enable_M2) then - call def_stream( nod2d , myDim_nod2D , 'iwe2_m2_alphac' , 'M2 energy dissipation' , 'none' , iwe2_alpha_M2_c(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream( nod2d , myDim_nod2D , 'iwe2_m2_alphac' , 'M2 energy dissipation' , 's/m^2' , iwe2_alpha_M2_c(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream( nod2d , myDim_nod2D , 'iwe2_m2_tau' , 'M2 dissipation timescale' , 's' , iwe2_M2_tau(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_m2_forc' , 'M2 forcing' , 'm^3/s^3/rad', iwe2_fM2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_m2_w' , 'M2 cross. spectr. propag.' , 'rad/s' , iwe2_M2_w(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1800,7 +1800,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) if (idemix2_enable_M2 .or. idemix2_enable_niw) then call def_stream(nod2d, myDim_nod2D, 'topo_dist2c', 'distance from coast' , 'm', iwe2_topo_dist, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) call def_stream(nod2d, myDim_nod2D, 'topo_hrms' , 'Root Mean Square Topographic Heigh', 'm', iwe2_topo_hrms, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - call def_stream(nod2d, myDim_nod2D, 'topo_hlam' , 'Topographic Wavelength' , 'm', iwe2_topo_hrms, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + call def_stream(nod2d, myDim_nod2D, 'topo_hlam' , 'Topographic Wavelength' , 'm', iwe2_topo_hlam, io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) end if end if From 4d6aefa2531b638921e4815315e883657324dbe1 Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 24 Jun 2026 10:46:02 +0200 Subject: [PATCH 61/63] add namelist tau_M2/niw timescales, fix diag array OOB, add coast_node diagnostic IDEMIX2 changes across five files: namelist / cvmix_idemix2.F90 - Add four new namelist parameters (all timescales in days, larger = slower dissipation = more open-ocean energy): idemix2_tau_M2_shelf = 7 (M2 shelf dissipation timescale) idemix2_tau_M2_oce = 50 (M2 open-ocean floor timescale) idemix2_tau_niw_shelf = 7 (NIW shelf dissipation timescale) idemix2_tau_niw_oce = 3 (NIW open-ocean floor timescale) - Wire them into cvmix_idemix2_setup as optional dummy args with defaults - Replace hard-coded magic numbers in tau_compart with the new namelist values; separate shelf and open-ocean branches for M2 vs NIW gen_modules_cvmix_idemix2.F90 - Shrink all IO-only diagnostic arrays from node_size (local+halo) to myDim_nod2D (local only): iwe2_E_iw_fbot, iwe2_E_iw_vdif, iwe2_E_iw_hdif, iwe2_E_iw_fsrf, iwe2_E_iw_dt; and the M2/NIW Ecompart/WWI arrays (iwe2_E_M2_advh/advs/diss/forc/refl/dt, iwe2_E_iw_diss_M2, iwe2_E_M2_diss_wwi, NIW equivalents) - Add `node <= myDim_nod2D` guard in the Eiw vertical diffusion loop and all three WWI branches so diagnostic arrays are never written at halo indices (fixes latent OOB for the M2/NIW WWI arrays) - Fix iwe2_E_iw_hdif whole-array assignment to restrict RHS to 1:myDim_nod2D - Add iwe2_coast_node (logical, node_size): marks nodes ON the coast boundary. Set in init_reflect_bc via a real-valued proxy to allow exchange_nod to propagate coast status across MPI halo boundaries. Distinguishes coast nodes from iwe2_refl_node (coast-adjacent interior). - Fix ivols_int missing from !$OMP PARALLEL DO PRIVATE list in apply_reflect_bc_spctrl (thread-safety fix) - Fix integer division 1/vol_s -> 1.0_WP/vol_s - Correct hsintegrate_Ecompart optional dummy arg sizes to myDim_nod2D; iwe2_E_M2_refl/iwe2_E_niw_refl changed from 2D (nfbin, myDim_nod2D) to 1D (myDim_nod2D) matching the scalar-per-node reflected-flux design io_meandata.F90 - Update def_stream calls for iwe2_Em2_refl and iwe2_Eniw_refl to 1D node-field form, matching the redesigned scalar storage io_mesh_info.F90 - Write iwe2_coast_node to mesh.diag.nc alongside iwe2_refl_node --- config/namelist.cvmix | 6 +- src/cvmix_driver/cvmix_idemix2.F90 | 82 ++++-- .../gen_modules_cvmix_idemix2.F90 | 253 +++++++++++------- src/io_meandata.F90 | 5 +- src/io_mesh_info.F90 | 28 ++ 5 files changed, 255 insertions(+), 119 deletions(-) diff --git a/config/namelist.cvmix b/config/namelist.cvmix index 96e9130d3..af600ebe8 100644 --- a/config/namelist.cvmix +++ b/config/namelist.cvmix @@ -116,12 +116,16 @@ idemix2_enable_M2 = .false. idemix2_M2forc_file = '/albedo/work/user/pscholz/forcing/IDEMIX2/idemix2_IT_forc_M2modes1-2_aniso.nc' idemix2_M2forc_vname = 'Flux_to2' ! variable name in surface forcing file idemix2_M2forc_zname = 'phi' ! zdim variable name in surface forcing file - +idemix2_tau_M2_shelf = 7.0 +idemix2_tau_M2_oce = 50.0 + ! --- NIW Forcing (Summed anisotropic M2-tide generation modes 1-2 (W/m2)) --- idemix2_enable_niw = .false. idemix2_fniw_usage = 0.2 ! fraction of surface forcing used [dimensionless] idemix2_niwforc_file = '/albedo/work/user/pscholz/forcing/IDEMIX/fourier_smooth_2005_cfsr_inert_rgrid.nc' idemix2_niwforc_vname = 'var706' +idemix2_tau_niw_shelf = 7.0 +idemix2_tau_niw_oce = 3.0 ! --- Bottom Forcing (Tidal Internal Waves) --- idemix2_enable_bot = .true. diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index 087c93fba..d97ecf165 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -94,7 +94,11 @@ module cvmix_idemix2 gamma , & ! constant of order one derived from the shape of the spectrum in m space (dimensionless) jstar , & ! spectral bandwidth in modes (dimensionless) mu0 , & ! dissipation parameter (dimensionless) - shelf_dist ! shelf definition in meters from coast + shelf_dist , & ! shelf definition in meters from coast + tau_niw_shelf , & ! NIW dissipation timescale on shelf (days) + tau_niw_oce , & ! NIW dissipation timescale floor in open ocean (days) + tau_M2_shelf , & ! M2 dissipation timescale on shelf (days) + tau_M2_oce ! M2 dissipation timescale floor in open ocean (days) logical :: & enable_M2 , & @@ -127,6 +131,10 @@ subroutine compute_init(tau_v , & ! time scale for vertical symmet mu0 , & ! dissipation parameter (dimensionless) nfbin , & ! number of spectral bins shelf_dist , & ! shelf definition in meters from coast + tau_niw_shelf , & + tau_niw_oce , & + tau_M2_shelf , & + tau_M2_oce , & enable_M2 , & enable_niw , & enable_superbee_adv , & @@ -137,7 +145,8 @@ subroutine compute_init(tau_v , & ! time scale for vertical symmet handle_old_vals, idemix2_userdef_constants) ! This subroutine sets user or default values for IDEMIX parameters - real(cvmix_r8), optional, intent(in) :: tau_v, tau_h, gamma, jstar, mu0, shelf_dist + real(cvmix_r8), optional, intent(in) :: tau_v, tau_h, gamma, jstar, mu0, shelf_dist, & + tau_niw_shelf, tau_niw_oce, tau_M2_shelf, tau_M2_oce logical , optional, intent(in) :: enable_M2, enable_niw, & enable_superbee_adv, enable_AB_timestep, & enable_hor_diffusion, enable_hor_diff_iter @@ -208,7 +217,35 @@ subroutine compute_init(tau_v , & ! time scale for vertical symmet else call idemix2_put('shelf_dist', 300000._cvmix_r8, idemix2_userdef_constants) end if - + + !___ tau_niw_shelf _________________________________________________________ + if (present(tau_niw_shelf)) then + call idemix2_put('tau_niw_shelf', tau_niw_shelf, idemix2_userdef_constants) + else + call idemix2_put('tau_niw_shelf', 7._cvmix_r8, idemix2_userdef_constants) + end if + + !___ tau_niw_oce ___________________________________________________________ + if (present(tau_niw_oce)) then + call idemix2_put('tau_niw_oce', tau_niw_oce, idemix2_userdef_constants) + else + call idemix2_put('tau_niw_oce', 3._cvmix_r8, idemix2_userdef_constants) + end if + + !___ tau_M2_shelf __________________________________________________________ + if (present(tau_M2_shelf)) then + call idemix2_put('tau_M2_shelf', tau_M2_shelf, idemix2_userdef_constants) + else + call idemix2_put('tau_M2_shelf', 7._cvmix_r8, idemix2_userdef_constants) + end if + + !___ tau_M2_oce ____________________________________________________________ + if (present(tau_M2_oce)) then + call idemix2_put('tau_M2_oce', tau_M2_oce, idemix2_userdef_constants) + else + call idemix2_put('tau_M2_oce', 50._cvmix_r8, idemix2_userdef_constants) + end if + !___ superbee_adv __________________________________________________________ if (present(nfbin)) then call idemix2_put('nfbin', nfbin, idemix2_userdef_constants) @@ -503,19 +540,22 @@ subroutine compute_compart_interact_tscale( & *(omega_compart**2.0 - coriolis**2.0)**0.5/omega_compart tau_compart = min(0.5/dtime, fxc*fxb/zbottom) else - tau_compart = 1./(50.*86400.0) - end if - end if + tau_compart = 1.0/(idemix2_const_in%tau_M2_oce*86400.0_cvmix_r8) + end if + end if endif endif - - ! on shelf limitation - if (topo_shelf) tau_compart = 1./(7.*86400.0) - if (trim(compart_name)=='niw') then - tau_compart = max(1d0/(3.*86400.0), tau_compart ) - else if (trim(compart_name)=='M2') then - tau_compart = max(1d0/(50.*86400.0), tau_compart ) - end if + + ! on shelf limitation + if (topo_shelf) then + if (trim(compart_name)=='niw') tau_compart = 1.0/(idemix2_const_in%tau_niw_shelf*86400.0_cvmix_r8) + if (trim(compart_name)=='M2' ) tau_compart = 1.0/(idemix2_const_in%tau_M2_shelf *86400.0_cvmix_r8) + end if + if (trim(compart_name)=='niw') then + tau_compart = max(1.0/(idemix2_const_in%tau_niw_oce*86400.0_cvmix_r8), tau_compart) + else if (trim(compart_name)=='M2') then + tau_compart = max(1.0/(idemix2_const_in%tau_M2_oce *86400.0_cvmix_r8), tau_compart) + end if end subroutine compute_compart_interact_tscale @@ -1227,12 +1267,16 @@ subroutine vmix_tke_put_idemix2_real(varname, val, idemix2_userdef_constants) ! if input idemix_userdef_constants present do pointer into this if (present(idemix2_userdef_constants)) idemix2_constants_out=> idemix2_userdef_constants select case(trim(varname)) - case('tau_v') ; idemix2_constants_out%tau_v = val - case('tau_h') ; idemix2_constants_out%tau_h = val - case('jstar') ; idemix2_constants_out%jstar = val - case('gamma') ; idemix2_constants_out%gamma = val - case('mu0' ) ; idemix2_constants_out%mu0 = val + case('tau_v' ) ; idemix2_constants_out%tau_v = val + case('tau_h' ) ; idemix2_constants_out%tau_h = val + case('jstar' ) ; idemix2_constants_out%jstar = val + case('gamma' ) ; idemix2_constants_out%gamma = val + case('mu0' ) ; idemix2_constants_out%mu0 = val case('shelf_dist' ) ; idemix2_constants_out%shelf_dist = val + case('tau_niw_shelf') ; idemix2_constants_out%tau_niw_shelf = val + case('tau_niw_oce' ) ; idemix2_constants_out%tau_niw_oce = val + case('tau_M2_shelf' ) ; idemix2_constants_out%tau_M2_shelf = val + case('tau_M2_oce' ) ; idemix2_constants_out%tau_M2_oce = val case DEFAULT print*, "ERROR:", trim(varname), " not a valid choice" stop 1 diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 1afca0df3..5ca3fe2c2 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -91,8 +91,22 @@ module g_cvmix_idemix2 integer :: idemix2_hor_diff_niter = 5 ! from Pollman et al. (2017) ! define shelf is defined as distance from coast (default 300km) - real(kind=WP) :: idemix2_shelf_dist = 300.0e3 - + real(kind=WP) :: idemix2_shelf_dist = 300.0e3 + + ! NIW/M2 dissipation timescales: shelf value and open-ocean floor (days) + ! defaults match pyOM2_fpohlmann: shelf=7days, NIW floor=3days, M2 floor=50days + ! --> Larger idemix2_tau_niw_oce (e.g. 50 days) → rate `1/τ` small → E_niw dissipates slowly → more reaches open ocean + ! --> Smaller idemix2_tau_niw_oce (e.g. 3 days) → rate `1/τ` large → E_niw dissipates quickly → energy stays near source + ! | Version | tau_niw_oce | Effect | + ! |-------------------|-------------|-------------------------------------| + ! | pyOM2 original | 50 days | slow dissipation, fills open ocean | + ! | pyOM2_fpohlmann | 3 days | fast dissipation, stays near source | + ! | FESOM2 default | 3 days | matches pyOM2_fpohlmann | + real(kind=WP) :: idemix2_tau_niw_shelf = 7.0_WP + real(kind=WP) :: idemix2_tau_niw_oce = 3.0_WP ! pyOM2_fpohlmann default; pyOM2_orig: 50.0 + real(kind=WP) :: idemix2_tau_M2_shelf = 7.0_WP + real(kind=WP) :: idemix2_tau_M2_oce = 50.0_WP + ! scal down baroclinic wave speed when not all modes are used real(kind=WP) :: idemix2_scal_cn = 1.0 @@ -183,6 +197,8 @@ module g_cvmix_idemix2 idemix2_enable_AB, idemix2_AB_epsilon, idemix2_nfbin, & ! idemix2_enable_superbee_adv idemix2_enable_hor_diff_expl, idemix2_enable_hor_diff_impl_iter, idemix2_hor_diff_niter, & idemix2_shelf_dist, & + idemix2_tau_niw_shelf, idemix2_tau_niw_oce, & + idemix2_tau_M2_shelf, idemix2_tau_M2_oce, & idemix2_botforc_Etot, & idemix2_enable_M2 , idemix2_M2forc_file , idemix2_M2forc_vname , idemix2_M2forc_zname, & idemix2_enable_niw , idemix2_niwforc_file , idemix2_niwforc_vname , idemix2_fniw_usage, & @@ -209,8 +225,8 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_M2_dt , & iwe2_E_M2_advh, iwe2_E_M2_advs , & iwe2_E_M2_diss, iwe2_E_M2_diss_wwi, & - iwe2_E_M2_forc, & - iwe2_E_M2_refl + iwe2_E_M2_forc + real(kind=WP), allocatable, dimension(:) :: iwe2_E_M2_refl ! --- niw related global variables --- @@ -220,11 +236,11 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:) :: w_niw_e, iwe2_niw_tau ! optional diagnostic - real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_niw_dt , & + real(kind=WP), allocatable, dimension(:,:) :: iwe2_E_niw_dt , & iwe2_E_niw_advh, iwe2_E_niw_advs , & iwe2_E_niw_diss, & - iwe2_E_niw_forc, & - iwe2_E_niw_refl + iwe2_E_niw_forc + real(kind=WP), allocatable, dimension(:) :: iwe2_E_niw_refl ! --- Eiw - internal wave energy related variables --- real(kind=WP), allocatable, dimension(:,:,:):: iwe2_E_iw @@ -265,6 +281,8 @@ module g_cvmix_idemix2 real(kind=WP), allocatable, dimension(:,:) :: iwe2_refl_src ! mask: .true. for own nodes that are interior to at least one coast edge logical, allocatable, dimension(:) :: iwe2_refl_node + ! mask: .true. for nodes that sit ON the coast (belong to a boundary edge) + logical, allocatable, dimension(:) :: iwe2_coast_node ! pre-computed periodic wrap indices for cross-spectral superbee stencil ! (branch-free inner loop in adv_Ecompart_crss_spctrl_superbee) integer, allocatable, dimension(:) :: iwe2_idxp1, iwe2_idxp2, iwe2_idxm1 @@ -300,7 +318,7 @@ subroutine init_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ if(mype==0) then write(*,*) '____________________________________________________________' - write(*,*) ' --> initialise IDEMIX2' + write(*,*) ' --> initialise CVMIX_IDEMIX2' write(*,*) end if !_______________________________________________________________________ @@ -341,15 +359,20 @@ subroutine init_cvmix_idemix2(partit, mesh) write(*,*) " │ " write(*,*) " ├> idemix2_enable_M2 = ", idemix2_enable_M2 write(*,*) " │ ┌──────────────────────────── " - write(*,*) " │ └> idemix2_M2forc_file = ", trim(idemix2_M2forc_file) - write(*,*) " │ ├> idemix2_M2forc_vname = ", trim(idemix2_M2forc_vname) - write(*,*) " │ └> idemix2_M2forc_zname = ", trim(idemix2_M2forc_zname) + write(*,*) " │ ├> idemix2_M2forc_file = ", trim(idemix2_M2forc_file) + write(*,*) " │ │ ├> idemix2_M2forc_vname = ", trim(idemix2_M2forc_vname) + write(*,*) " │ │ └> idemix2_M2forc_zname = ", trim(idemix2_M2forc_zname) + write(*,*) " │ ├> idemix2_tau_M2_shelf = ", idemix2_tau_M2_shelf, " days" + write(*,*) " │ └> idemix2_tau_M2_oce = ", idemix2_tau_M2_oce, " days" + write(*,*) " │ " write(*,*) " ├> idemix2_enable_niw = ", idemix2_enable_niw write(*,*) " │ ┌──────────────────────────── " write(*,*) " │ ├> idemix2_fniw_usage = ", idemix2_fniw_usage - write(*,*) " │ └> idemix2_niwforc_file = ", trim(idemix2_niwforc_file) - write(*,*) " │ └> idemix2_niwforc_vname = ", trim(idemix2_niwforc_vname) + write(*,*) " │ ├> idemix2_niwforc_file = ", trim(idemix2_niwforc_file) + write(*,*) " │ │ └> idemix2_niwforc_vname = ", trim(idemix2_niwforc_vname) + write(*,*) " │ ├> idemix2_tau_niw_shelf = ", idemix2_tau_niw_shelf, " days" + write(*,*) " │ └> idemix2_tau_niw_oce = ", idemix2_tau_niw_oce, " days" write(*,*) " │ " write(*,*) " ├> idemix2_enable_bot = ", idemix2_enable_bot write(*,*) " │ ┌──────────────────────────── " @@ -417,12 +440,12 @@ subroutine init_cvmix_idemix2(partit, mesh) allocate(iwe2_E_iw_diss(nl, node_size)) iwe2_E_iw_diss( :,:)= 0.0_WP ! Eiw production from disspation - ! Diagnostics + ! Diagnostics (sized myDim_nod2D: IO-only, never need halo) if (idemix2_diag_Eiw) then - allocate( iwe2_E_iw_fbot(nl, node_size) & - , iwe2_E_iw_vdif(nl, node_size) & - , iwe2_E_iw_hdif(nl, node_size) & - , iwe2_E_iw_fsrf( node_size) & + allocate( iwe2_E_iw_fbot(nl, myDim_nod2D) & + , iwe2_E_iw_vdif(nl, myDim_nod2D) & + , iwe2_E_iw_hdif(nl, myDim_nod2D) & + , iwe2_E_iw_fsrf( myDim_nod2D) & ) iwe2_E_iw_fbot( :,:)= 0.0_WP iwe2_E_iw_hdif( :,:)= 0.0_WP @@ -430,7 +453,7 @@ subroutine init_cvmix_idemix2(partit, mesh) iwe2_E_iw_fsrf( :)= 0.0_WP end if if (idemix2_diag_Eiw .or. idemix2_diag_WWI) then - allocate( iwe2_E_iw_dt( nl, node_size)) + allocate( iwe2_E_iw_dt( nl, myDim_nod2D)) iwe2_E_iw_dt( :,:)= 0.0_WP end if @@ -476,28 +499,27 @@ subroutine init_cvmix_idemix2(partit, mesh) ! Diagnostics if (idemix2_diag_Ecompart) then ! diagnostic for M2 spectral energy advection - allocate( iwe2_E_M2_advh(nfbin, node_size) & - , iwe2_E_M2_advs(nfbin, node_size) & - , iwe2_E_M2_diss(nfbin, node_size) & - , iwe2_E_M2_forc(nfbin, node_size) & - , iwe2_E_M2_refl(nfbin, node_size) ) + allocate( iwe2_E_M2_advh(nfbin, myDim_nod2D) & + , iwe2_E_M2_advs(nfbin, myDim_nod2D) & + , iwe2_E_M2_diss(nfbin, myDim_nod2D) & + , iwe2_E_M2_forc(nfbin, myDim_nod2D) ) + allocate( iwe2_E_M2_refl( myDim_nod2D) ) iwe2_E_M2_advh(:,:) = 0.0_WP iwe2_E_M2_advs(:,:) = 0.0_WP iwe2_E_M2_diss(:,:) = 0.0_WP iwe2_E_M2_forc(:,:) = 0.0_WP - iwe2_E_M2_refl(:,:) = 0.0_WP + iwe2_E_M2_refl(:) = 0.0_WP end if - + if (idemix2_diag_Ecompart .or. idemix2_diag_WWI) then - ! diagnostic for M2 spectral energy advection - allocate( iwe2_E_M2_dt( nfbin, node_size) ) - iwe2_E_M2_dt( :,:) = 0.0_WP - end if - + allocate( iwe2_E_M2_dt(nfbin, myDim_nod2D) ) + iwe2_E_M2_dt(:,:) = 0.0_WP + end if + if (idemix2_diag_WWI) then ! diagnostic for M2 wave-wave interaction - allocate( iwe2_E_iw_diss_M2( nl , node_size ) & - , iwe2_E_M2_diss_wwi(nfbin, node_size) ) + allocate( iwe2_E_iw_diss_M2(nl, myDim_nod2D) & + , iwe2_E_M2_diss_wwi(nfbin, myDim_nod2D) ) iwe2_E_iw_diss_M2( :,:) = 0.0_WP iwe2_E_M2_diss_wwi(:,:) = 0.0_WP end if @@ -545,40 +567,43 @@ subroutine init_cvmix_idemix2(partit, mesh) ! Diagnostics if (idemix2_diag_Ecompart) then ! diagnostic for niw spectral energy advection - allocate( iwe2_E_niw_advh(nfbin, node_size) & - , iwe2_E_niw_advs(nfbin, node_size) & - , iwe2_E_niw_diss(nfbin, node_size) & - , iwe2_E_niw_forc(nfbin, node_size) & - , iwe2_E_niw_refl(nfbin, node_size) ) + allocate( iwe2_E_niw_advh(nfbin, myDim_nod2D) & + , iwe2_E_niw_advs(nfbin, myDim_nod2D) & + , iwe2_E_niw_diss(nfbin, myDim_nod2D) & + , iwe2_E_niw_forc(nfbin, myDim_nod2D) ) + allocate( iwe2_E_niw_refl( myDim_nod2D) ) iwe2_E_niw_advh(:,:) = 0.0_WP iwe2_E_niw_advs(:,:) = 0.0_WP iwe2_E_niw_diss(:,:) = 0.0_WP iwe2_E_niw_forc(:,:) = 0.0_WP - iwe2_E_niw_refl(:,:) = 0.0_WP + iwe2_E_niw_refl(:) = 0.0_WP end if - + if (idemix2_diag_Ecompart .or. idemix2_diag_WWI) then - ! diagnostic for niw spectral energy advection - allocate( iwe2_E_niw_dt( nfbin, node_size)) - iwe2_E_niw_dt( :,:) = 0.0_WP + allocate( iwe2_E_niw_dt(nfbin, myDim_nod2D) ) + iwe2_E_niw_dt(:,:) = 0.0_WP end if - + if (idemix2_diag_WWI) then ! diagnostic for niw wave-wave interaction - allocate( iwe2_E_iw_diss_niw(nl, node_size) ) + allocate( iwe2_E_iw_diss_niw(nl, myDim_nod2D) ) iwe2_E_iw_diss_niw(:,:) = 0.0_WP end if end if - ! reflected boundary condition - allocate(iwe2_refl_bin(myDim_edge2D)) - allocate(iwe2_refl_sgn(myDim_edge2D)) - allocate(iwe2_refl_src(idemix2_nfbin, myDim_nod2D)) - allocate(iwe2_refl_node(myDim_nod2D+eDim_nod2D)) - iwe2_refl_bin(:) = 0 - iwe2_refl_sgn(:) = 0 - iwe2_refl_src(:,:)= 0.0_WP - iwe2_refl_node(:) = .false. + ! reflected boundary condition (only needed when M2 or NIW compartments are active) + if (idemix2_enable_M2 .or. idemix2_enable_niw) then + allocate(iwe2_refl_bin(myDim_edge2D)) + allocate(iwe2_refl_sgn(myDim_edge2D)) + allocate(iwe2_refl_src(idemix2_nfbin, myDim_nod2D)) + allocate(iwe2_refl_node(myDim_nod2D+eDim_nod2D)) + allocate(iwe2_coast_node(myDim_nod2D+eDim_nod2D)) + iwe2_refl_bin(:) = 0 + iwe2_refl_sgn(:) = 0 + iwe2_refl_src(:,:)= 0.0_WP + iwe2_refl_node(:) = .false. + iwe2_coast_node(:)= .false. + end if ! allocate 1d Spectral space coordinates allocate( iwe2_phit( nfbin) & @@ -663,13 +688,16 @@ subroutine init_cvmix_idemix2(partit, mesh) !_______________________________________________________________________ ! pre-compute reflective coastal BC lookup tables - call init_reflect_bc( iwe2_refl_bin & ! OUT: mirror spectral bin index per coast edge (0=not coast) - , iwe2_refl_sgn & ! OUT: sign per coast edge (+1 if ednodes(1) is coast, -1 otherwise) - , iwe2_refl_src & ! OUT: per-timestep reflect source accumulator (m²/s³) - , iwe2_refl_node & ! OUT: logical mask, .true. for coast-adjacent nodes - , partit & ! IN - , mesh & ! IN - ) + if (idemix2_enable_M2 .or. idemix2_enable_niw) then + call init_reflect_bc( iwe2_refl_bin & ! OUT: mirror spectral bin index per coast edge (0=not coast) + , iwe2_refl_sgn & ! OUT: sign per coast edge (+1 if ednodes(1) is coast, -1 otherwise) + , iwe2_refl_src & ! OUT: per-timestep reflect source accumulator (m²/s³) + , iwe2_refl_node & ! OUT: logical mask, .true. for coast-adjacent interior nodes + , iwe2_coast_node & ! OUT: logical mask, .true. for coast nodes themselves + , partit & ! IN + , mesh & ! IN + ) + end if !_______________________________________________________________________ ! read idemix M2 forcing from cfsr data --> file @@ -985,6 +1013,10 @@ subroutine init_cvmix_idemix2(partit, mesh) , mu0 = idemix2_mu0 & !IN: wave-wave interaction coefficient , nfbin = idemix2_nfbin & !IN: number of spectral angular bins , shelf_dist = idemix2_shelf_dist & !IN: shelf distance threshold (m) + , tau_niw_shelf = idemix2_tau_niw_shelf & !IN: NIW shelf dissipation timescale (s) + , tau_niw_oce = idemix2_tau_niw_oce & !IN: NIW open-ocean floor timescale (s) + , tau_M2_shelf = idemix2_tau_M2_shelf & !IN: M2 shelf dissipation timescale (s) + , tau_M2_oce = idemix2_tau_M2_oce & !IN: M2 open-ocean floor timescale (s) , enable_M2 = idemix2_enable_M2 & !IN: activate M2 tidal compartment , enable_niw = idemix2_enable_niw & !IN: activate NIW compartment , enable_AB_timestep = idemix2_enable_AB & !IN: use Adams-Bashforth 2nd-order time stepping @@ -1012,25 +1044,29 @@ end subroutine init_cvmix_idemix2 ! │ ! │ iwe2_bc_reflect_bin(edge) = kk (mirror spectral bin) ! │ iwe2_bc_reflect_sgn(edge) = +1 (coast = ednodes(1)) - subroutine init_reflect_bc( refl_bin & - , refl_sgn & - , refl_src & - , refl_node & - , partit & - , mesh & + subroutine init_reflect_bc( refl_bin & + , refl_sgn & + , refl_src & + , refl_node & + , coast_node & + , partit & + , mesh & ) implicit none - type(t_mesh) , intent(in), target :: mesh - type(t_partit), intent(in), target :: partit - integer , intent(inout) :: refl_bin(partit%myDim_edge2D) - integer , intent(inout) :: refl_sgn(partit%myDim_edge2D) - real(kind=WP) , intent(inout) :: refl_src(idemix2_nfbin, partit%myDim_nod2D) - logical , intent(inout) :: refl_node(partit%myDim_nod2D+partit%eDim_nod2D) + type(t_mesh) , intent(in) , target :: mesh + type(t_partit), intent(inout), target :: partit + integer , intent(inout) :: refl_bin(partit%myDim_edge2D) + integer , intent(inout) :: refl_sgn(partit%myDim_edge2D) + real(kind=WP) , intent(inout) :: refl_src(idemix2_nfbin, partit%myDim_nod2D) + logical , intent(inout) :: refl_node(partit%myDim_nod2D+partit%eDim_nod2D) + logical , intent(inout) :: coast_node(partit%myDim_nod2D+partit%eDim_nod2D) integer :: edge, n1, n2, n_int, node, kk_bc, fbinj, nfbin real(kind=WP) :: lon1, lat1, lon2, lat2, lat_mean real(kind=WP) :: edge_dx, edge_dy, phi_mirror, dist, dist_min logical, allocatable :: is_coast_node(:) + real(kind=WP), allocatable :: coast_flag(:) + integer :: loc_cnt(3), glb_cnt(3) #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" @@ -1100,15 +1136,21 @@ subroutine init_reflect_bc( refl_bin & ! propagation direction at the last ocean node. ! refl_src(:,:) = 0.0_WP - ! a node is a coast node if it belongs to at least one boundary edge + ! a node is a coast node if it belongs to at least one boundary edge. + ! exchange_nod propagates coast status to halo nodes whose coast edge + ! lives on a neighbouring MPI task (no logical overload → real proxy). allocate(is_coast_node(myDim_nod2D+eDim_nod2D)) - is_coast_node(:) = .false. + allocate(coast_flag(myDim_nod2D+eDim_nod2D)) + coast_flag(:) = 0.0_WP do edge = 1, myDim_edge2D if (edge_tri(2, edge) == 0) then - is_coast_node(edges(1, edge)) = .true. - is_coast_node(edges(2, edge)) = .true. + coast_flag(edges(1, edge)) = 1.0_WP + coast_flag(edges(2, edge)) = 1.0_WP end if end do + call exchange_nod(coast_flag, partit) + is_coast_node = (coast_flag > 0.5_WP) + deallocate(coast_flag) do edge = 1, myDim_edge2D if (edge_tri(2, edge) == 0) cycle ! skip coast-parallel boundary edges @@ -1160,9 +1202,20 @@ subroutine init_reflect_bc( refl_bin & if (n_int <= myDim_nod2D) refl_node(n_int) = .true. end do + coast_node = is_coast_node deallocate(is_coast_node) - - if (mype==0) write(*,*) ' ├> IDEMIX2 reflective coastal BC lookup table built' + + ! global diagnostic: reduce counts across all MPI ranks and print on rank 0 + loc_cnt(1) = count(edge_tri(2, 1:myDim_edge2D) == 0) + loc_cnt(2) = count(refl_bin(1:myDim_edge2D) > 0) + loc_cnt(3) = count(refl_node(1:myDim_nod2D)) + call MPI_AllREDUCE(loc_cnt, glb_cnt, 3, MPI_INTEGER, MPI_SUM, MPI_COMM_FESOM, MPIerr) + if (mype==0) then + write(*,*) ' ├> IDEMIX2 reflective coastal BC lookup table built' + write(*,*) ' │ boundary edges (edge_tri(2)==0) [global] : ', glb_cnt(1) + write(*,*) ' │ coast-adj. interior edges flagged [global] : ', glb_cnt(2) + write(*,*) ' │ coast-adj. interior nodes flagged [global] : ', glb_cnt(3) + end if end subroutine init_reflect_bc @@ -1609,7 +1662,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) do node = 1, myDim_nod2D+eDim_nod2D uln = ulevels_nod2D(node) nln = nlevels_nod2D(node) - if (idemix2_diag_Eiw) then + if (idemix2_diag_Eiw .and. node <= myDim_nod2D) then call cvmix_idemix2_compute_vdiff_vdiss_Eiw( & nlev = nln-uln+1 & !IN: number of active levels , dzw = hnode( uln:nln-1, node) & !IN: layer thickness (m) @@ -1662,7 +1715,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ! implicit call aliases Eiw_old and Eiw to the same array, making any ! in-subroutine Eiw-Eiw_old difference zero (Fortran aliasing bug). if ((idemix2_enable_hor_diff_expl .or. idemix2_enable_hor_diff_impl_iter) .and. idemix2_diag_Eiw) then - iwe2_E_iw_hdif = -iwe2_E_iw(:, :, iwe2_tip1) + iwe2_E_iw_hdif = -iwe2_E_iw(:, 1:myDim_nod2D, iwe2_tip1) end if if (idemix2_enable_hor_diff_expl) then @@ -1716,7 +1769,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) nln = nlevels_nod2D(node) !_______________________________________________________________ if (idemix2_enable_M2 .and. idemix2_enable_niw) then - if (idemix2_diag_WWI) then + if (idemix2_diag_WWI .and. node <= myDim_nod2D) then call cvmix_idemix2_compute_Eiw_waveinteract( & nlev = nln-uln+1 & !IN: number of active levels , nfbin = idemix2_nfbin & !IN: number of spectral angular bins @@ -1764,7 +1817,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) end if elseif (idemix2_enable_M2) then - if (idemix2_diag_WWI) then + if (idemix2_diag_WWI .and. node <= myDim_nod2D) then call cvmix_idemix2_compute_Eiw_waveinteract( & nlev = nln-uln+1 & !IN: number of active levels , nfbin = idemix2_nfbin & !IN: number of spectral angular bins @@ -1802,7 +1855,7 @@ subroutine calc_cvmix_idemix2(istep, partit, mesh) ) end if elseif (idemix2_enable_niw) then - if (idemix2_diag_WWI) then + if (idemix2_diag_WWI .and. node <= myDim_nod2D) then call cvmix_idemix2_compute_Eiw_waveinteract( & nlev = nln-uln+1 & !IN: number of active levels , nfbin = idemix2_nfbin & !IN: number of spectral angular bins @@ -2247,20 +2300,22 @@ end subroutine adv_Ecompart_hor_spctrl_superbee ! subroutine apply_reflect_bc_spctrl( flux & , refl_src & + , refl_flux & , refl_bin & , refl_sgn & , vol_s & - , partit & + , partit & , mesh) implicit none !___INPUT/OUTPUT VARIABLES______________________________________________ type(t_partit), intent(inout), target :: partit type(t_mesh) , intent(in ), target :: mesh - real(kind=WP) , intent(inout) :: flux(idemix2_nfbin, partit%myDim_edge2D) - integer , intent(in ) :: refl_bin( partit%myDim_edge2D ) - integer , intent(in ) :: refl_sgn( partit%myDim_edge2D ) - real(kind=WP) , intent(out ) :: refl_src(idemix2_nfbin, partit%myDim_nod2D) - real(kind=WP) , intent(in ) :: vol_s(partit%myDim_nod2D+partit%eDim_nod2D) + real(kind=WP) , intent(inout) :: flux( idemix2_nfbin, partit%myDim_edge2D) + integer , intent(in ) :: refl_bin( partit%myDim_edge2D) + integer , intent(in ) :: refl_sgn( partit%myDim_edge2D) + real(kind=WP) , intent(out ) :: refl_src( idemix2_nfbin, partit%myDim_nod2D) + real(kind=WP) , intent(out ) :: refl_flux( partit%myDim_nod2D) + real(kind=WP) , intent(in ) :: vol_s( partit%myDim_nod2D+partit%eDim_nod2D) !___LOCAL VARIABLES_____________________________________________________ integer :: edge, fbini, kk, nfbin, sgn, n_int real(kind=WP) :: outflux, ivols_int @@ -2271,7 +2326,8 @@ subroutine apply_reflect_bc_spctrl( flux & nfbin = idemix2_nfbin - refl_src(:,:) = 0.0_WP + refl_src( :,:) = 0.0_WP + refl_flux(:) = 0.0_WP ! Zero every coast-directed flux so no energy reaches the coast node. ! For each blocked flux in bin fbini, accumulate two terms into reflect_src: @@ -2279,7 +2335,7 @@ subroutine apply_reflect_bc_spctrl( flux & ! -sgn*outflux in source bin fbini (energy lost from incident direction) ! Net: energy is redistributed fbini→kk at n_int with zero total change. ! Applied to Edivh after adv_Ecompart_flx2tra_spctrl in hsintegrate_Ecompart. -!$OMP PARALLEL DO PRIVATE(edge, fbini, kk, sgn, n_int, outflux) +!$OMP PARALLEL DO PRIVATE(edge, fbini, kk, sgn, n_int, outflux, ivols_int) do edge = 1, myDim_edge2D kk = refl_bin(edge) ! edge is not connected to coast @@ -2295,7 +2351,7 @@ subroutine apply_reflect_bc_spctrl( flux & n_int = merge(edges(2, edge), edges(1, edge), sgn == +1) ! local scaler volume - ivols_int = 1/vol_s(n_int) + ivols_int = 1.0_WP/vol_s(n_int) do fbini = 2, nfbin-1 outflux = flux(fbini, edge)*ivols_int @@ -2307,8 +2363,11 @@ subroutine apply_reflect_bc_spctrl( flux & refl_src(kk, n_int) = refl_src(kk, n_int) + sgn * outflux !$OMP ATOMIC refl_src(fbini, n_int) = refl_src(fbini, n_int) - sgn * outflux +!$OMP ATOMIC + refl_flux(n_int) = refl_flux(n_int) + sgn * outflux end if end if + end do ! --> do fbini = 2, nfbin-1 end do ! --> do edge = 1, myDim_edge2D !$OMP END PARALLEL DO @@ -2753,11 +2812,12 @@ subroutine hsintegrate_Ecompart( & real(kind=WP) , intent(inout), optional:: Eadvs( idemix2_nfbin, partit%myDim_nod2D) real(kind=WP) , intent(inout), optional:: Ediss( idemix2_nfbin, partit%myDim_nod2D) real(kind=WP) , intent(inout), optional:: Eforc( idemix2_nfbin, partit%myDim_nod2D) - real(kind=WP) , intent(inout), optional:: Erefl( idemix2_nfbin, partit%myDim_nod2D) - + real(kind=WP) , intent(inout), optional:: Erefl( partit%myDim_nod2D) + !___LOCAL VARIABLES_____________________________________________________ integer :: node, fbini, nfbin real(kind=WP) :: inv_denom + real(kind=WP) :: refl_flux(partit%myDim_nod2D) #include "../associate_part_def.h" #include "../associate_mesh_def.h" #include "../associate_part_ass.h" @@ -2794,6 +2854,7 @@ subroutine hsintegrate_Ecompart( & ! apply reflective coastal BC: redirect coast-directed fluxes into mirror bins call apply_reflect_bc_spctrl( flx_uv & , refl_src & + , refl_flux & , refl_bin & , refl_sgn & , vol_s & @@ -2912,7 +2973,7 @@ subroutine hsintegrate_Ecompart( & if (present(Eforc)) Eforc(:,:) = forc(:, 1:myDim_nod2D) - if (present(Erefl)) Erefl(:,:) = refl_src(:, 1:myDim_nod2D) + if (present(Erefl)) Erefl(:) = refl_flux(1:myDim_nod2D) end subroutine hsintegrate_Ecompart diff --git a/src/io_meandata.F90 b/src/io_meandata.F90 index afe6f8ff4..6aaf6521b 100644 --- a/src/io_meandata.F90 +++ b/src/io_meandata.F90 @@ -1758,13 +1758,12 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Em2_strct' , 'EM2 structure function energy' , 'm^2/s^2' , iwe2_E_M2_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) ! optional diagnostic if (idemix2_diag_Ecompart) then - if (allocated(iwe2_E_M2_refl )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_refl' , 'EM2 coast-reflect. accumulated flux', 'm^2/s^3' , iwe2_E_M2_refl(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_M2_refl )) call def_stream(nod2d, myDim_nod2D, 'iwe2_Em2_refl' , 'EM2 coast-intercept. accumulated flux', 'm^2/s^3', iwe2_E_M2_refl(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_M2_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_dt' , 'EM2 total tendency' , 'm^2/s^3' , iwe2_E_M2_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_M2_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advh' , 'EM2 horizontal advection' , 'm^2/s^3' , iwe2_E_M2_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_M2_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_advs' , 'EM2 spectral advection' , 'm^2/s^3' , iwe2_E_M2_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_M2_diss )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_diss' , 'EM2 dissipation' , 'm^2/s^3' , iwe2_E_M2_diss(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_M2_forc )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Em2_forc' , 'EM2 forcing tendency' , 'm^2/s^3' , iwe2_E_M2_forc(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) - end if if (idemix2_diag_WWI) then if (allocated(iwe2_E_iw_diss_M2)) call def_stream((/nl ,nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eiw_dissM2' , 'Eiw dissipation through M2 WWI' , 'm^2/s^3' , iwe2_E_iw_diss_M2(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) @@ -1785,7 +1784,7 @@ subroutine ini_mean_io(ice, dynamics, tracers, partit, mesh) call def_stream((/nl , nod2d/),(/nl ,myDim_nod2D /), 'iwe2_Eniw_strct' , 'Eniw structure function energy' , 'm^2/s^2' , iwe2_E_niw_struct(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) ! optional diagnostic if (idemix2_diag_Ecompart) then - if (allocated(iwe2_E_niw_refl )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_refl' , 'Eniw coast-reflect. accumulated flux', 'm^2/s^3', iwe2_E_niw_refl(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) + if (allocated(iwe2_E_niw_refl )) call def_stream(nod2d, myDim_nod2D, 'iwe2_Eniw_refl' , 'Eniw coast-intercept. accumulated flux', 'm^2/s^3', iwe2_E_niw_refl(:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_niw_dt )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_dt' , 'Eniw total tendency' , 'm^2/s^3' , iwe2_E_niw_dt( :,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_niw_advh )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advh' , 'Eniw horizontal advection' , 'm^2/s^3' , iwe2_E_niw_advh(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) if (allocated(iwe2_E_niw_advs )) call def_stream((/idemix2_nfbin, nod2d/),(/idemix2_nfbin,myDim_nod2D /), 'iwe2_Eniw_advs' , 'Eniw spectral advection' , 'm^2/s^3' , iwe2_E_niw_advs(:,:) , io_list(i)%freq, io_list(i)%unit, io_list(i)%precision, partit, mesh) diff --git a/src/io_mesh_info.F90 b/src/io_mesh_info.F90 index 79288c307..1a3725fc5 100644 --- a/src/io_mesh_info.F90 +++ b/src/io_mesh_info.F90 @@ -5,6 +5,8 @@ module io_mesh_info use g_config use g_comm_auto use o_PARAM +use g_cvmix_idemix2, only: iwe2_refl_bin, iwe2_refl_sgn, iwe2_refl_node, iwe2_coast_node, & + idemix2_enable_M2, idemix2_enable_niw use netcdf implicit none @@ -46,6 +48,7 @@ subroutine write_mesh_info(partit, mesh) integer :: lon_id, lat_id ! UGRID NAMES START HERE integer :: face_node_id, edge_nodes_id, face_edges_id, face_links_id, edge_face_links_id + integer :: iwe2_refl_bin_id, iwe2_refl_sgn_id, iwe2_refl_node_id, iwe2_coast_node_id character(100) :: longname character(2000) :: filename real(kind=WP), allocatable :: rbuffer(:), lrbuffer(:) @@ -327,6 +330,12 @@ subroutine write_mesh_info(partit, mesh) call my_def_var(ncid, 'gradient_sca_y', NF90_DOUBLE, 2, (/elem_n_id, id_3/), gradient_sca_y_id, 'y component of a gradient at nodes of an element', partit) call my_def_var(ncid, 'gradient_vec_x', NF90_DOUBLE, 2, (/elem_n_id, id_3/), gradient_vec_x_id, 'x component of a gradient at elements of an element', partit) call my_def_var(ncid, 'gradient_vec_y', NF90_DOUBLE, 2, (/elem_n_id, id_3/), gradient_vec_y_id, 'y component of a gradient at elements of an element', partit) + if (mod(mix_scheme_nmb,10)==7 .and. (idemix2_enable_M2 .or. idemix2_enable_niw)) then + call my_def_var(ncid, 'iwe2_refl_bin', NF90_INT, 1, (/edge_n_id/), iwe2_refl_bin_id, 'IDEMIX2 reflect BC: mirror spectral bin per coast edge (0=interior)', partit) + call my_def_var(ncid, 'iwe2_refl_sgn', NF90_INT, 1, (/edge_n_id/), iwe2_refl_sgn_id, 'IDEMIX2 reflect BC: coast-node sign per edge (+1 node1 coast, -1 node2 coast)', partit) + call my_def_var(ncid, 'iwe2_refl_node', NF90_INT, 1, (/nod_n_id/), iwe2_refl_node_id, 'IDEMIX2 reflect BC: coast-adjacent interior node mask (0/1)', partit) + call my_def_var(ncid, 'iwe2_coast_node', NF90_INT, 1, (/nod_n_id/), iwe2_coast_node_id, 'IDEMIX2 reflect BC: coast node mask after MPI halo exchange (0/1)', partit) + end if call my_nf90_enddef(ncid, partit) ! NOTE(PG): Same order as definition! @@ -591,6 +600,25 @@ subroutine write_mesh_info(partit, mesh) deallocate(rbuffer) endif + if (mod(mix_scheme_nmb,10)==7 .and. (idemix2_enable_M2 .or. idemix2_enable_niw)) then + allocate(ibuffer(edge2D)) + call gather_edge(iwe2_refl_bin(1:myDim_edge2D), ibuffer, partit) + call my_put_vara(ncid, iwe2_refl_bin_id, 1, edge2D, ibuffer, partit) + call gather_edge(iwe2_refl_sgn(1:myDim_edge2D), ibuffer, partit) + call my_put_vara(ncid, iwe2_refl_sgn_id, 1, edge2D, ibuffer, partit) + deallocate(ibuffer) + + allocate(ibuffer(nod2D)) + allocate(lbuffer(myDim_nod2D)) + lbuffer = merge(1, 0, iwe2_refl_node(1:myDim_nod2D)) + call gather_nod(lbuffer, ibuffer, partit) + call my_put_vara(ncid, iwe2_refl_node_id, 1, nod2D, ibuffer, partit) + lbuffer = merge(1, 0, iwe2_coast_node(1:myDim_nod2D)) + call gather_nod(lbuffer, ibuffer, partit) + call my_put_vara(ncid, iwe2_coast_node_id, 1, nod2D, ibuffer, partit) + deallocate(lbuffer, ibuffer) + end if + call my_close(ncid, partit) end subroutine write_mesh_info From aba90b9c0861f2e7d0f785fda0ec8098f3ba673a Mon Sep 17 00:00:00 2001 From: Patrick Date: Wed, 24 Jun 2026 12:28:02 +0200 Subject: [PATCH 62/63] change one default parameter --- src/cvmix_driver/gen_modules_cvmix_idemix2.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 5ca3fe2c2..2040fd776 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -103,7 +103,7 @@ module g_cvmix_idemix2 ! | pyOM2_fpohlmann | 3 days | fast dissipation, stays near source | ! | FESOM2 default | 3 days | matches pyOM2_fpohlmann | real(kind=WP) :: idemix2_tau_niw_shelf = 7.0_WP - real(kind=WP) :: idemix2_tau_niw_oce = 3.0_WP ! pyOM2_fpohlmann default; pyOM2_orig: 50.0 + real(kind=WP) :: idemix2_tau_niw_oce = 50.0_WP ! pyOM2_fpohlmann default; pyOM2_orig: 50.0 real(kind=WP) :: idemix2_tau_M2_shelf = 7.0_WP real(kind=WP) :: idemix2_tau_M2_oce = 50.0_WP From c8c306cd35d7681b421d1389407a0d3a37edfcbe Mon Sep 17 00:00:00 2001 From: Patrick Date: Tue, 30 Jun 2026 15:03:09 +0200 Subject: [PATCH 63/63] idemix2: resolve cosu/coslat question and fix reflect-BC coordinate frame Two related fixes after investigating pyOM2's spherical-coordinate treatment of the spectral group velocity: cvmix_idemix2.F90 -- v_compart: drop coslat, replace tentative comment pyOM2 multiplies v_M2 by cosu(j) because on a lat-lon B-grid the V-face arc-length is r*cos(lat_face)*dx, so the cell-budget reads [cosu(j)*v*E(j) - cosu(j-1)*v*E(j-1)] / (cost(j)*dyt(j)), which is the correct discrete form of (1/r cos phi) d(cos phi * F_y)/dphi. In FESOM2's unstructured FV scheme the cos(lat) metric is already embedded in the physical edge lengths (via elem_cos) and the true nodal control-volume vol_s; adding an extra coslat factor on v_compart would double-count the metric and bias meridional transport by O(cos lat). FESOM2 standard tracer advection applies the same convention, so omitting coslat here is consistent. The old placeholder comment is replaced with this explanation. gen_modules_cvmix_idemix2.F90 -- init_reflect_bc: use coord_nod2D not geo_coord_nod2D The mirror spectral bin for a coast edge is found by computing the angle from coast node to interior node and matching it to phit(k). phit lives in the rotated model frame because u_compart = cg*cos(phit) is projected onto edge_cross_dxdy, which is built from coord_nod2D with the rotated- latitude cos metric. Using geographic coordinates geo_coord_nod2D introduced a misalignment between the reflected bin and the actual propagation direction in non-trivial mesh rotations. --- src/cvmix_driver/cvmix_idemix2.F90 | 11 +++++++++-- src/cvmix_driver/gen_modules_cvmix_idemix2.F90 | 10 +++++++--- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/src/cvmix_driver/cvmix_idemix2.F90 b/src/cvmix_driver/cvmix_idemix2.F90 index d97ecf165..b24430e39 100644 --- a/src/cvmix_driver/cvmix_idemix2.F90 +++ b/src/cvmix_driver/cvmix_idemix2.F90 @@ -466,8 +466,15 @@ subroutine compute_compart_groupvel( & ! do fbin_i=2,nfbin-1 do fbin_i=1, nfbin ! --> include ghost cells ofthe periodic boundary u_compart(fbin_i) = cg_compart*cos( phit(fbin_i) ) - ! Keep coslat to match pyOM2 - need to investigate divergence normalization - ! v_compart(fbin_i) = cg_compart*sin( phit(fbin_i) ) * coslat + ! pyOM2 has v_M2 = cg*sin(phi)*cosu(j): the V-face zonal width on a lat-lon + ! grid is r*cos(lat_face)*dx, so the FV budget gives cosu/cost*dyt in the + ! denominator — this correctly implements the spherical divergence metric + ! term 1/(r*cos)*d(cos*v*E)/dlat = -v*tan(lat)/r * E (convergence of meridians). + ! In FESOM2 the FV scheme computes EUCLIDEAN divergence on the unstructured + ! mesh; multiplying v_compart by cos(lat) would NOT reproduce pyOM2's + ! correction (different denominator structure). The proper fix would be an + ! explicit source +cg*sin(phi)*tan(lat)/r * E per bin, but FESOM2 standard + ! tracer advection omits this metric term too — omitting it here is consistent. v_compart(fbin_i) = cg_compart*sin( phit(fbin_i) ) w_compart(fbin_i) = (kdot_y*cos(phiu(fbin_i)) + kdot_x*sin(phiu(fbin_i)) ) end do diff --git a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 index 2040fd776..37302c7c9 100644 --- a/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 +++ b/src/cvmix_driver/gen_modules_cvmix_idemix2.F90 @@ -1159,9 +1159,13 @@ subroutine init_reflect_bc( refl_bin & ! only process edges with exactly one coast node if (is_coast_node(n1) .eqv. is_coast_node(n2)) cycle - ! geographic coordinates of the two nodes (lon/lat in radians) - lon1 = geo_coord_nod2D(1, n1); lat1 = geo_coord_nod2D(2, n1) - lon2 = geo_coord_nod2D(1, n2); lat2 = geo_coord_nod2D(2, n2) + ! rotated model coordinates of the two nodes (lon/lat in radians). + ! Must use coord_nod2D (rotated) NOT geo_coord_nod2D (geographic): + ! the spectral bins phit(k) are in the rotated frame because + ! u_compart = cg*cos(phit) is projected onto edge_cross_dxdy, + ! which is built from coord_nod2D with cos(rotated_lat) metric. + lon1 = coord_nod2D(1, n1); lat1 = coord_nod2D(2, n1) + lon2 = coord_nod2D(1, n2); lat2 = coord_nod2D(2, n2) lat_mean = 0.5_WP*(lat1 + lat2) ! edge direction FROM coast node BACK TO interior node (the reflection direction)