From 8da1fd1aff10fa4deb424b4393c7d5b55a5f3b23 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Wed, 10 May 2023 08:22:51 +0100 Subject: [PATCH 01/34] Initial work on new thermodynamics --- convention.txt | 8 +-- models/3d/moist_3d.f90 | 2 +- src/3d/fields/field_netcdf.f90 | 76 ++++++++++++++++------------- src/3d/fields/fields.f90 | 21 ++++---- src/3d/parcels/parcel_container.f90 | 44 ++++++++++------- src/3d/parcels/parcel_init.f90 | 27 +++++----- src/3d/parcels/parcel_merge.f90 | 25 ++++++---- src/3d/parcels/parcel_netcdf.f90 | 55 +++++++++++++-------- 8 files changed, 152 insertions(+), 106 deletions(-) diff --git a/convention.txt b/convention.txt index 1ea29ad9f..d79d67cd2 100644 --- a/convention.txt +++ b/convention.txt @@ -4,8 +4,8 @@ volg -- volume velog -- velocity velgradg -- velocity gradient tensor vortg -- vorticity -tbuoyg -- total buoyancy -dbuoyg -- dry buoyancy -humg -- specific humidity -humlig -- condensed humidity +tbuoyg -- total buoyancy (in m/s^2) +thetag -- potential temperature +qvg -- water vapour specific humidity +qlg -- liquid water specific humidity nparg -- number of parcels per grid box diff --git a/models/3d/moist_3d.f90 b/models/3d/moist_3d.f90 index 4e2c18a27..fceeb88b5 100644 --- a/models/3d/moist_3d.f90 +++ b/models/3d/moist_3d.f90 @@ -30,7 +30,7 @@ module moist_3d double precision :: e_values(3) ! To create asymmetry, we vary the buoyancy in the plume ! according to b = b_pl*[1 + (e1*x*y+e2*x*z+e3*yz)/R^2]. double precision :: r_smooth_frac ! Fraction of radius where smooth transition starts - + end type plume_type type(plume_type) :: moist diff --git a/src/3d/fields/field_netcdf.f90 b/src/3d/fields/field_netcdf.f90 index dbd763bb3..290c09610 100644 --- a/src/3d/fields/field_netcdf.f90 +++ b/src/3d/fields/field_netcdf.f90 @@ -23,7 +23,7 @@ module field_netcdf integer :: x_vel_id, y_vel_id, z_vel_id, & x_vor_id, y_vor_id, z_vor_id, & - tbuoy_id, vol_id, n_writes + tbuoy_id, theta_id, vol_id, n_writes #ifdef ENABLE_DIAGNOSE integer :: x_vtend_id, y_vtend_id, z_vtend_id, & @@ -31,7 +31,7 @@ module field_netcdf #endif #ifndef ENABLE_DRY_MODE - integer :: dbuoy_id, hum_id, lbuoy_id + integer :: qv_id, ql_id #endif double precision :: restart_time @@ -41,7 +41,7 @@ module field_netcdf coord_ids, t_axis_id, & x_vel_id, y_vel_id, z_vel_id, & x_vor_id, y_vor_id, z_vor_id, & - tbuoy_id, vol_id, & + tbuoy_id, theta_id, vol_id, & n_writes, restart_time #ifdef ENABLE_DIAGNOSE @@ -50,7 +50,7 @@ module field_netcdf #endif #ifndef ENABLE_DRY_MODE - private :: dbuoy_id, hum_id, lbuoy_id + private :: qv_id, ql_id #endif contains @@ -222,33 +222,33 @@ subroutine create_netcdf_field_file(basename, overwrite, l_restart) dimids=dimids, & varid=tbuoy_id) -#ifndef ENABLE_DRY_MODE call define_netcdf_dataset(ncid=ncid, & - name='dry_buoyancy', & - long_name='dry buoyancy', & + name='theta', & + long_name='potential temperature', & std_name='', & - unit='m/s^2', & + unit='K', & dtype=NF90_DOUBLE, & dimids=dimids, & - varid=dbuoy_id) + varid=theta_id) +#ifndef ENABLE_DRY_MODE call define_netcdf_dataset(ncid=ncid, & - name='humidity', & - long_name='specific humidity', & + name='qv', & + long_name='water vapour spec. hum.', & std_name='', & unit='kg/kg', & dtype=NF90_DOUBLE, & dimids=dimids, & - varid=hum_id) + varid=qv_id) call define_netcdf_dataset(ncid=ncid, & - name='liquid_water_content', & - long_name='liquid-water content', & + name='ql', & + long_name='liquid water spec. hum.', & std_name='', & - unit='1', & + unit='kg/kg', & dtype=NF90_DOUBLE, & dimids=dimids, & - varid=lbuoy_id) + varid=ql_id) #endif call define_netcdf_dataset(ncid=ncid, & @@ -312,13 +312,14 @@ subroutine read_netcdf_field_content call get_var_id(ncid, 'buoyancy', tbuoy_id) -#ifndef ENABLE_DRY_MODE - call get_var_id(ncid, 'dry_buoyancy', dbuoy_id) + call get_var_id(ncid, 'theta', theta_id) - call get_var_id(ncid, 'humidity', hum_id) +#ifndef ENABLE_DRY_MODE + call get_var_id(ncid, 'qv', qv_id) - call get_var_id(ncid, 'liquid_water_content', lbuoy_id) + call get_var_id(ncid, 'ql', ql_id) #endif + call get_var_id(ncid, 'volume', vol_id) end subroutine read_netcdf_field_content @@ -392,15 +393,14 @@ subroutine write_netcdf_fields(t) call write_netcdf_dataset(ncid, tbuoy_id, tbuoyg(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)), & start, cnt) -#ifndef ENABLE_DRY_MODE - call write_netcdf_dataset(ncid, dbuoy_id, dbuoyg(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)), & + call write_netcdf_dataset(ncid, theta_id, theta(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)), & start, cnt) - call write_netcdf_dataset(ncid, lbuoy_id, glati * (tbuoyg(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)) & - - dbuoyg(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1))), & +#ifndef ENABLE_DRY_MODE + call write_netcdf_dataset(ncid, qv_id, qvg(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)), & start, cnt) - call write_netcdf_dataset(ncid, hum_id, humg(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)), & + call write_netcdf_dataset(ncid, ql_id, qlg(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)), & start, cnt) #endif @@ -472,10 +472,10 @@ subroutine read_netcdf_fields(fname, step) cnt) endif - if (has_dataset(lid, 'buoyancy')) then + if (has_dataset(lid, 'theta')) then call read_netcdf_dataset(lid, & - 'buoyancy', & - tbuoyg(box%lo(3):box%hi(3), & + 'theta', & + thetag(box%lo(3):box%hi(3), & box%lo(2):box%hi(2), & box%lo(1):box%hi(1)), & start, & @@ -483,12 +483,22 @@ subroutine read_netcdf_fields(fname, step) endif #ifndef ENABLE_DRY_MODE - if (has_dataset(lid, 'humidity')) then + if (has_dataset(lid, 'qv')) then + call read_netcdf_dataset(lid, & + 'qv', & + qvg(box%lo(3):box%hi(3), & + box%lo(2):box%hi(2), & + box%lo(1):box%hi(1)), & + start, & + cnt) + endif + + if (has_dataset(lid, 'ql')) then call read_netcdf_dataset(lid, & - 'humidity', & - humg(box%lo(3):box%hi(3), & - box%lo(2):box%hi(2), & - box%lo(1):box%hi(1)), & + 'ql', & + qlg(box%lo(3):box%hi(3), & + box%lo(2):box%hi(2), & + box%lo(1):box%hi(1)), & start, & cnt) endif diff --git a/src/3d/fields/fields.f90 b/src/3d/fields/fields.f90 index f307d90d5..f54ba2f3a 100644 --- a/src/3d/fields/fields.f90 +++ b/src/3d/fields/fields.f90 @@ -36,8 +36,9 @@ module fields double precision, allocatable, dimension(:, :, :) :: & #ifndef ENABLE_DRY_MODE - dbuoyg, & ! dry buoyancy (or liquid-water buoyancy) - humg, & ! humidity + thetag, & ! dry buoyancy (or liquid-water buoyancy) + qvg, & ! humidity + qlg, & ! liquid water #endif tbuoyg, & ! buoyancy #ifndef NDEBUG @@ -87,10 +88,10 @@ subroutine field_alloc allocate(vtend(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1), n_dim)) allocate(tbuoyg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) - + allocate(thetag(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) #ifndef ENABLE_DRY_MODE - allocate(dbuoyg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) - allocate(humg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) + allocate(qvg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) + allocate(qlg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) #endif allocate(nparg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) @@ -110,9 +111,10 @@ subroutine field_default vortg = zero vtend = zero tbuoyg = zero + thetag = zero #ifndef ENABLE_DRY_MODE - dbuoyg = zero - humg = zero + qvg = zero + qlg = zero #endif nparg = zero nsparg = zero @@ -133,9 +135,10 @@ subroutine field_dealloc deallocate(vortg) deallocate(vtend) deallocate(tbuoyg) + deallocate(thetag) #ifndef ENABLE_DRY_MODE - deallocate(dbuoyg) - deallocate(humg ) + deallocate(qvg) + deallocate(qlg) #endif deallocate(nparg) deallocate(nsparg) diff --git a/src/3d/parcels/parcel_container.f90 b/src/3d/parcels/parcel_container.f90 index 21440b400..3ed3e2894 100644 --- a/src/3d/parcels/parcel_container.f90 +++ b/src/3d/parcels/parcel_container.f90 @@ -27,9 +27,10 @@ module parcel_container IDX_B22, & ! B22 shape matrix element IDX_B23, & ! B23 shape matrix element IDX_VOL, & ! volume - IDX_BUO, & ! buoyancy + IDX_THETA, & ! buoyancy #ifndef ENABLE_DRY_MODE - IDX_HUM, & ! humidity + IDX_QV, & ! water vapour specific humidity + IDX_QL, & ! liquid vapour specific humidity #endif IDX_RK4_X_DPOS, & ! RK4 variable delta x-position IDX_RK4_Y_DPOS, & ! RK4 variable delta y-position @@ -63,9 +64,10 @@ module parcel_container double precision, allocatable, dimension(:) :: & volume, & #ifndef ENABLE_DRY_MODE - humidity, & + qv, & + ql, & #endif - buoyancy + theta ! LS-RK4 variables @@ -100,12 +102,13 @@ subroutine set_buffer_indices IDX_B22 = 10 ! B22 shape matrix element IDX_B23 = 11 ! B23 shape matrix element IDX_VOL = 12 ! volume - IDX_BUO = 13 ! buoyancy + IDX_THETA = 13 ! potential temperature - i = IDX_BUO + 1 + i = IDX_THETA + 1 #ifndef ENABLE_DRY_MODE - IDX_HUM = i - i = i + 1 + IDX_QV = i + IDX_QL = i + 1 + i = i + 2 #endif ! LS-RK4 variables @@ -230,9 +233,10 @@ subroutine parcel_replace(n, m) parcels%position(:, n) = parcels%position(:, m) parcels%vorticity(:, n) = parcels%vorticity(:, m) parcels%volume(n) = parcels%volume(m) - parcels%buoyancy(n) = parcels%buoyancy(m) + parcels%theta(n) = parcels%theta(m) #ifndef ENABLE_DRY_MODE - parcels%humidity(n) = parcels%humidity(m) + parcels%qv(n) = parcels%qv(m) + parcels%ql(n) = parcels%ql(m) #endif parcels%B(:, n) = parcels%B(:, m) @@ -257,9 +261,10 @@ subroutine parcel_alloc(num) allocate(parcels%vorticity(3, num)) allocate(parcels%B(5, num)) allocate(parcels%volume(num)) - allocate(parcels%buoyancy(num)) + allocate(parcels%theta(num)) #ifndef ENABLE_DRY_MODE - allocate(parcels%humidity(num)) + allocate(parcels%qv(num)) + allocate(parcels%ql(num)) #endif call parcel_ellipsoid_allocate(num) @@ -286,9 +291,10 @@ subroutine parcel_dealloc deallocate(parcels%vorticity) deallocate(parcels%B) deallocate(parcels%volume) - deallocate(parcels%buoyancy) + deallocate(parcels%theta) #ifndef ENABLE_DRY_MODE - deallocate(parcels%humidity) + deallocate(parcels%qv) + deallocate(parcels%ql) #endif call parcel_ellipsoid_deallocate @@ -311,9 +317,10 @@ subroutine parcel_serialize(n, buffer) buffer(IDX_X_VOR:IDX_Z_VOR) = parcels%vorticity(:, n) buffer(IDX_B11:IDX_B23) = parcels%B(:, n) buffer(IDX_VOL) = parcels%volume(n) - buffer(IDX_BUO) = parcels%buoyancy(n) + buffer(IDX_THETA) = parcels%theta(n) #ifndef ENABLE_DRY_MODE - buffer(IDX_HUM) = parcels%humidity(n) + buffer(IDX_QV) = parcels%qv(n) + buffer(IDX_QL) = parcels%ql(n) #endif ! LS-RK4 variables: buffer(IDX_RK4_X_DPOS:IDX_RK4_Z_DPOS) = parcels%delta_pos(:, n) @@ -333,9 +340,10 @@ subroutine parcel_deserialize(n, buffer) parcels%vorticity(:, n) = buffer(IDX_X_VOR:IDX_Z_VOR) parcels%B(:, n) = buffer(IDX_B11:IDX_B23) parcels%volume(n) = buffer(IDX_VOL) - parcels%buoyancy(n) = buffer(IDX_BUO) + parcels%theta(n) = buffer(IDX_THETA) #ifndef ENABLE_DRY_MODE - parcels%humidity(n) = buffer(IDX_HUM) + parcels%qv(n) = buffer(IDX_QV) + parcels%ql(n) = buffer(IDX_QL) #endif ! LS-RK4 variables: parcels%delta_pos(:, n) = buffer(IDX_RK4_X_DPOS:IDX_RK4_Z_DPOS) diff --git a/src/3d/parcels/parcel_init.f90 b/src/3d/parcels/parcel_init.f90 index ef30266a4..abe667750 100644 --- a/src/3d/parcels/parcel_init.f90 +++ b/src/3d/parcels/parcel_init.f90 @@ -99,9 +99,10 @@ subroutine parcel_default !$omp do private(n) do n = 1, n_parcels parcels%vorticity(:, n) = zero - parcels%buoyancy(n) = zero + parcels%theta(n) = zero #ifndef ENABLE_DRY_MODE - parcels%humidity(n) = zero + parcels%qv(n) = zero + parcels%ql(n) = zero #endif enddo !$omp end do @@ -190,11 +191,13 @@ subroutine init_parcels_from_grids parcels%vorticity(l, n) = parcels%vorticity(l, n) & + sum(weights * vortg(ks:ks+1, js:js+1, is:is+1, l)) enddo - parcels%buoyancy(n) = parcels%buoyancy(n) & - + sum(weights * tbuoyg(ks:ks+1, js:js+1, is:is+1)) + parcels%theta(n) = parcels%theta(n) & + + sum(weights * thetag(ks:ks+1, js:js+1, is:is+1)) #ifndef ENABLE_DRY_MODE - parcels%humidity(n) = parcels%humidity(n) & - + sum(weights * humg(ks:ks+1, js:js+1, is:is+1)) + parcels%qv(n) = parcels%qv(n) & + + sum(weights * qvg(ks:ks+1, js:js+1, is:is+1)) + parcels%ql(n) = parcels%ql(n) & + + sum(weights * qlg(ks:ks+1, js:js+1, is:is+1)) #endif enddo !$omp end do @@ -208,7 +211,7 @@ end subroutine init_parcels_from_grids subroutine init_fill_halo #ifndef ENABLE_DRY_MODE - integer, parameter :: n_fields = 5 + integer, parameter :: n_fields = 6 #else integer, parameter :: n_fields = 4 #endif @@ -217,9 +220,10 @@ subroutine init_fill_halo call field_interior_to_buffer(vortg(:, :, :, I_X), 1) call field_interior_to_buffer(vortg(:, :, :, I_Y), 2) call field_interior_to_buffer(vortg(:, :, :, I_Z), 3) - call field_interior_to_buffer(tbuoyg, 4) + call field_interior_to_buffer(thetag, 4) #ifndef ENABLE_DRY_MODE - call field_interior_to_buffer(humg, 5) + call field_interior_to_buffer(qvg, 5) + call field_interior_to_buffer(qlg, 6) #endif call interior_to_halo_communication @@ -227,9 +231,10 @@ subroutine init_fill_halo call field_buffer_to_halo(vortg(:, :, :, I_X), 1, .false.) call field_buffer_to_halo(vortg(:, :, :, I_Y), 2, .false.) call field_buffer_to_halo(vortg(:, :, :, I_Z), 3, .false.) - call field_buffer_to_halo(tbuoyg, 4, .false.) + call field_buffer_to_halo(thetag, 4, .false.) #ifndef ENABLE_DRY_MODE - call field_buffer_to_halo(humg, 5, .false.) + call field_buffer_to_halo(qvg, 5, .false.) + call field_buffer_to_halo(qlg, 6, .false.) #endif call field_mpi_dealloc diff --git a/src/3d/parcels/parcel_merge.f90 b/src/3d/parcels/parcel_merge.f90 index 7fc2f7bae..af6584a4d 100644 --- a/src/3d/parcels/parcel_merge.f90 +++ b/src/3d/parcels/parcel_merge.f90 @@ -106,9 +106,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) double precision :: x0(n_merge), y0(n_merge) double precision :: posm(3, n_merge) double precision :: delx, vmerge, dely, delz, B33, mu - double precision :: buoym(n_merge), vortm(3, n_merge) + double precision :: thetam(n_merge), vortm(3, n_merge) #ifndef ENABLE_DRY_MODE - double precision :: hum(n_merge) + double precision :: qvm(n_merge) + double precision :: qlm(n_merge) #endif double precision, intent(out) :: Bm(6, n_merge) ! B11, B12, B13, B22, B23, B33 double precision, intent(out) :: vm(n_merge) @@ -148,9 +149,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) posm(3, l) = parcels%volume(ic) * parcels%position(3, ic) ! buoyancy and humidity - buoym(l) = parcels%volume(ic) * parcels%buoyancy(ic) + thetam(l) = parcels%volume(ic) * parcels%theta(ic) #ifndef ENABLE_DRY_MODE - hum(l) = parcels%volume(ic) * parcels%humidity(ic) + qvm(l) = parcels%volume(ic) * parcels%qv(ic) + qlm(l) = parcels%volume(ic) * parcels%ql(ic) #endif vortm(:, l) = parcels%volume(ic) * parcels%vorticity(:, ic) @@ -175,9 +177,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) posm(3, n) = posm(3, n) + parcels%volume(is) * parcels%position(3, is) ! Accumulate buoyancy and humidity - buoym(n) = buoym(n) + parcels%volume(is) * parcels%buoyancy(is) + thetam(n) = thetam(n) + parcels%volume(is) * parcels%theta(is) #ifndef ENABLE_DRY_MODE - hum(n) = hum(n) + parcels%volume(is) * parcels%humidity(is) + qvm(n) = qvm(n) + parcels%volume(is) * parcels%qv(is) + qlm(n) = qlm(n) + parcels%volume(is) * parcels%ql(is) #endif vortm(:, n) = vortm(:, n) + parcels%volume(is) * parcels%vorticity(:, is) enddo @@ -204,9 +207,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) call apply_periodic_bc(posm(:, m)) ! buoyancy and humidity - buoym(m) = vmerge * buoym(m) + thetam(m) = vmerge * thetam(m) #ifndef ENABLE_DRY_MODE - hum(m) = vmerge * hum(m) + qvm(m) = vmerge * qvm(m) + qlm(m) = vmerge * qlm(m) #endif vortm(:, m) = vmerge * vortm(:, m) enddo @@ -244,9 +248,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) parcels%position(2, ic) = posm(2, l) parcels%position(3, ic) = posm(3, l) - parcels%buoyancy(ic) = buoym(l) + parcels%theta(ic) = thetam(l) #ifndef ENABLE_DRY_MODE - parcels%humidity(ic) = hum(l) + parcels%qv(ic) = qvm(l) + parcels%ql(ic) = qlm(l) #endif parcels%vorticity(:, ic) = vortm(:, l) diff --git a/src/3d/parcels/parcel_netcdf.f90 b/src/3d/parcels/parcel_netcdf.f90 index cae365b41..e7e830766 100644 --- a/src/3d/parcels/parcel_netcdf.f90 +++ b/src/3d/parcels/parcel_netcdf.f90 @@ -25,7 +25,7 @@ module parcel_netcdf character(len=512) :: ncfname integer :: ncid - integer :: npar_dim_id, vol_id, buo_id, & + integer :: npar_dim_id, vol_id, theta_id, & x_pos_id, y_pos_id, z_pos_id, & x_vor_id, y_vor_id, z_vor_id, & b11_id, b12_id, b13_id, & @@ -34,19 +34,19 @@ module parcel_netcdf double precision :: restart_time #ifndef ENABLE_DRY_MODE - integer :: hum_id + integer :: qv_id, ql_id #endif private :: ncid, ncfname, n_writes, npar_dim_id, & x_pos_id, y_pos_id, z_pos_id, start_id, & x_vor_id, y_vor_id, z_vor_id, & b11_id, b12_id, b13_id, b22_id, b23_id, & - vol_id, buo_id, t_dim_id, t_axis_id, & + vol_id, theta_id, t_dim_id, t_axis_id, & restart_time, mpi_dim_id, & read_chunk #ifndef ENABLE_DRY_MODE - private :: hum_id + private :: qv_id, ql_id #endif private :: ncbasename @@ -238,23 +238,32 @@ subroutine create_netcdf_parcel_file(basename, overwrite, l_restart) varid=z_vor_id) call define_netcdf_dataset(ncid=ncid, & - name='buoyancy', & - long_name='parcel buoyancy', & + name='theta', & + long_name='parcel potential temperature',& std_name='', & - unit='m/s^2', & + unit='K', & dtype=NF90_DOUBLE, & dimids=dimids, & - varid=buo_id) + varid=theta_id) #ifndef ENABLE_DRY_MODE call define_netcdf_dataset(ncid=ncid, & - name='humidity', & - long_name='parcel humidity', & + name='qv', & + long_name='water vapour spec. hum.', & std_name='', & - unit='1', & + unit='kg/kg', & dtype=NF90_DOUBLE, & dimids=dimids, & - varid=hum_id) + varid=qv_id) + + call define_netcdf_dataset(ncid=ncid, & + name='ql', & + long_name='liquid water spec. hum.', & + std_name='', & + unit='kg/kg', & + dtype=NF90_DOUBLE, & + dimids=dimids, & + varid=ql_id) #endif call close_definition(ncid) @@ -330,10 +339,11 @@ subroutine write_netcdf_parcels(t) call write_netcdf_dataset(ncid, y_vor_id, parcels%vorticity(2, 1:n_parcels), start, cnt) call write_netcdf_dataset(ncid, z_vor_id, parcels%vorticity(3, 1:n_parcels), start, cnt) - call write_netcdf_dataset(ncid, buo_id, parcels%buoyancy(1:n_parcels), start, cnt) + call write_netcdf_dataset(ncid, theta_id, parcels%theta(1:n_parcels), start, cnt) #ifndef ENABLE_DRY_MODE - call write_netcdf_dataset(ncid, hum_id, parcels%humidity(1:n_parcels), start, cnt) + call write_netcdf_dataset(ncid, qv_id, parcels%qv(1:n_parcels), start, cnt) + call write_netcdf_dataset(ncid, ql_id, parcels%ql(1:n_parcels), start, cnt) #endif ! increment counter n_writes = n_writes + 1 @@ -566,17 +576,22 @@ subroutine read_chunk(first, last, pfirst) parcels%vorticity(3, pfirst:plast), start, cnt) endif - if (has_dataset(ncid, 'buoyancy')) then + if (has_dataset(ncid, 'theta')) then l_valid = .true. - call read_netcdf_dataset(ncid, 'buoyancy', & - parcels%buoyancy(pfirst:plast), start, cnt) + call read_netcdf_dataset(ncid, 'theta', & + parcels%theta(pfirst:plast), start, cnt) endif #ifndef ENABLE_DRY_MODE - if (has_dataset(ncid, 'humidity')) then + if (has_dataset(ncid, 'qv')) then + l_valid = .true. + call read_netcdf_dataset(ncid, 'qv', & + parcels%qv(pfirst:plast), start, cnt) + endif + if (has_dataset(ncid, 'ql')) then l_valid = .true. - call read_netcdf_dataset(ncid, 'humidity', & - parcels%humidity(pfirst:plast), start, cnt) + call read_netcdf_dataset(ncid, 'ql', & + parcels%ql(pfirst:plast), start, cnt) endif #endif From 1d788d115bc50e7e22aa21c958fa20e75a32d0e3 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Thu, 11 May 2023 07:45:18 +0100 Subject: [PATCH 02/34] Ongoing work on thermodynamics --- mpi-tests/parcel_merge_serial.f90 | 25 ++++--- src/3d/fields/field_diagnostics.f90 | 2 + src/3d/fields/field_diagnostics_netcdf.f90 | 1 + src/3d/fields/field_netcdf.f90 | 4 ++ src/3d/parcels/parcel_container.f90 | 2 +- src/3d/parcels/parcel_netcdf.f90 | 4 +- src/3d/parcels/parcel_split.f90 | 9 +-- unit-tests/3d/test_ellipsoid_split.f90 | 15 ++-- unit-tests/3d/test_mpi_nearest_1.f90 | 6 +- unit-tests/3d/test_mpi_nearest_10.f90 | 6 +- unit-tests/3d/test_mpi_nearest_11.f90 | 6 +- unit-tests/3d/test_mpi_nearest_12.f90 | 48 ++++++------- unit-tests/3d/test_mpi_nearest_13.f90 | 72 +++++++++---------- unit-tests/3d/test_mpi_nearest_14.f90 | 48 ++++++------- unit-tests/3d/test_mpi_nearest_15.f90 | 56 +++++++-------- unit-tests/3d/test_mpi_nearest_16.f90 | 56 +++++++-------- unit-tests/3d/test_mpi_nearest_17.f90 | 56 +++++++-------- unit-tests/3d/test_mpi_nearest_18.f90 | 48 ++++++------- unit-tests/3d/test_mpi_nearest_19.f90 | 56 +++++++-------- unit-tests/3d/test_mpi_nearest_2.f90 | 6 +- unit-tests/3d/test_mpi_nearest_20.f90 | 24 +++---- unit-tests/3d/test_mpi_nearest_3.f90 | 6 +- unit-tests/3d/test_mpi_nearest_4.f90 | 6 +- unit-tests/3d/test_mpi_nearest_5.f90 | 6 +- unit-tests/3d/test_mpi_nearest_6.f90 | 6 +- unit-tests/3d/test_mpi_nearest_7.f90 | 6 +- unit-tests/3d/test_mpi_nearest_8.f90 | 6 +- unit-tests/3d/test_mpi_nearest_9.f90 | 6 +- unit-tests/3d/test_mpi_parcel_communicate.f90 | 2 +- unit-tests/3d/test_mpi_parcel_delete.f90 | 10 +-- unit-tests/3d/test_mpi_parcel_diagnostics.f90 | 2 +- unit-tests/3d/test_mpi_parcel_pack.f90 | 7 +- unit-tests/3d/test_mpi_parcel_read.f90 | 15 ++-- .../3d/test_mpi_parcel_read_rejection.f90 | 49 ++++++++----- unit-tests/3d/test_mpi_parcel_split.f90 | 2 +- unit-tests/3d/test_mpi_parcel_unpack.f90 | 15 ++-- unit-tests/3d/test_mpi_parcel_write.f90 | 5 +- 37 files changed, 369 insertions(+), 330 deletions(-) diff --git a/mpi-tests/parcel_merge_serial.f90 b/mpi-tests/parcel_merge_serial.f90 index 8f500b9e1..ad1302cea 100644 --- a/mpi-tests/parcel_merge_serial.f90 +++ b/mpi-tests/parcel_merge_serial.f90 @@ -87,9 +87,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) double precision :: x0(n_merge), y0(n_merge) double precision :: posm(3, n_merge) double precision :: delx, vmerge, dely, delz, B33, mu - double precision :: buoym(n_merge), vortm(3, n_merge) + double precision :: thetam(n_merge), vortm(3, n_merge) #ifndef ENABLE_DRY_MODE - double precision :: hum(n_merge) + double precision :: qvm(n_merge) + double precision :: qlm(n_merge) #endif double precision, intent(out) :: Bm(6, n_merge) ! B11, B12, B13, B22, B23, B33 double precision, intent(out) :: vm(n_merge) @@ -124,9 +125,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) posm(3, l) = parcels%volume(ic) * parcels%position(3, ic) ! buoyancy and humidity - buoym(l) = parcels%volume(ic) * parcels%buoyancy(ic) + thetam(l) = parcels%volume(ic) * parcels%theta(ic) #ifndef ENABLE_DRY_MODE - hum(l) = parcels%volume(ic) * parcels%humidity(ic) + qvm(l) = parcels%volume(ic) * parcels%qv(ic) + qlm(l) = parcels%volume(ic) * parcels%ql(ic) #endif vortm(:, l) = parcels%volume(ic) * parcels%vorticity(:, ic) @@ -151,9 +153,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) posm(3, n) = posm(3, n) + parcels%volume(is) * parcels%position(3, is) ! Accumulate buoyancy and humidity - buoym(n) = buoym(n) + parcels%volume(is) * parcels%buoyancy(is) + thetam(n) = thetam(n) + parcels%volume(is) * parcels%theta(is) #ifndef ENABLE_DRY_MODE - hum(n) = hum(n) + parcels%volume(is) * parcels%humidity(is) + qvm(n) = qvm(n) + parcels%volume(is) * parcels%qv(is) + qlm(n) = qlm(n) + parcels%volume(is) * parcels%ql(is) #endif vortm(:, n) = vortm(:, n) + parcels%volume(is) * parcels%vorticity(:, is) enddo @@ -180,9 +183,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) call apply_periodic_bc(posm(:, m)) ! buoyancy and humidity - buoym(m) = vmerge * buoym(m) + thetam(m) = vmerge * thetam(m) #ifndef ENABLE_DRY_MODE - hum(m) = vmerge * hum(m) + qvm(m) = vmerge * qvm(m) + qlm(m) = vmerge * qlm(m) #endif vortm(:, m) = vmerge * vortm(:, m) enddo @@ -220,9 +224,10 @@ subroutine do_group_merge(parcels, isma, iclo, n_merge, Bm, vm) parcels%position(2, ic) = posm(2, l) parcels%position(3, ic) = posm(3, l) - parcels%buoyancy(ic) = buoym(l) + parcels%theta(ic) = thetam(l) #ifndef ENABLE_DRY_MODE - parcels%humidity(ic) = hum(l) + parcels%qv(ic) = qvm(l) + parcels%ql(ic) = qlm(l) #endif parcels%vorticity(:, ic) = vortm(:, l) diff --git a/src/3d/fields/field_diagnostics.f90 b/src/3d/fields/field_diagnostics.f90 index b932063dc..352a9efc1 100644 --- a/src/3d/fields/field_diagnostics.f90 +++ b/src/3d/fields/field_diagnostics.f90 @@ -11,6 +11,7 @@ module field_diagnostics use mpi_collectives, only : mpi_blocking_reduce use physics, only : ape_calculation use ape_density, only : ape_den + use parcel_interpl, only: par2grid_diag implicit none integer :: field_stats_timer @@ -47,6 +48,7 @@ subroutine calculate_field_diagnostics ! ! calculate locally ! + call par2grid_diag ! do not take halo cells into account field_stats(IDX_RMS_V) = sum((volg(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)) - vcell) ** 2) diff --git a/src/3d/fields/field_diagnostics_netcdf.f90 b/src/3d/fields/field_diagnostics_netcdf.f90 index 6ef467526..8318f1767 100644 --- a/src/3d/fields/field_diagnostics_netcdf.f90 +++ b/src/3d/fields/field_diagnostics_netcdf.f90 @@ -14,6 +14,7 @@ module field_diagnostics_netcdf use mpi_timer, only : start_timer, stop_timer use options, only : write_netcdf_options use physics, only : write_physical_quantities, ape_calculation + implicit none private diff --git a/src/3d/fields/field_netcdf.f90 b/src/3d/fields/field_netcdf.f90 index 290c09610..97e195de2 100644 --- a/src/3d/fields/field_netcdf.f90 +++ b/src/3d/fields/field_netcdf.f90 @@ -11,6 +11,8 @@ module field_netcdf use mpi_layout, only : box use parameters, only : write_zeta_boundary_flag use mpi_utils, only : mpi_stop + use parcel_interpl, only: par2grid_diag + implicit none integer :: field_io_timer @@ -338,6 +340,8 @@ subroutine write_netcdf_fields(t) return endif + call par2grid_diag + call open_netcdf_file(ncfname, NF90_WRITE, ncid) lo = box%lo diff --git a/src/3d/parcels/parcel_container.f90 b/src/3d/parcels/parcel_container.f90 index 3ed3e2894..5b30732f4 100644 --- a/src/3d/parcels/parcel_container.f90 +++ b/src/3d/parcels/parcel_container.f90 @@ -317,7 +317,7 @@ subroutine parcel_serialize(n, buffer) buffer(IDX_X_VOR:IDX_Z_VOR) = parcels%vorticity(:, n) buffer(IDX_B11:IDX_B23) = parcels%B(:, n) buffer(IDX_VOL) = parcels%volume(n) - buffer(IDX_THETA) = parcels%theta(n) + buffer(IDX_THETA) = parcels%theta(n) #ifndef ENABLE_DRY_MODE buffer(IDX_QV) = parcels%qv(n) buffer(IDX_QL) = parcels%ql(n) diff --git a/src/3d/parcels/parcel_netcdf.f90 b/src/3d/parcels/parcel_netcdf.f90 index e7e830766..9efa41417 100644 --- a/src/3d/parcels/parcel_netcdf.f90 +++ b/src/3d/parcels/parcel_netcdf.f90 @@ -249,7 +249,7 @@ subroutine create_netcdf_parcel_file(basename, overwrite, l_restart) #ifndef ENABLE_DRY_MODE call define_netcdf_dataset(ncid=ncid, & name='qv', & - long_name='water vapour spec. hum.', & + long_name='parcel water vapour spec. hum.',& std_name='', & unit='kg/kg', & dtype=NF90_DOUBLE, & @@ -258,7 +258,7 @@ subroutine create_netcdf_parcel_file(basename, overwrite, l_restart) call define_netcdf_dataset(ncid=ncid, & name='ql', & - long_name='liquid water spec. hum.', & + long_name='parcel liquid water spec. hum.',& std_name='', & unit='kg/kg', & dtype=NF90_DOUBLE, & diff --git a/src/3d/parcels/parcel_split.f90 b/src/3d/parcels/parcel_split.f90 index 365a2d334..ee727230b 100644 --- a/src/3d/parcels/parcel_split.f90 +++ b/src/3d/parcels/parcel_split.f90 @@ -88,9 +88,10 @@ subroutine parcel_split(parcels, threshold) parcels%vorticity(:, n_thread_loc) = parcels%vorticity(:, n) parcels%volume(n_thread_loc) = parcels%volume(n) - parcels%buoyancy(n_thread_loc) = parcels%buoyancy(n) + parcels%theta(n_thread_loc) = parcels%theta(n) #ifndef ENABLE_DRY_MODE - parcels%humidity(n_thread_loc) = parcels%humidity(n) + parcels%qv(n_thread_loc) = parcels%qv(n) + parcels%ql(n_thread_loc) = parcels%ql(n) #endif V(:, 1) = V(:, 1) * dh * dsqrt(D(1)) parcels%position(:, n_thread_loc) = parcels%position(:, n) - V(:, 1) @@ -104,11 +105,11 @@ subroutine parcel_split(parcels, threshold) call apply_reflective_bc(parcels%position(:, n), parcels%B(:, n)) ! save parcel indices of child parcels for the - ! halo swap routine +!~ ! halo swap routine pid(n) = n pid(n_thread_loc) = n_thread_loc enddo - !$omp end do + !$omp end dosrc/2d/parcels/parcel_diagnostics.f90: !$omp end parallel n_parcel_splits = n_parcel_splits + n_parcels - last_index diff --git a/unit-tests/3d/test_ellipsoid_split.f90 b/unit-tests/3d/test_ellipsoid_split.f90 index 4aaeedfdb..401015241 100644 --- a/unit-tests/3d/test_ellipsoid_split.f90 +++ b/unit-tests/3d/test_ellipsoid_split.f90 @@ -72,9 +72,10 @@ subroutine setup_parcels parcels%position(:, 1) = zero parcels%volume(1) = four / three * abc * pi - parcels%buoyancy(1) = one + parcels%theta(1) = one #ifndef ENABLE_DRY_MODE - parcels%humidity(1) = one + parcels%qv(1) = one + parcels%ql(1) = one #endif ! 7 Nov 2021 ! https://mathworld.wolfram.com/SphericalCoordinates.html @@ -129,9 +130,10 @@ subroutine check_result error = max(error, abs(get_B33(parcels%B(:, 1), parcels%volume(1)) - B33)) error = max(error, sum(abs(pos(:, 1) - parcels%position(:, 1)))) error = max(error, abs(f12 * four / three * abc * pi - parcels%volume(1))) - error = max(error, abs(parcels%buoyancy(1) - one)) + error = max(error, abs(parcels%theta(1) - one)) #ifndef ENABLE_DRY_MODE - error = max(error, abs(parcels%humidity(1) - one)) + error = max(error, abs(parcels%qv(1) - one)) + error = max(error, abs(parcels%ql(1) - one)) #endif ! second parcel @@ -144,9 +146,10 @@ subroutine check_result error = max(error, sum(abs(pos(:, 2) - parcels%position(:, 2)))) error = max(error, abs(f12 * four / three * abc * pi - parcels%volume(2))) error = max(error, dble(abs(n_parcels - 2))) - error = max(error, abs(parcels%buoyancy(2) - one)) + error = max(error, abs(parcels%theta(2) - one)) #ifndef ENABLE_DRY_MODE - error = max(error, abs(parcels%humidity(2) - one)) + error = max(error, abs(parcels%qv(2) - one)) + error = max(error, abs(parcels%ql(2) - one)) #endif end subroutine check_result diff --git a/unit-tests/3d/test_mpi_nearest_1.f90 b/unit-tests/3d/test_mpi_nearest_1.f90 index c48e0c927..9ea00b38a 100644 --- a/unit-tests/3d/test_mpi_nearest_1.f90 +++ b/unit-tests/3d/test_mpi_nearest_1.f90 @@ -108,7 +108,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -117,7 +117,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 enddo @@ -126,7 +126,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dble(m) * dx(2) * 0.45 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 enddo diff --git a/unit-tests/3d/test_mpi_nearest_10.f90 b/unit-tests/3d/test_mpi_nearest_10.f90 index 22e33b8ef..35e086f6a 100644 --- a/unit-tests/3d/test_mpi_nearest_10.f90 +++ b/unit-tests/3d/test_mpi_nearest_10.f90 @@ -109,7 +109,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -117,7 +117,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -125,7 +125,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.33d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement diff --git a/unit-tests/3d/test_mpi_nearest_11.f90 b/unit-tests/3d/test_mpi_nearest_11.f90 index 94850e359..f2501fe8f 100644 --- a/unit-tests/3d/test_mpi_nearest_11.f90 +++ b/unit-tests/3d/test_mpi_nearest_11.f90 @@ -109,7 +109,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -117,7 +117,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -125,7 +125,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.33d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement diff --git a/unit-tests/3d/test_mpi_nearest_12.f90 b/unit-tests/3d/test_mpi_nearest_12.f90 index a31ef9b36..7e034fd70 100644 --- a/unit-tests/3d/test_mpi_nearest_12.f90 +++ b/unit-tests/3d/test_mpi_nearest_12.f90 @@ -152,7 +152,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -160,7 +160,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -168,7 +168,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.28d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_1 @@ -193,7 +193,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -201,7 +201,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -209,7 +209,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_2 @@ -234,7 +234,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -242,7 +242,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -250,7 +250,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.28d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_3 @@ -275,7 +275,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -283,7 +283,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -291,7 +291,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_4 @@ -320,7 +320,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -328,7 +328,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -336,7 +336,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! @@ -348,7 +348,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -356,7 +356,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -364,7 +364,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.30d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_5 @@ -393,7 +393,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -401,7 +401,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -409,7 +409,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! @@ -421,7 +421,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -429,7 +429,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.32d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -437,7 +437,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.33d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_6 diff --git a/unit-tests/3d/test_mpi_nearest_13.f90 b/unit-tests/3d/test_mpi_nearest_13.f90 index 7e2332358..8015d225c 100644 --- a/unit-tests/3d/test_mpi_nearest_13.f90 +++ b/unit-tests/3d/test_mpi_nearest_13.f90 @@ -178,7 +178,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -186,7 +186,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -194,7 +194,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_1 @@ -219,7 +219,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -227,7 +227,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -235,7 +235,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.26d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_2 @@ -260,7 +260,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -268,7 +268,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -276,7 +276,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_3 @@ -301,7 +301,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -309,7 +309,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.42d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -317,7 +317,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.28d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_4 @@ -346,7 +346,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -354,7 +354,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -362,7 +362,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! @@ -374,7 +374,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -382,7 +382,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -390,7 +390,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_5 @@ -419,7 +419,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -427,7 +427,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -435,7 +435,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! @@ -447,7 +447,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -455,7 +455,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -463,7 +463,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_6 @@ -492,7 +492,7 @@ subroutine cell_placement_7(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -500,7 +500,7 @@ subroutine cell_placement_7(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -508,7 +508,7 @@ subroutine cell_placement_7(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! @@ -520,7 +520,7 @@ subroutine cell_placement_7(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -528,7 +528,7 @@ subroutine cell_placement_7(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.28d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -536,7 +536,7 @@ subroutine cell_placement_7(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_7 @@ -565,7 +565,7 @@ subroutine cell_placement_8(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -573,7 +573,7 @@ subroutine cell_placement_8(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -581,7 +581,7 @@ subroutine cell_placement_8(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! @@ -593,7 +593,7 @@ subroutine cell_placement_8(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -601,7 +601,7 @@ subroutine cell_placement_8(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.28d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -609,7 +609,7 @@ subroutine cell_placement_8(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_8 diff --git a/unit-tests/3d/test_mpi_nearest_14.f90 b/unit-tests/3d/test_mpi_nearest_14.f90 index 6bcf177f7..1752f11dd 100644 --- a/unit-tests/3d/test_mpi_nearest_14.f90 +++ b/unit-tests/3d/test_mpi_nearest_14.f90 @@ -152,7 +152,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -160,7 +160,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -168,7 +168,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_1 @@ -193,7 +193,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -201,7 +201,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -209,7 +209,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_2 @@ -234,7 +234,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -242,7 +242,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -250,7 +250,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_3 @@ -275,7 +275,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -283,7 +283,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -291,7 +291,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.34d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_4 @@ -320,7 +320,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -328,7 +328,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -336,7 +336,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! @@ -348,7 +348,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.28d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -356,7 +356,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -364,7 +364,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_5 @@ -393,7 +393,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -401,7 +401,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -409,7 +409,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! @@ -421,7 +421,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.28d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -429,7 +429,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -437,7 +437,7 @@ subroutine cell_placement_6(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_6 diff --git a/unit-tests/3d/test_mpi_nearest_15.f90 b/unit-tests/3d/test_mpi_nearest_15.f90 index d0add1759..2afec529c 100644 --- a/unit-tests/3d/test_mpi_nearest_15.f90 +++ b/unit-tests/3d/test_mpi_nearest_15.f90 @@ -139,7 +139,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -147,7 +147,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -155,7 +155,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -163,7 +163,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_1 @@ -188,7 +188,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -196,7 +196,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -204,7 +204,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -212,7 +212,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_2 @@ -237,7 +237,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -245,7 +245,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -253,7 +253,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -261,7 +261,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_3 @@ -290,7 +290,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -298,7 +298,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -306,7 +306,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -314,7 +314,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -327,7 +327,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -335,7 +335,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.45d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -343,7 +343,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.35d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -351,7 +351,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.2d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_4 @@ -376,7 +376,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -384,7 +384,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -392,7 +392,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -400,7 +400,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -413,7 +413,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.2d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -421,7 +421,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -429,7 +429,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.45d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -437,7 +437,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.2d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_5 diff --git a/unit-tests/3d/test_mpi_nearest_16.f90 b/unit-tests/3d/test_mpi_nearest_16.f90 index 7b4d5b94a..a2d803e15 100644 --- a/unit-tests/3d/test_mpi_nearest_16.f90 +++ b/unit-tests/3d/test_mpi_nearest_16.f90 @@ -139,7 +139,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -147,7 +147,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -155,7 +155,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -163,7 +163,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_1 @@ -188,7 +188,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -196,7 +196,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -204,7 +204,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -212,7 +212,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_2 @@ -236,7 +236,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -244,7 +244,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -252,7 +252,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -260,7 +260,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_3 @@ -289,7 +289,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -297,7 +297,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -305,7 +305,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -313,7 +313,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -326,7 +326,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.3d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -334,7 +334,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.45d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -342,7 +342,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.3d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -350,7 +350,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.2d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_4 @@ -379,7 +379,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -387,7 +387,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -395,7 +395,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -403,7 +403,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -416,7 +416,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.2d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -424,7 +424,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -432,7 +432,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.45d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -440,7 +440,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.35d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_5 diff --git a/unit-tests/3d/test_mpi_nearest_17.f90 b/unit-tests/3d/test_mpi_nearest_17.f90 index dd6ccb501..f9e3c8df5 100644 --- a/unit-tests/3d/test_mpi_nearest_17.f90 +++ b/unit-tests/3d/test_mpi_nearest_17.f90 @@ -139,7 +139,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -147,7 +147,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -155,7 +155,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -163,7 +163,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_1 @@ -188,7 +188,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -196,7 +196,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -204,7 +204,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -212,7 +212,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_2 @@ -236,7 +236,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.35d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -244,7 +244,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -252,7 +252,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -260,7 +260,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.35d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_3 @@ -289,7 +289,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -297,7 +297,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -305,7 +305,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -313,7 +313,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -326,7 +326,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -334,7 +334,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -342,7 +342,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.3d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -350,7 +350,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.15d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -380,7 +380,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -388,7 +388,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -396,7 +396,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -404,7 +404,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -417,7 +417,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.25d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel B @@ -425,7 +425,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -433,7 +433,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.45d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -441,7 +441,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.25d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_5 diff --git a/unit-tests/3d/test_mpi_nearest_18.f90 b/unit-tests/3d/test_mpi_nearest_18.f90 index 678468c3f..749be5eff 100644 --- a/unit-tests/3d/test_mpi_nearest_18.f90 +++ b/unit-tests/3d/test_mpi_nearest_18.f90 @@ -126,7 +126,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.38d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -134,7 +134,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.38d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -142,7 +142,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.38d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -150,7 +150,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.38d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_1 @@ -175,7 +175,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.3d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -183,7 +183,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.38d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -191,7 +191,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.3d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -199,7 +199,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.38d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_2 @@ -228,7 +228,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -236,7 +236,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -244,7 +244,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -252,7 +252,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -265,7 +265,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.45d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -273,7 +273,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.45d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -281,7 +281,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.3d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -289,7 +289,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.2d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_3 @@ -318,7 +318,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -326,7 +326,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -334,7 +334,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -342,7 +342,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -355,7 +355,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.45d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -363,7 +363,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.45d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -371,7 +371,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.3d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -379,7 +379,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.2d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_4 diff --git a/unit-tests/3d/test_mpi_nearest_19.f90 b/unit-tests/3d/test_mpi_nearest_19.f90 index 60c74f733..6b1bc009e 100644 --- a/unit-tests/3d/test_mpi_nearest_19.f90 +++ b/unit-tests/3d/test_mpi_nearest_19.f90 @@ -139,7 +139,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.23d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -147,7 +147,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -155,7 +155,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel D @@ -163,7 +163,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_1 @@ -188,7 +188,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.23d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -196,7 +196,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -204,7 +204,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel D @@ -212,7 +212,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.33d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_2 @@ -237,7 +237,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -245,7 +245,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -253,7 +253,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.43d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel D @@ -261,7 +261,7 @@ subroutine cell_placement_3(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_3 @@ -290,7 +290,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -298,7 +298,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -306,7 +306,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel D @@ -314,7 +314,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -327,7 +327,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -335,7 +335,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -343,7 +343,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.25d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel D @@ -351,7 +351,7 @@ subroutine cell_placement_4(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.13d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_4 @@ -380,7 +380,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -388,7 +388,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -396,7 +396,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel D @@ -404,7 +404,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -417,7 +417,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.2d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -425,7 +425,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.35d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -433,7 +433,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.46d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel D @@ -441,7 +441,7 @@ subroutine cell_placement_5(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.46d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_5 diff --git a/unit-tests/3d/test_mpi_nearest_2.f90 b/unit-tests/3d/test_mpi_nearest_2.f90 index 1f33b85b9..72815e153 100644 --- a/unit-tests/3d/test_mpi_nearest_2.f90 +++ b/unit-tests/3d/test_mpi_nearest_2.f90 @@ -108,7 +108,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 @@ -117,7 +117,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 enddo @@ -126,7 +126,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 enddo diff --git a/unit-tests/3d/test_mpi_nearest_20.f90 b/unit-tests/3d/test_mpi_nearest_20.f90 index eae7d50d7..91e8c10d2 100644 --- a/unit-tests/3d/test_mpi_nearest_20.f90 +++ b/unit-tests/3d/test_mpi_nearest_20.f90 @@ -106,8 +106,8 @@ program test_mpi_nearest_20 ! do n = 1, n_merge ! is = isma(n) ! ic = iclo(n) -! print *, comm%rank, parcels%position(1, is), parcels%position(2, is), int(parcels%buoyancy(is)), & -! parcels%position(1, ic), parcels%position(2, ic), int(parcels%buoyancy(ic)) +! print *, comm%rank, parcels%position(1, is), parcels%position(2, is), int(parcels%theta(is)), & +! parcels%position(1, ic), parcels%position(2, ic), int(parcels%theta(ic)) ! enddo ! endif ! call MPI_Barrier(comm%world, comm%err) @@ -159,7 +159,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.35d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -167,7 +167,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel c @@ -175,7 +175,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -183,7 +183,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel e @@ -191,7 +191,7 @@ subroutine cell_placement_1(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.38d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_1 @@ -216,7 +216,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.35d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -224,7 +224,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel C @@ -232,7 +232,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel d @@ -240,7 +240,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel e @@ -248,7 +248,7 @@ subroutine cell_placement_2(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.38d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement_2 diff --git a/unit-tests/3d/test_mpi_nearest_3.f90 b/unit-tests/3d/test_mpi_nearest_3.f90 index 558372fa5..d653b8d8c 100644 --- a/unit-tests/3d/test_mpi_nearest_3.f90 +++ b/unit-tests/3d/test_mpi_nearest_3.f90 @@ -110,7 +110,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel @@ -118,7 +118,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel @@ -126,7 +126,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement diff --git a/unit-tests/3d/test_mpi_nearest_4.f90 b/unit-tests/3d/test_mpi_nearest_4.f90 index 24e0a762e..12411a694 100644 --- a/unit-tests/3d/test_mpi_nearest_4.f90 +++ b/unit-tests/3d/test_mpi_nearest_4.f90 @@ -110,7 +110,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + 0.1d0 * dx(2) parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel @@ -118,7 +118,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.35d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! big parcel @@ -126,7 +126,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y - 0.42d0 * dx(2) parcels%position(3, l) = z parcels%volume(l) = 1.1d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement diff --git a/unit-tests/3d/test_mpi_nearest_5.f90 b/unit-tests/3d/test_mpi_nearest_5.f90 index 19756d931..91c7147d6 100644 --- a/unit-tests/3d/test_mpi_nearest_5.f90 +++ b/unit-tests/3d/test_mpi_nearest_5.f90 @@ -109,7 +109,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -117,7 +117,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -125,7 +125,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement diff --git a/unit-tests/3d/test_mpi_nearest_6.f90 b/unit-tests/3d/test_mpi_nearest_6.f90 index 16412b8cb..137374665 100644 --- a/unit-tests/3d/test_mpi_nearest_6.f90 +++ b/unit-tests/3d/test_mpi_nearest_6.f90 @@ -109,7 +109,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -117,7 +117,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -125,7 +125,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement diff --git a/unit-tests/3d/test_mpi_nearest_7.f90 b/unit-tests/3d/test_mpi_nearest_7.f90 index a0cfc0ff3..8107e1241 100644 --- a/unit-tests/3d/test_mpi_nearest_7.f90 +++ b/unit-tests/3d/test_mpi_nearest_7.f90 @@ -109,7 +109,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -117,7 +117,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y - dx(1) * 0.4d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -125,7 +125,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y - dx(1) * 0.3d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement diff --git a/unit-tests/3d/test_mpi_nearest_8.f90 b/unit-tests/3d/test_mpi_nearest_8.f90 index d679b8ead..f6c4dc358 100644 --- a/unit-tests/3d/test_mpi_nearest_8.f90 +++ b/unit-tests/3d/test_mpi_nearest_8.f90 @@ -109,7 +109,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.24d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -117,7 +117,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.42d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -125,7 +125,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.46d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement diff --git a/unit-tests/3d/test_mpi_nearest_9.f90 b/unit-tests/3d/test_mpi_nearest_9.f90 index 7e35b7719..d97c36335 100644 --- a/unit-tests/3d/test_mpi_nearest_9.f90 +++ b/unit-tests/3d/test_mpi_nearest_9.f90 @@ -109,7 +109,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel b @@ -117,7 +117,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y - dx(2) * 0.44d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 ! small parcel a @@ -125,7 +125,7 @@ subroutine cell_placement(l, i, j, k) parcels%position(2, l) = y + dx(2) * 0.28d0 parcels%position(3, l) = z parcels%volume(l) = 0.9d0 * vmin - parcels%buoyancy(l) = l + comm%rank * 100 + parcels%theta(l) = l + comm%rank * 100 l = l + 1 end subroutine cell_placement diff --git a/unit-tests/3d/test_mpi_parcel_communicate.f90 b/unit-tests/3d/test_mpi_parcel_communicate.f90 index abceefa22..c724110a1 100644 --- a/unit-tests/3d/test_mpi_parcel_communicate.f90 +++ b/unit-tests/3d/test_mpi_parcel_communicate.f90 @@ -96,7 +96,7 @@ program test_mpi_parcel_communicate parcels%volume(1:n_parcels) = comm%rank + 1 parcels%B(:, 1:n_parcels) = comm%rank + 1 parcels%vorticity(:, 1:n_parcels) = comm%rank + 1 - parcels%buoyancy(1:n_parcels) = comm%rank + 1 + parcels%theta(1:n_parcels) = comm%rank + 1 call parcel_communicate diff --git a/unit-tests/3d/test_mpi_parcel_delete.f90 b/unit-tests/3d/test_mpi_parcel_delete.f90 index 82dfb3c5f..a58d9f3e7 100644 --- a/unit-tests/3d/test_mpi_parcel_delete.f90 +++ b/unit-tests/3d/test_mpi_parcel_delete.f90 @@ -50,9 +50,10 @@ program test_mpi_parcel_delete parcels%B(4, n) = 10.0d0 + a parcels%B(5, n) = 11.0d0 + a parcels%volume(n) = 12.0d0 + a - parcels%buoyancy(n) = 13.0d0 + a + parcels%theta(n) = 13.0d0 + a #ifndef ENABLE_DRY_MODE - parcels%humidity(n) = 14.0d0 + a + parcels%qv(n) = 14.0d0 + a + parcels%ql(n) = 15.0d0 + a #endif enddo @@ -107,9 +108,10 @@ program test_mpi_parcel_delete passed = (passed .and. (parcels%B(4, ii(n)) - (10.0d0 + a) == zero)) passed = (passed .and. (parcels%B(5, ii(n)) - (11.0d0 + a) == zero)) passed = (passed .and. (parcels%volume(ii(n)) - (12.0d0 + a) == zero)) - passed = (passed .and. (parcels%buoyancy(ii(n)) - (13.0d0 + a) == zero)) + passed = (passed .and. (parcels%theta(ii(n)) - (13.0d0 + a) == zero)) #ifndef ENABLE_DRY_MODE - passed = (passed .and. (parcels%humidity(ii(n)) - (14.0d0 + a) == zero)) + passed = (passed .and. (parcels%qv(ii(n)) - (14.0d0 + a) == zero)) + passed = (passed .and. (parcels%ql(ii(n)) - (15.0d0 + a) == zero)) #endif i = i + 1 endif diff --git a/unit-tests/3d/test_mpi_parcel_diagnostics.f90 b/unit-tests/3d/test_mpi_parcel_diagnostics.f90 index b4c5525d9..adf4e241b 100644 --- a/unit-tests/3d/test_mpi_parcel_diagnostics.f90 +++ b/unit-tests/3d/test_mpi_parcel_diagnostics.f90 @@ -53,7 +53,7 @@ program test_mpi_parcel_diagnostics parcels%position(1, l) = corner(1) + dx(1) * (dble(i) - f12) * im parcels%position(2, l) = corner(2) + dx(2) * (dble(j) - f12) * im parcels%position(3, l) = corner(3) + dx(3) * (dble(k) - f12) * im - parcels%buoyancy(l) = parcels%position(3, l) + parcels%theta(l) = parcels%position(3, l) l = l + 1 enddo enddo diff --git a/unit-tests/3d/test_mpi_parcel_pack.f90 b/unit-tests/3d/test_mpi_parcel_pack.f90 index ad8d3c3b9..58c94adc8 100644 --- a/unit-tests/3d/test_mpi_parcel_pack.f90 +++ b/unit-tests/3d/test_mpi_parcel_pack.f90 @@ -48,7 +48,7 @@ program test_mpi_parcel_pack parcels%B(4, n) = 10.0d0 + a parcels%B(5, n) = 11.0d0 + a parcels%volume(n) = 12.0d0 + a - parcels%buoyancy(n) = 13.0d0 + a + parcels%theta(n) = 13.0d0 + a #ifndef ENABLE_DRY_MODE parcels%humidity(n) = 14.0d0 + a #endif @@ -93,9 +93,10 @@ program test_mpi_parcel_pack passed = (passed .and. (parcels%B(4, l) - buffer(i + IDX_B22) == zero)) passed = (passed .and. (parcels%B(5, l) - buffer(i + IDX_B23) == zero)) passed = (passed .and. (parcels%volume(l) - buffer(i + IDX_VOL) == zero)) - passed = (passed .and. (parcels%buoyancy(l) - buffer(i + IDX_BUO) == zero)) + passed = (passed .and. (parcels%theta(l) - buffer(i + IDX_THETA) == zero)) #ifndef ENABLE_DRY_MODE - passed = (passed .and. (parcels%humidity(l) - buffer(i + IDX_HUM) == zero)) + passed = (passed .and. (parcels%qv(l) - buffer(i + IDX_QV) == zero)) + passed = (passed .and. (parcels%ql(l) - buffer(i + IDX_QL) == zero)) #endif enddo diff --git a/unit-tests/3d/test_mpi_parcel_read.f90 b/unit-tests/3d/test_mpi_parcel_read.f90 index 904e2314b..8f8c93dee 100644 --- a/unit-tests/3d/test_mpi_parcel_read.f90 +++ b/unit-tests/3d/test_mpi_parcel_read.f90 @@ -46,10 +46,11 @@ program test_mpi_parcel_read parcels%B(:, n) = start_index + n parcels%volume(n) = start_index + n parcels%vorticity(:, n) = start_index + n - parcels%buoyancy(n) = start_index + n + parcels%theta(n) = start_index + n #ifndef ENABLE_DRY_MODE - parcels%humidity(n) = start_index + n + parcels%qv(n) = start_index + n + parcels%ql(n) = start_index + n #endif enddo @@ -69,9 +70,10 @@ program test_mpi_parcel_read parcels%B = 0 parcels%volume = 0 parcels%vorticity = 0 - parcels%buoyancy = 0 + parcels%theta = 0 #ifndef ENABLE_DRY_MODE - parcels%humidity = 0 + parcels%qv = 0 + parcels%ql = 0 #endif call read_netcdf_parcels('nctest_0000000001_parcels.nc') @@ -93,9 +95,10 @@ program test_mpi_parcel_read passed = (passed .and. (abs(parcels%vorticity(1, n) - res) == zero)) passed = (passed .and. (abs(parcels%vorticity(2, n) - res) == zero)) passed = (passed .and. (abs(parcels%vorticity(3, n) - res) == zero)) - passed = (passed .and. (abs(parcels%buoyancy(n) - res) == zero)) + passed = (passed .and. (abs(parcels%theta(n) - res) == zero)) #ifndef ENABLE_DRY_MODE - passed = (passed .and. (abs(parcels%humidity(n) - res) == zero)) + passed = (passed .and. (abs(parcels%qv(n) - res) == zero)) + passed = (passed .and. (abs(parcels%ql(n) - res) == zero)) #endif enddo endif diff --git a/unit-tests/3d/test_mpi_parcel_read_rejection.f90 b/unit-tests/3d/test_mpi_parcel_read_rejection.f90 index cc5449302..74965a626 100644 --- a/unit-tests/3d/test_mpi_parcel_read_rejection.f90 +++ b/unit-tests/3d/test_mpi_parcel_read_rejection.f90 @@ -25,14 +25,14 @@ program test_mpi_parcel_read_rejection double precision :: x_sum, y_sum, z_sum integer :: ncid - integer :: npar_dim_id, vol_id, buo_id, & + integer :: npar_dim_id, vol_id, theta_id, & x_pos_id, y_pos_id, z_pos_id, & x_vor_id, y_vor_id, z_vor_id, & b11_id, b12_id, b13_id, & b22_id, b23_id, & t_axis_id, t_dim_id, mpi_dim_id #ifndef ENABLE_DRY_MODE - integer :: hum_id + integer :: qv_id, ql_id #endif character(len=512) :: ncbasename @@ -97,10 +97,11 @@ program test_mpi_parcel_read_rejection parcels%B(:, 1:n_parcels) = comm%rank + 1 parcels%volume(1:n_parcels) = comm%rank + 1 parcels%vorticity(:, 1:n_parcels) = comm%rank + 1 - parcels%buoyancy(1:n_parcels) = comm%rank + 1 + parcels%theta(1:n_parcels) = comm%rank + 1 #ifndef ENABLE_DRY_MODE - parcels%humidity(1:n_parcels) = comm%rank + 1 + parcels%qv(1:n_parcels) = comm%rank + 1 + parcels%ql(1:n_parcels) = comm%rank + 1 #endif call create_file('nctest') @@ -119,9 +120,10 @@ program test_mpi_parcel_read_rejection parcels%B = 0 parcels%volume = 0 parcels%vorticity = 0 - parcels%buoyancy = 0 + parcels%theta = 0 #ifndef ENABLE_DRY_MODE - parcels%humidity = 0 + parcels%qv = 0 + parcels%ql = 0 #endif call read_netcdf_parcels('nctest_0000000001_parcels.nc') @@ -143,9 +145,10 @@ program test_mpi_parcel_read_rejection passed = (passed .and. (maxval(abs(parcels%vorticity(1, 1:n_parcels) - res)) == zero)) passed = (passed .and. (maxval(abs(parcels%vorticity(2, 1:n_parcels) - res)) == zero)) passed = (passed .and. (maxval(abs(parcels%vorticity(3, 1:n_parcels) - res)) == zero)) - passed = (passed .and. (maxval(abs(parcels%buoyancy(1:n_parcels) - res)) == zero)) + passed = (passed .and. (maxval(abs(parcels%theta(1:n_parcels) - res)) == zero)) #ifndef ENABLE_DRY_MODE - passed = (passed .and. (maxval(abs(parcels%humidity(1:n_parcels) - res)) == zero)) + passed = (passed .and. (maxval(abs(parcels%qv(1:n_parcels) - res)) == zero)) + passed = (passed .and. (maxval(abs(parcels%ql(1:n_parcels) - res)) == zero)) #endif endif @@ -315,23 +318,32 @@ subroutine create_file(basename) varid=z_vor_id) call define_netcdf_dataset(ncid=ncid, & - name='buoyancy', & - long_name='parcel buoyancy', & + name='theta', & + long_name='parcel potential temperature',& std_name='', & - unit='m/s^2', & + unit='K', & dtype=NF90_DOUBLE, & dimids=dimids, & - varid=buo_id) + varid=theta_id) #ifndef ENABLE_DRY_MODE call define_netcdf_dataset(ncid=ncid, & - name='humidity', & - long_name='parcel humidity', & + name='qv', & + long_name='parcel water vapour spec. hum.',& std_name='', & - unit='1', & + unit='kg/kg', & dtype=NF90_DOUBLE, & dimids=dimids, & - varid=hum_id) + varid=qv_id) + + call define_netcdf_dataset(ncid=ncid, & + name='ql', & + long_name='parcel liquid water spec. hum.',& + std_name='', & + unit='kg/kg', & + dtype=NF90_DOUBLE, & + dimids=dimids, & + varid=ql_id) #endif call close_definition(ncid) @@ -384,10 +396,11 @@ subroutine write_parcels(t) call write_netcdf_dataset(ncid, y_vor_id, parcels%vorticity(2, 1:n_parcels), start, cnt) call write_netcdf_dataset(ncid, z_vor_id, parcels%vorticity(3, 1:n_parcels), start, cnt) - call write_netcdf_dataset(ncid, buo_id, parcels%buoyancy(1:n_parcels), start, cnt) + call write_netcdf_dataset(ncid, theta_id, parcels%theta(1:n_parcels), start, cnt) #ifndef ENABLE_DRY_MODE - call write_netcdf_dataset(ncid, hum_id, parcels%humidity(1:n_parcels), start, cnt) + call write_netcdf_dataset(ncid, qv_id, parcels%qv(1:n_parcels), start, cnt) + call write_netcdf_dataset(ncid, ql_id, parcels%ql(1:n_parcels), start, cnt) #endif call close_netcdf_file(ncid) diff --git a/unit-tests/3d/test_mpi_parcel_split.f90 b/unit-tests/3d/test_mpi_parcel_split.f90 index b92bc525c..70c4ea0d7 100644 --- a/unit-tests/3d/test_mpi_parcel_split.f90 +++ b/unit-tests/3d/test_mpi_parcel_split.f90 @@ -106,7 +106,7 @@ program test_mpi_parcel_split parcels%volume(1:n_parcels) = f12 * vcell parcels%vorticity(:, 1:n_parcels) = comm%rank + 1 - parcels%buoyancy(1:n_parcels) = comm%rank + 1 + parcels%theta(1:n_parcels) = comm%rank + 1 call parcel_split(parcels, threshold=four) diff --git a/unit-tests/3d/test_mpi_parcel_unpack.f90 b/unit-tests/3d/test_mpi_parcel_unpack.f90 index 4bee8835e..95f8a1bd6 100644 --- a/unit-tests/3d/test_mpi_parcel_unpack.f90 +++ b/unit-tests/3d/test_mpi_parcel_unpack.f90 @@ -40,9 +40,10 @@ program test_mpi_parcel_unpack parcels%B(4, n) = 10.0d0 + a parcels%B(5, n) = 11.0d0 + a parcels%volume(n) = 12.0d0 + a - parcels%buoyancy(n) = 13.0d0 + a + parcels%theta(n) = 13.0d0 + a #ifndef ENABLE_DRY_MODE - parcels%humidity(n) = 14.0d0 + a + parcels%qv(n) = 14.0d0 + a + parcels%ql(n) = 15.0d0 + a #endif enddo @@ -65,9 +66,10 @@ program test_mpi_parcel_unpack buffer(i + IDX_B22) = 10.0d0 + a buffer(i + IDX_B23) = 11.0d0 + a buffer(i + IDX_VOL) = 12.0d0 + a - buffer(i + IDX_BUO) = 13.0d0 + a + buffer(i + IDX_THETA) = 13.0d0 + a #ifndef ENABLE_DRY_MODE - buffer(i + IDX_HUM) = 14.0d0 + a + buffer(i + IDX_QV) = 14.0d0 + a + buffer(i + IDX_QL) = 15.0d0 + a #endif enddo @@ -92,9 +94,10 @@ program test_mpi_parcel_unpack passed = (passed .and. (parcels%B(4, n) == 10.0d0 + a)) passed = (passed .and. (parcels%B(5, n) == 11.0d0 + a)) passed = (passed .and. (parcels%volume(n) == 12.0d0 + a)) - passed = (passed .and. (parcels%buoyancy(n) == 13.0d0 + a)) + passed = (passed .and. (parcels%theta(n) == 13.0d0 + a)) #ifndef ENABLE_DRY_MODE - passed = (passed .and. (parcels%humidity(n) == 14.0d0 + a)) + passed = (passed .and. (parcels%qv(n) == 14.0d0 + a)) + passed = (passed .and. (parcels%ql(n) == 15.0d0 + a)) #endif enddo diff --git a/unit-tests/3d/test_mpi_parcel_write.f90 b/unit-tests/3d/test_mpi_parcel_write.f90 index 02329683b..27236cd87 100644 --- a/unit-tests/3d/test_mpi_parcel_write.f90 +++ b/unit-tests/3d/test_mpi_parcel_write.f90 @@ -29,10 +29,11 @@ program test_mpi_parcel_write parcels%B(:, 1:n_parcels) = comm%rank parcels%volume(1:n_parcels) = comm%rank parcels%vorticity(:, 1:n_parcels) = comm%rank - parcels%buoyancy(1:n_parcels) = comm%rank + parcels%theta(1:n_parcels) = comm%rank #ifndef ENABLE_DRY_MODE - parcels%humidity(1:n_parcels) = comm%rank + parcels%qv(1:n_parcels) = comm%rank + parcels%ql(1:n_parcels) = comm%rank #endif call create_netcdf_parcel_file('nctest', .true., .false.) From 061400fe7cc847548270300404d9eaa0e108f2b3 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Thu, 11 May 2023 20:49:57 +0100 Subject: [PATCH 03/34] More ongoing work on thermodynamics --- src/3d/parcels/parcel_interpl.f90 | 271 ++++++++++++++++++++++-------- src/utils/physics.f90 | 8 +- 2 files changed, 210 insertions(+), 69 deletions(-) diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index 58bb2ca71..0272e584d 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -20,7 +20,7 @@ module parcel_interpl , interior_to_halo_communication & , halo_to_interior_communication & , field_halo_swap - use physics, only : glat, lambda_c, q_0 + use physics, only : gravity, theta_0, qv_dens_coeff, r_d, c_p, L_v use omp_lib use mpi_utils, only : mpi_exit_on_error implicit none @@ -43,22 +43,27 @@ module parcel_interpl , IDX_VOR_Y_SWAP = 3 & , IDX_VOR_Z_SWAP = 4 & , IDX_TBUOY_SWAP = 5 -#ifndef ENABLE_DRY_MODE - integer, parameter :: IDX_DBUOY_SWAP = 6 & - , IDX_HUM_SWAP = 7 - integer, parameter :: n_field_swap = 7 -#else integer, parameter :: n_field_swap = 5 + + ! restart indices for par2grid_diag + integer, parameter :: IDX_THETA_SWAP = 1 +#ifndef ENABLE_DRY_MODE + integer, parameter :: IDX_QV_SWAP = 2 & + , IDX_QL_SWAP = 3 + integer, parameter :: n_field_swap_diag = 3 +#else + integer, parameter :: n_field_swap_diag = 1 #endif public :: par2grid & + , par2grid_diag & , vol2grid & , grid2par & , par2grid_timer & , grid2par_timer & , halo_swap_timer & - , trilinear + , trilinear contains @@ -93,7 +98,7 @@ subroutine vol2grid(l_reuse) enddo !$omp end do !$omp end parallel - + call start_timer(halo_swap_timer) call field_halo_swap(volg) call stop_timer(halo_swap_timer) @@ -125,44 +130,30 @@ subroutine par2grid(l_reuse) double precision :: points(3, 4) integer :: n, p, l, i, j, k double precision :: pvol, weight(0:1,0:1,0:1), btot -#ifndef ENABLE_DRY_MODE - double precision :: q_c -#endif call start_timer(par2grid_timer) +#ifndef ENABLE_DRY_MODE + call saturation_adjustment +#endif + vortg = zero volg = zero nparg = zero nsparg = zero -#ifndef ENABLE_DRY_MODE - dbuoyg = zero - humg = zero -#endif tbuoyg = zero !$omp parallel default(shared) -#ifndef ENABLE_DRY_MODE - !$omp do private(n, p, l, i, j, k, points, pvol, weight, btot, q_c) & - !$omp& private( is, js, ks, weights) & - !$omp& reduction(+:nparg, nsparg, vortg, dbuoyg, humg, tbuoyg, volg) -#else !$omp do private(n, p, l, i, j, k, points, pvol, weight, btot) & !$omp& private( is, js, ks, weights) & !$omp& reduction(+:nparg, nsparg, vortg, tbuoyg, volg) -#endif do n = 1, n_parcels pvol = parcels%volume(n) #ifndef ENABLE_DRY_MODE - ! liquid water content - q_c = parcels%humidity(n) & - - q_0 * dexp(lambda_c * (lower(3) - parcels%position(3, n))) - q_c = max(zero, q_c) - ! total buoyancy (including effects of latent heating) - btot = parcels%buoyancy(n) + glat * q_c + btot = gravity*(parcels%theta(n)*(1.0+qv_theta_coefficient*parcels%qv(n)-parcels%ql(n))/theta_0-1.0) #else - btot = parcels%buoyancy(n) + btot = gravity*(parcels%theta(n)/theta_0-1.0) #endif points = get_ellipsoid_points(parcels%position(:, n), & pvol, parcels%B(:, n), n, l_reuse) @@ -186,12 +177,6 @@ subroutine par2grid(l_reuse) vortg(ks:ks+1, js:js+1, is:is+1, l) = vortg(ks:ks+1, js:js+1, is:is+1, l) & + weight * parcels%vorticity(l, n) enddo -#ifndef ENABLE_DRY_MODE - dbuoyg(ks:ks+1, js:js+1, is:is+1) = dbuoyg(ks:ks+1, js:js+1, is:is+1) & - + weight * parcels%buoyancy(n) - humg(ks:ks+1, js:js+1, is:is+1) = humg(ks:ks+1, js:js+1, is:is+1) & - + weight * parcels%humidity(n) -#endif tbuoyg(ks:ks+1, js:js+1, is:is+1) = tbuoyg(ks:ks+1, js:js+1, is:is+1) & + weight * btot volg(ks:ks+1, js:js+1, is:is+1) = volg(ks:ks+1, js:js+1, is:is+1) & @@ -226,19 +211,6 @@ subroutine par2grid(l_reuse) tbuoyg(nz-1, :, :) = tbuoyg(nz-1, :, :) + tbuoyg(nz+1, :, :) !$omp end parallel workshare -#ifndef ENABLE_DRY_MODE - !$omp parallel workshare - dbuoyg(0, :, :) = two * dbuoyg(0, :, :) - dbuoyg(nz, :, :) = two * dbuoyg(nz, :, :) - dbuoyg(1, :, :) = dbuoyg(1, :, :) + dbuoyg(-1, :, :) - dbuoyg(nz-1, :, :) = dbuoyg(nz-1, :, :) + dbuoyg(nz+1, :, :) - humg(0, :, :) = two * humg(0, :, :) - humg(nz, :, :) = two * humg(nz, :, :) - humg(1, :, :) = humg(1, :, :) + humg(-1, :, :) - humg(nz-1, :, :) = humg(nz-1, :, :) + humg(nz+1, :, :) - !$omp end parallel workshare -#endif - ! exclude halo cells to avoid division by zero do p = 1, 3 vortg(0:nz, :, :, p) = vortg(0:nz, :, :, p) / volg(0:nz, :, :) @@ -258,10 +230,6 @@ subroutine par2grid(l_reuse) vortg(-1, :, :, :) = two * vortg(0, :, :, :) - vortg(1, :, :, :) vortg(nz+1, :, :, :) = two * vortg(nz, :, :, :) - vortg(nz-1, :, :, :) -#ifndef ENABLE_DRY_MODE - dbuoyg(0:nz, :, :) = dbuoyg(0:nz, :, :) / volg(0:nz, :, :) - humg(0:nz, :, :) = humg(0:nz, :, :) / volg(0:nz, :, :) -#endif tbuoyg(0:nz, :, :) = tbuoyg(0:nz, :, :) / volg(0:nz, :, :) ! extrapolate to halo grid points (needed to compute @@ -288,6 +256,99 @@ subroutine par2grid(l_reuse) end subroutine par2grid + ! Interpolate parcel quantities to the grid, these consist of the parcel + ! - vorticity + ! - buoyancy + ! - volume + ! It also updates the scalar fields: + ! - nparg, that is the number of parcels per grid cell + ! - nsparg, that is the number of small parcels per grid cell + ! @pre The parcel must be assigned to the correct MPI process. + subroutine par2grid_diag + double precision :: points(3, 4) + integer :: n, p, l, i, j, k + double precision :: pvol, weight(0:1,0:1,0:1) + + thetag = zero +#ifndef ENABLE_DRY_MODE + qcg = zero + qvg = zero +#endif + !$omp parallel default(shared) +#ifndef ENABLE_DRY_MODE + !$omp do private(n, p, l, i, j, k, points, pvol, weight) & + !$omp& private( is, js, ks, weights) & + !$omp& reduction(+:nparg, nsparg, vortg, thetag, qvg, qlg) +#else + !$omp do private(n, p, l, i, j, k, points, pvol, weight) & + !$omp& private( is, js, ks, weights) & + !$omp& reduction(+:nparg, nsparg, vortg, thetag) +#endif + + do n = 1, n_parcels + pvol = parcels%volume(n) + + points = get_ellipsoid_points(parcels%position(:, n), & + pvol, parcels%B(:, n), n, l_reuse) + + call get_index(parcels%position(:, n), i, j, k) + nparg(k, j, i) = nparg(k, j, i) + 1 + if (parcels%volume(n) <= vmin) then + nsparg(k, j, i) = nsparg(k, j, i) + 1 + endif + + ! we have 4 points per ellipsoid + do p = 1, 4 + + call trilinear(points(:, p), is, js, ks, weights) + + ! loop over grid points which are part of the interpolation + ! the weight is a quarter due to 4 points per ellipsoid + weight = f14 * pvol* weights + + thetag(ks:ks+1, js:js+1, is:is+1) = thetag(ks:ks+1, js:js+1, is:is+1) & + + weight * parcels%theta(n) +#ifndef ENABLE_DRY_MODE + qvg(ks:ks+1, js:js+1, is:is+1) = qvg(ks:ks+1, js:js+1, is:is+1) & + + weight * parcels%qv(n) + qlg(ks:ks+1, js:js+1, is:is+1) = qlg(ks:ks+1, js:js+1, is:is+1) & + + weight * parcels%ql(n) +#endif + enddo + enddo + !$omp end do + !$omp end parallel + + call start_timer(halo_swap_timer) + call par2grid_halo_swap_diag + call stop_timer(halo_swap_timer) + + !$omp parallel workshare + thetag(0:nz, :, :) = thetag(0:nz, :, :) / volg(0:nz, :, :) + + ! extrapolate to halo grid points (needed to compute + ! z derivative used for the time step) + thetag(-1, :, :) = two * thetag(0, :, :) - thetag(1, :, :) + thetag(nz+1, :, :) = two * thetag(nz, :, :) - thetag(nz-1, :, :) + +#ifndef ENABLE_DRY_MODE + qvg(0:nz, :, :) = qvg(0:nz, :, :) / volg(0:nz, :, :) + + ! extrapolate to halo grid points (needed to compute + ! z derivative used for the time step) + qvg(-1, :, :) = two * qvg(0, :, :) - qvg(1, :, :) + qvg(nz+1, :, :) = two * qvg(nz, :, :) - qvg(nz-1, :, :) + + qlg(0:nz, :, :) = qlg(0:nz, :, :) / volg(0:nz, :, :) + + ! extrapolate to halo grid points (needed to compute + ! z derivative used for the time step) + qlg(-1, :, :) = two * qlg(0, :, :) - qlg(1, :, :) + qlg(nz+1, :, :) = two * qlg(nz, :, :) - qlg(nz-1, :, :) +#endif + !$omp end parallel workshare + + end subroutine par2grid_diag subroutine par2grid_halo_swap ! we must first fill the interior grid points @@ -305,10 +366,6 @@ subroutine par2grid_halo_swap call field_halo_to_buffer(vortg(:, :, :, I_Y), IDX_VOR_Y_SWAP) call field_halo_to_buffer(vortg(:, :, :, I_Z), IDX_VOR_Z_SWAP) call field_halo_to_buffer(tbuoyg, IDX_TBUOY_SWAP) -#ifndef ENABLE_DRY_MODE - call field_halo_to_buffer(dbuoyg, IDX_DBUOY_SWAP) - call field_halo_to_buffer(humg, IDX_HUM_SWAP) -#endif ! send halo data to valid regions of other processes call halo_to_interior_communication @@ -320,10 +377,7 @@ subroutine par2grid_halo_swap call field_buffer_to_interior(vortg(:, :, :, I_Y), IDX_VOR_Y_SWAP, .true.) call field_buffer_to_interior(vortg(:, :, :, I_Z), IDX_VOR_Z_SWAP, .true.) call field_buffer_to_interior(tbuoyg, IDX_TBUOY_SWAP, .true.) -#ifndef ENABLE_DRY_MODE - call field_buffer_to_interior(dbuoyg, IDX_DBUOY_SWAP, .true.) - call field_buffer_to_interior(humg, IDX_HUM_SWAP, .true.) -#endif + !------------------------------------------------------------------ ! Fill halo: @@ -333,10 +387,6 @@ subroutine par2grid_halo_swap call field_interior_to_buffer(vortg(:, :, :, I_Y), IDX_VOR_Y_SWAP) call field_interior_to_buffer(vortg(:, :, :, I_Z), IDX_VOR_Z_SWAP) call field_interior_to_buffer(tbuoyg, IDX_TBUOY_SWAP) -#ifndef ENABLE_DRY_MODE - call field_interior_to_buffer(dbuoyg, IDX_DBUOY_SWAP) - call field_interior_to_buffer(humg, IDX_HUM_SWAP) -#endif call interior_to_halo_communication @@ -345,15 +395,55 @@ subroutine par2grid_halo_swap call field_buffer_to_halo(vortg(:, :, :, I_Y), IDX_VOR_Y_SWAP, .false.) call field_buffer_to_halo(vortg(:, :, :, I_Z), IDX_VOR_Z_SWAP, .false.) call field_buffer_to_halo(tbuoyg, IDX_TBUOY_SWAP, .false.) -#ifndef ENABLE_DRY_MODE - call field_buffer_to_halo(dbuoyg, IDX_DBUOY_SWAP, .false.) - call field_buffer_to_halo(humg, IDX_HUM_SWAP, .false.) -#endif call field_mpi_dealloc end subroutine par2grid_halo_swap + subroutine par2grid_halo_swap_diag + ! we must first fill the interior grid points + ! correctly, and then the halo; otherwise + ! halo grid points do not have correct values at + ! corners where multiple processes share grid points. + + call field_mpi_alloc(n_field_swap_diag) + + !------------------------------------------------------------------ + ! Accumulate interior: + call field_halo_to_buffer(thetag, IDX_THETA_SWAP) +#ifndef ENABLE_DRY_MODE + call field_halo_to_buffer(qvg, IDX_QV_SWAP) + call field_halo_to_buffer(qlg, IDX_QL_SWAP) +#endif + ! send halo data to valid regions of other processes + call halo_to_interior_communication + + ! accumulate interior; after this operation + ! all interior grid points have the correct value + call field_buffer_to_interior(thetag, IDX_THETA_SWAP, .true.) + call field_buffer_to_interior(qvg, IDX_QV_SWAP, .true.) + call field_buffer_to_interior(qlg, IDX_QL_SWAP, .true.) +#endif + + !------------------------------------------------------------------ + ! Fill halo: + + call field_interior_to_buffer(thetag, IDX_THETA_SWAP) +#ifndef ENABLE_DRY_MODE + call field_interior_to_buffer(qvg, IDX_QV_SWAP) + call field_interior_to_buffer(qlg, IDX_QL_SWAP) +#endif + + call interior_to_halo_communication + + call field_buffer_to_halo(thetag, IDX_THETA_SWAP, .false.) +#ifndef ENABLE_DRY_MODE + call field_buffer_to_halo(qvg, IDX_QV_SWAP, .false.) + call field_buffer_to_halo(qlg, IDX_QL_SWAP, .false.) +#endif + call field_mpi_dealloc + + end subroutine par2grid_halo_swap_diag ! Interpolate the gridded quantities to the parcels ! @param[in] add contributions, i.e. do not reset parcel quantities to zero before doing grid2par. @@ -484,5 +574,52 @@ pure subroutine get_weights(xyz, i, j, k, ww) end subroutine get_weights + subroutine saturation_adjustment + double precision, parameter :: tk0c = 273.15 &! Temperature of freezing in Kelvin + double precision, parameter :: qsa1 = 3.8, &! Top in equation to calculate qsat + double precision, parameter :: qsa2 = -17.2693882, &! Constant in qsat equation + double precision, parameter :: qsa3 = 35.86, &! Constant in qsat equation + double precision, parameter :: qsa4 = 6.109, &! Constant in qsat equation + double precision, parameter :: pressure_scale_height = 8000. ! Constant in qsat equation + double precision, parameter :: ref_press = 100000 + double precision :: press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat + integer :: n, iter + + !$omp parallel default(shared) + !$omp do private(n, iter, press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat) + do n = 1, n_parcels + press=ref_press*exp(-parcels%position(3, n)/pressure_scale_height) + exn=(press/ref_press)**(r_d/c_p) + temp=parcels%theta(n)*exn + temp_start=temp + ql_start=parcels%ql(n) + qt_start=ql_start+parcels%qv(n) + ! Test unsaturated case first + temp_low=temp-(L_v/c_p)*ql_start + qsat_low = qsa1/(press*exp(qsa2*(temp_low - tk0c)/(temp_low - qsa3)) - qsa4) + if(qt_start < qsat_low) then ! Evaporate everything, if needed at all + if(ql_start>0.) then + parcels%theta(n)=parcels%theta(n)-(L_v/(c_p*exn))*ql_start + parcels%qv(n)=parcels%qv(n)+ql_start + parcels%ql(n)=0. + end if + ! Moist case: iterate a few times, start from temp instead of temp_low + else + do iter=1,4 + qsat=qsa1/(press*exp(qsa2*(temp - tk0c)/(temp - qsa3)) - qsa4) + ql_iter=max(qt_start-qsat,0.0) + temp=temp_start-(L_v/c_p)*(ql_start-ql_iter) + enddo + qsat=qsa1/(press*exp(qsa2*(temp - tk0c)/(temp - qsa3)) - qsa4) + ql_iter=max(qt_start-qsat,0.0) + parcels%theta(n)=parcels%theta(n)-(L_v/(c_p*exn))*(ql_start-ql_iter) + parcels%qv(n)=qt_start-ql_iter + parcels%ql(n)=ql_iter + end if + end do + !$omp end do + !$omp end parallel + + end subroutine saturation_adjustment end module parcel_interpl diff --git a/src/utils/physics.f90 b/src/utils/physics.f90 index 35166167e..7726d0e6d 100644 --- a/src/utils/physics.f90 +++ b/src/utils/physics.f90 @@ -69,7 +69,12 @@ module physics ![m] MPIC specific, scale-height, H double precision, protected :: height_c = 1000.0d0 - ! + ![-] Molecular weight of dry air/ molecular weight of water - 1 + double precision, protected :: qv_dens_coeff= 0.608 + + ! gas constant of gry air + double precision, protected :: r_d=287.05 + ! The following quantities are calculated: ! @@ -159,7 +164,6 @@ subroutine update_physical_quantities glat = gravity * L_v / (c_p * theta_0) glati = one / glat - lambda_c = one / height_c if (l_planet_vorticity) then From 16da9d5b915330624987b5efd75f57be4e623c52 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Thu, 11 May 2023 21:30:02 +0100 Subject: [PATCH 04/34] Compiling code --- mpi-tests/test_parcel_merge_random.f90 | 6 +++--- mpi-tests/test_parcel_split_random.f90 | 6 +++--- src/3d/Makefile.am | 6 +++--- src/3d/fields/field_netcdf.f90 | 2 +- src/3d/parcels/parcel_diagnostics.f90 | 9 +++++++-- src/3d/parcels/parcel_interpl.f90 | 24 +++++++++++++----------- unit-tests/3d/test_mpi_parcel_pack.f90 | 3 ++- 7 files changed, 32 insertions(+), 24 deletions(-) diff --git a/mpi-tests/test_parcel_merge_random.f90 b/mpi-tests/test_parcel_merge_random.f90 index 3d5e1488f..d324a42e5 100644 --- a/mpi-tests/test_parcel_merge_random.f90 +++ b/mpi-tests/test_parcel_merge_random.f90 @@ -90,12 +90,12 @@ program test_parcel_merge_random call random_number(rn(3)) j = nint(n_parcels * rn(3)) + 1 parcels%volume(j) = 0.9d0 * vmin - parcels%buoyancy(j) = 1.0d0 + parcels%theta(j) = 1.0d0 endif enddo - n_merges = int(sum(parcels%buoyancy(1:n_parcels))) + n_merges = int(sum(parcels%theta(1:n_parcels))) call perform_integer_reduction(n_merges) if (comm%rank == comm%master) then @@ -117,7 +117,7 @@ program test_parcel_merge_random n_parcels = n_orig do n = 1, n_parcels parcels%volume(n) = vol - parcels%buoyancy(n) = 0.0d0 + parcels%theta(n) = 0.0d0 parcels%B(:, n) = b call random_number(rn) diff --git a/mpi-tests/test_parcel_split_random.f90 b/mpi-tests/test_parcel_split_random.f90 index b807e291f..f8feea551 100644 --- a/mpi-tests/test_parcel_split_random.f90 +++ b/mpi-tests/test_parcel_split_random.f90 @@ -87,12 +87,12 @@ program test_parcel_split_random call random_number(rn(3)) j = nint(n_parcels * rn(3)) + 1 parcels%volume(j) = 1.1d0 * vmax - parcels%buoyancy(j) = 1.0d0 + parcels%theta(j) = 1.0d0 endif enddo - n_splits = int(sum(parcels%buoyancy(1:n_parcels))) + n_splits = int(sum(parcels%theta(1:n_parcels))) call perform_integer_reduction(n_splits) if (comm%rank == comm%master) then @@ -114,7 +114,7 @@ program test_parcel_split_random n_parcels = n_orig do n = 1, n_parcels parcels%volume(n) = vol - parcels%buoyancy(n) = 0.0d0 + parcels%theta(n) = 0.0d0 parcels%B(:, n) = b call random_number(rn) diff --git a/src/3d/Makefile.am b/src/3d/Makefile.am index 3f2ca37de..aaf6e6242 100644 --- a/src/3d/Makefile.am +++ b/src/3d/Makefile.am @@ -13,9 +13,6 @@ epic3d_SOURCES = \ fields/field_mpi.f90 \ fields/fields.f90 \ fields/field_ops.f90 \ - fields/field_diagnostics.f90 \ - fields/field_netcdf.f90 \ - fields/field_diagnostics_netcdf.f90 \ parcels/parcel_ellipsoid.f90 \ parcels/parcel_container.f90 \ parcels/parcel_mpi.f90 \ @@ -26,6 +23,9 @@ epic3d_SOURCES = \ parcels/parcel_diagnostics.f90 \ parcels/parcel_interpl.f90 \ parcels/parcel_init.f90 \ + fields/field_diagnostics.f90 \ + fields/field_netcdf.f90 \ + fields/field_diagnostics_netcdf.f90 \ inversion/inversion_utils.f90 \ inversion/inversion.f90 \ parcels/parcel_correction.f90 \ diff --git a/src/3d/fields/field_netcdf.f90 b/src/3d/fields/field_netcdf.f90 index 97e195de2..f7b9a067f 100644 --- a/src/3d/fields/field_netcdf.f90 +++ b/src/3d/fields/field_netcdf.f90 @@ -397,7 +397,7 @@ subroutine write_netcdf_fields(t) call write_netcdf_dataset(ncid, tbuoy_id, tbuoyg(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)), & start, cnt) - call write_netcdf_dataset(ncid, theta_id, theta(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)), & + call write_netcdf_dataset(ncid, theta_id, thetag(lo(3):hi(3), lo(2):hi(2), lo(1):hi(1)), & start, cnt) #ifndef ENABLE_DRY_MODE diff --git a/src/3d/parcels/parcel_diagnostics.f90 b/src/3d/parcels/parcel_diagnostics.f90 index 8b312bff1..555c057ec 100644 --- a/src/3d/parcels/parcel_diagnostics.f90 +++ b/src/3d/parcels/parcel_diagnostics.f90 @@ -9,7 +9,7 @@ module parcel_diagnostics use parcel_split_mod, only : n_parcel_splits use parcel_merge, only : n_parcel_merges use omp_lib - use physics, only : ape_calculation + use physics, only : ape_calculation, gravity, theta_0, qv_dens_coeff use ape_density, only : ape_den use mpi_timer, only : start_timer, stop_timer use mpi_communicator @@ -70,7 +70,12 @@ subroutine calculate_parcel_diagnostics vel = parcels%delta_pos(:, n) vor = parcels%vorticity(:, n) vol = parcels%volume(n) - b = parcels%buoyancy(n) +#ifndef ENABLE_DRY_MODE + ! total buoyancy (including effects of latent heating) + b = gravity*(parcels%theta(n)*(1.0+qv_dens_coeff*parcels%qv(n)-parcels%ql(n))/theta_0-1.0) +#else + b = gravity*(parcels%theta(n)/theta_0-1.0) +#endif z = parcels%position(3, n) ! kinetic energy diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index 0272e584d..64fc3cc43 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -151,7 +151,7 @@ subroutine par2grid(l_reuse) #ifndef ENABLE_DRY_MODE ! total buoyancy (including effects of latent heating) - btot = gravity*(parcels%theta(n)*(1.0+qv_theta_coefficient*parcels%qv(n)-parcels%ql(n))/theta_0-1.0) + btot = gravity*(parcels%theta(n)*(1.0+qv_dens_coeff*parcels%qv(n)-parcels%ql(n))/theta_0-1.0) #else btot = gravity*(parcels%theta(n)/theta_0-1.0) #endif @@ -264,23 +264,24 @@ end subroutine par2grid ! - nparg, that is the number of parcels per grid cell ! - nsparg, that is the number of small parcels per grid cell ! @pre The parcel must be assigned to the correct MPI process. - subroutine par2grid_diag + subroutine par2grid_diag(l_reuse) + logical, optional :: l_reuse double precision :: points(3, 4) - integer :: n, p, l, i, j, k + integer :: n, p, i, j, k double precision :: pvol, weight(0:1,0:1,0:1) thetag = zero #ifndef ENABLE_DRY_MODE - qcg = zero qvg = zero + qlg = zero #endif !$omp parallel default(shared) #ifndef ENABLE_DRY_MODE - !$omp do private(n, p, l, i, j, k, points, pvol, weight) & + !$omp do private(n, p, i, j, k, points, pvol, weight) & !$omp& private( is, js, ks, weights) & !$omp& reduction(+:nparg, nsparg, vortg, thetag, qvg, qlg) #else - !$omp do private(n, p, l, i, j, k, points, pvol, weight) & + !$omp do private(n, p, i, j, k, points, pvol, weight) & !$omp& private( is, js, ks, weights) & !$omp& reduction(+:nparg, nsparg, vortg, thetag) #endif @@ -421,6 +422,7 @@ subroutine par2grid_halo_swap_diag ! accumulate interior; after this operation ! all interior grid points have the correct value call field_buffer_to_interior(thetag, IDX_THETA_SWAP, .true.) +#ifndef ENABLE_DRY_MODE call field_buffer_to_interior(qvg, IDX_QV_SWAP, .true.) call field_buffer_to_interior(qlg, IDX_QL_SWAP, .true.) #endif @@ -575,11 +577,11 @@ pure subroutine get_weights(xyz, i, j, k, ww) end subroutine get_weights subroutine saturation_adjustment - double precision, parameter :: tk0c = 273.15 &! Temperature of freezing in Kelvin - double precision, parameter :: qsa1 = 3.8, &! Top in equation to calculate qsat - double precision, parameter :: qsa2 = -17.2693882, &! Constant in qsat equation - double precision, parameter :: qsa3 = 35.86, &! Constant in qsat equation - double precision, parameter :: qsa4 = 6.109, &! Constant in qsat equation + double precision, parameter :: tk0c = 273.15 ! Temperature of freezing in Kelvin + double precision, parameter :: qsa1 = 3.8 ! Top in equation to calculate qsat + double precision, parameter :: qsa2 = -17.2693882 ! Constant in qsat equation + double precision, parameter :: qsa3 = 35.86 ! Constant in qsat equation + double precision, parameter :: qsa4 = 6.109 ! Constant in qsat equation double precision, parameter :: pressure_scale_height = 8000. ! Constant in qsat equation double precision, parameter :: ref_press = 100000 double precision :: press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat diff --git a/unit-tests/3d/test_mpi_parcel_pack.f90 b/unit-tests/3d/test_mpi_parcel_pack.f90 index 58c94adc8..b96216b20 100644 --- a/unit-tests/3d/test_mpi_parcel_pack.f90 +++ b/unit-tests/3d/test_mpi_parcel_pack.f90 @@ -50,7 +50,8 @@ program test_mpi_parcel_pack parcels%volume(n) = 12.0d0 + a parcels%theta(n) = 13.0d0 + a #ifndef ENABLE_DRY_MODE - parcels%humidity(n) = 14.0d0 + a + parcels%qv(n) = 14.0d0 + a + parcels%ql(n) = 15.0d0 + a #endif enddo From 54189c1482f66d215648b46ad151d8cbac3bc921 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Thu, 11 May 2023 21:53:43 +0100 Subject: [PATCH 05/34] Small fixes in openmp --- src/3d/parcels/parcel_interpl.f90 | 8 ++++---- src/3d/parcels/parcel_split.f90 | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index 64fc3cc43..1d2fc83ca 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -279,11 +279,11 @@ subroutine par2grid_diag(l_reuse) #ifndef ENABLE_DRY_MODE !$omp do private(n, p, i, j, k, points, pvol, weight) & !$omp& private( is, js, ks, weights) & - !$omp& reduction(+:nparg, nsparg, vortg, thetag, qvg, qlg) + !$omp& reduction(+:nparg, nsparg, thetag, qvg, qlg) #else !$omp do private(n, p, i, j, k, points, pvol, weight) & !$omp& private( is, js, ks, weights) & - !$omp& reduction(+:nparg, nsparg, vortg, thetag) + !$omp& reduction(+:nparg, nsparg, thetag) #endif do n = 1, n_parcels @@ -582,8 +582,8 @@ subroutine saturation_adjustment double precision, parameter :: qsa2 = -17.2693882 ! Constant in qsat equation double precision, parameter :: qsa3 = 35.86 ! Constant in qsat equation double precision, parameter :: qsa4 = 6.109 ! Constant in qsat equation - double precision, parameter :: pressure_scale_height = 8000. ! Constant in qsat equation - double precision, parameter :: ref_press = 100000 + double precision, parameter :: pressure_scale_height = 8000.0 ! Constant in qsat equation + double precision, parameter :: ref_press = 100000.0 double precision :: press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat integer :: n, iter diff --git a/src/3d/parcels/parcel_split.f90 b/src/3d/parcels/parcel_split.f90 index ee727230b..b7d7699fe 100644 --- a/src/3d/parcels/parcel_split.f90 +++ b/src/3d/parcels/parcel_split.f90 @@ -105,11 +105,11 @@ subroutine parcel_split(parcels, threshold) call apply_reflective_bc(parcels%position(:, n), parcels%B(:, n)) ! save parcel indices of child parcels for the -!~ ! halo swap routine + ! halo swap routine pid(n) = n pid(n_thread_loc) = n_thread_loc enddo - !$omp end dosrc/2d/parcels/parcel_diagnostics.f90: + !$omp end do !$omp end parallel n_parcel_splits = n_parcel_splits + n_parcels - last_index From 7977b2a23ea7f1e4e5148adb2adb34f7ad36d88e Mon Sep 17 00:00:00 2001 From: sjboeing Date: Thu, 11 May 2023 22:41:29 +0100 Subject: [PATCH 06/34] Restoring double correction factor, some name fixes --- src/3d/boundary_layer/bndry_fluxes.f90 | 10 +++++----- src/3d/parcels/parcel_interpl.f90 | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/3d/boundary_layer/bndry_fluxes.f90 b/src/3d/boundary_layer/bndry_fluxes.f90 index c296ccb4b..0225fc6a6 100644 --- a/src/3d/boundary_layer/bndry_fluxes.f90 +++ b/src/3d/boundary_layer/bndry_fluxes.f90 @@ -25,9 +25,9 @@ module bndry_fluxes private ! Spatial form of the buoyancy and humidity fluxes through lower surface: - double precision, dimension(:, :), allocatable :: bflux + double precision, dimension(:, :), allocatable :: thetaflux #ifndef ENABLE_DRY_MODE - double precision, dimension(:, :), allocatable :: hflux + double precision, dimension(:, :), allocatable :: qvflux #endif double precision :: fluxfac @@ -86,9 +86,9 @@ subroutine bndry_fluxes_default call bndry_fluxes_allocate - bflux = zero + thetaflux = zero #ifndef ENABLE_DRY_MODE - hflux = zero + qvflux = zero #endif end subroutine bndry_fluxes_default @@ -183,7 +183,7 @@ subroutine apply_bndry_fluxes(dt) call bilinear(xy, is, js, weights) - fac = 2.0*(zdepth - z)/(dx(3)*dx(3)) * dt + fac = (zdepth - z) * dt do l = 1, ngp ! The multiplication by dt is necessary to provide the amount of b or h diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index c4029f63c..f6eda039d 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -20,7 +20,7 @@ module parcel_interpl , interior_to_halo_communication & , halo_to_interior_communication & , field_halo_swap_scalar - , + use physics, only : gravity, theta_0, qv_dens_coeff, r_d, c_p, L_v use omp_lib use mpi_utils, only : mpi_exit_on_error @@ -409,7 +409,7 @@ subroutine par2grid_halo_swap_diag ! halo grid points do not have correct values at ! corners where multiple processes share grid points. - call field_mpi_alloc(n_field_swap_diag) + call field_mpi_alloc(n_field_swap_diag, ndim=3) !------------------------------------------------------------------ ! Accumulate interior: From 667d52e7bea2f6a4fc7df410610abdddf8b07c45 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Fri, 12 May 2023 14:50:01 +0100 Subject: [PATCH 07/34] Adding back multiplication at boundaries in par2grid_diag (needed) --- src/3d/parcels/parcel_interpl.f90 | 71 ++++++++++++++++++++++++++++--- 1 file changed, 65 insertions(+), 6 deletions(-) diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index 1d2fc83ca..1f6d84f4b 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -19,7 +19,8 @@ module parcel_interpl , field_interior_to_buffer & , interior_to_halo_communication & , halo_to_interior_communication & - , field_halo_swap + , field_halo_swap_scalar + use physics, only : gravity, theta_0, qv_dens_coeff, r_d, c_p, L_v use omp_lib use mpi_utils, only : mpi_exit_on_error @@ -62,8 +63,9 @@ module parcel_interpl , grid2par & , par2grid_timer & , grid2par_timer & - , halo_swap_timer & - , trilinear + , halo_swap_timer & + , trilinear & + , bilinear contains @@ -100,7 +102,7 @@ subroutine vol2grid(l_reuse) !$omp end parallel call start_timer(halo_swap_timer) - call field_halo_swap(volg) + call field_halo_swap_scalar(volg) call stop_timer(halo_swap_timer) ! apply free slip boundary condition @@ -320,6 +322,25 @@ subroutine par2grid_diag(l_reuse) !$omp end do !$omp end parallel + !$omp parallel workshare + ! apply free slip boundary condition + thetag(0, :, :) = two * thetag(0, :, :) + thetag(nz, :, :) = two * thetag(nz, :, :) + thetag(1, :, :) = thetag(1, :, :) + thetag(-1, :, :) + thetag(nz-1, :, :) = thetag(nz-1, :, :) + thetag(nz+1, :, :) + + qvg(0, :, :) = two * qvg(0, :, :) + qvg(nz, :, :) = two * qvg(nz, :, :) + qvg(1, :, :) = qvg(1, :, :) + qvg(-1, :, :) + qvg(nz-1, :, :) = qvg(nz-1, :, :) + qvg(nz+1, :, :) + + qlg(0, :, :) = two * qlg(0, :, :) + qlg(nz, :, :) = two * qlg(nz, :, :) + qlg(1, :, :) = qlg(1, :, :) + qlg(-1, :, :) + qlg(nz-1, :, :) = qlg(nz-1, :, :) + qlg(nz+1, :, :) + !$omp end parallel workshare + + call start_timer(halo_swap_timer) call par2grid_halo_swap_diag call stop_timer(halo_swap_timer) @@ -357,7 +378,7 @@ subroutine par2grid_halo_swap ! halo grid points do not have correct values at ! corners where multiple processes share grid points. - call field_mpi_alloc(n_field_swap) + call field_mpi_alloc(n_field_swap, ndim=3) !------------------------------------------------------------------ ! Accumulate interior: @@ -407,7 +428,7 @@ subroutine par2grid_halo_swap_diag ! halo grid points do not have correct values at ! corners where multiple processes share grid points. - call field_mpi_alloc(n_field_swap_diag) + call field_mpi_alloc(n_field_swap_diag, ndim=3) !------------------------------------------------------------------ ! Accumulate interior: @@ -624,4 +645,42 @@ subroutine saturation_adjustment end subroutine saturation_adjustment + !:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + ! Bi-linear interpolation + ! @param[in] pos position of the parcel + ! @param[out] ii horizontal grid points for interoplation + ! @param[out] jj meridional grid points for interpolation + ! @param[out] ww interpolation weights + subroutine bilinear(pos, ii, jj, ww) + double precision, intent(in) :: pos(2) + integer, intent(out) :: ii(4), jj(4) + double precision, intent(out) :: ww(4) + double precision :: xy(2) + + ! (i, j) + call get_horizontal_index(pos, ii(1), jj(1)) + call get_horizontal_position(ii(1), jj(1), xy) + ww(1) = product(one - abs(pos - xy) * dxi(1:2)) + + ! (i+1, j) + ii(2) = ii(1) + 1 + jj(2) = jj(1) + call get_horizontal_position(ii(2), jj(2), xy) + ww(2) = product(one - abs(pos - xy) * dxi(1:2)) + + ! (i, j+1) + ii(3) = ii(1) + jj(3) = jj(1) + 1 + call get_horizontal_position(ii(3), jj(3), xy) + ww(3) = product(one - abs(pos - xy) * dxi(1:2)) + + ! (i+1, j+1) + ii(4) = ii(2) + jj(4) = jj(3) + call get_horizontal_position(ii(4), jj(4), xy) + ww(4) = product(one - abs(pos - xy) * dxi(1:2)) + + end subroutine bilinear + end module parcel_interpl From 5b2d499b50669d4a72647e22f98629fd8ecd4c3d Mon Sep 17 00:00:00 2001 From: sjboeing Date: Fri, 12 May 2023 15:00:05 +0100 Subject: [PATCH 08/34] Adding in pre-compiler directives for dry case --- src/3d/parcels/parcel_interpl.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index 1f6d84f4b..58f0b6724 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -329,6 +329,7 @@ subroutine par2grid_diag(l_reuse) thetag(1, :, :) = thetag(1, :, :) + thetag(-1, :, :) thetag(nz-1, :, :) = thetag(nz-1, :, :) + thetag(nz+1, :, :) +#ifndef ENABLE_DRY_MODE qvg(0, :, :) = two * qvg(0, :, :) qvg(nz, :, :) = two * qvg(nz, :, :) qvg(1, :, :) = qvg(1, :, :) + qvg(-1, :, :) @@ -338,6 +339,7 @@ subroutine par2grid_diag(l_reuse) qlg(nz, :, :) = two * qlg(nz, :, :) qlg(1, :, :) = qlg(1, :, :) + qlg(-1, :, :) qlg(nz-1, :, :) = qlg(nz-1, :, :) + qlg(nz+1, :, :) +#endif !$omp end parallel workshare From 14b927a6854a737e055658b3913bd1d20c5408e4 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Fri, 12 May 2023 22:54:21 +0100 Subject: [PATCH 09/34] Bugfixes in 1) Dry mode and 2) Diagnostic par2grid somehow needs volg recalculated --- src/3d/fields/fields.f90 | 2 +- src/3d/parcels/parcel_interpl.f90 | 28 +++++++++++++++++++++------- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/3d/fields/fields.f90 b/src/3d/fields/fields.f90 index 6b13d8654..030f97c1d 100644 --- a/src/3d/fields/fields.f90 +++ b/src/3d/fields/fields.f90 @@ -36,10 +36,10 @@ module fields double precision, allocatable, dimension(:, :, :) :: & #ifndef ENABLE_DRY_MODE - thetag, & ! dry buoyancy (or liquid-water buoyancy) qvg, & ! humidity qlg, & ! liquid water #endif + thetag, & ! dry buoyancy (or liquid-water buoyancy) tbuoyg, & ! buoyancy #ifndef NDEBUG sym_volg, & ! symmetry volume (debug mode only) diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index 58f0b6724..01fe1566a 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -48,13 +48,13 @@ module parcel_interpl integer, parameter :: n_field_swap = 5 ! restart indices for par2grid_diag - integer, parameter :: IDX_THETA_SWAP = 1 + integer, parameter :: IDX_THETA_SWAP = 2 #ifndef ENABLE_DRY_MODE - integer, parameter :: IDX_QV_SWAP = 2 & - , IDX_QL_SWAP = 3 - integer, parameter :: n_field_swap_diag = 3 + integer, parameter :: IDX_QV_SWAP = 3 & + , IDX_QL_SWAP = 4 + integer, parameter :: n_field_swap_diag = 4 #else - integer, parameter :: n_field_swap_diag = 1 + integer, parameter :: n_field_swap_diag = 2 #endif public :: par2grid & @@ -273,6 +273,7 @@ subroutine par2grid_diag(l_reuse) double precision :: pvol, weight(0:1,0:1,0:1) thetag = zero + volg = zero #ifndef ENABLE_DRY_MODE qvg = zero qlg = zero @@ -281,11 +282,11 @@ subroutine par2grid_diag(l_reuse) #ifndef ENABLE_DRY_MODE !$omp do private(n, p, i, j, k, points, pvol, weight) & !$omp& private( is, js, ks, weights) & - !$omp& reduction(+:nparg, nsparg, thetag, qvg, qlg) + !$omp& reduction(+:nparg, nsparg, thetag, volg, qvg, qlg) #else !$omp do private(n, p, i, j, k, points, pvol, weight) & !$omp& private( is, js, ks, weights) & - !$omp& reduction(+:nparg, nsparg, thetag) + !$omp& reduction(+:nparg, nsparg, thetag, volg) #endif do n = 1, n_parcels @@ -311,6 +312,8 @@ subroutine par2grid_diag(l_reuse) thetag(ks:ks+1, js:js+1, is:is+1) = thetag(ks:ks+1, js:js+1, is:is+1) & + weight * parcels%theta(n) + volg(ks:ks+1, js:js+1, is:is+1) = volg(ks:ks+1, js:js+1, is:is+1) & + + weight #ifndef ENABLE_DRY_MODE qvg(ks:ks+1, js:js+1, is:is+1) = qvg(ks:ks+1, js:js+1, is:is+1) & + weight * parcels%qv(n) @@ -324,6 +327,11 @@ subroutine par2grid_diag(l_reuse) !$omp parallel workshare ! apply free slip boundary condition + volg(0, :, :) = two * volg(0, :, :) + volg(nz, :, :) = two * volg(nz, :, :) + volg(1, :, :) = volg(1, :, :) + volg(-1, :, :) + volg(nz-1, :, :) = volg(nz-1, :, :) + volg(nz+1, :, :) + thetag(0, :, :) = two * thetag(0, :, :) thetag(nz, :, :) = two * thetag(nz, :, :) thetag(1, :, :) = thetag(1, :, :) + thetag(-1, :, :) @@ -434,6 +442,7 @@ subroutine par2grid_halo_swap_diag !------------------------------------------------------------------ ! Accumulate interior: + call field_halo_to_buffer(volg, IDX_VOL_SWAP) call field_halo_to_buffer(thetag, IDX_THETA_SWAP) #ifndef ENABLE_DRY_MODE call field_halo_to_buffer(qvg, IDX_QV_SWAP) @@ -444,6 +453,7 @@ subroutine par2grid_halo_swap_diag ! accumulate interior; after this operation ! all interior grid points have the correct value + call field_buffer_to_interior(volg, IDX_VOL_SWAP, .true.) call field_buffer_to_interior(thetag, IDX_THETA_SWAP, .true.) #ifndef ENABLE_DRY_MODE call field_buffer_to_interior(qvg, IDX_QV_SWAP, .true.) @@ -453,6 +463,7 @@ subroutine par2grid_halo_swap_diag !------------------------------------------------------------------ ! Fill halo: + call field_interior_to_buffer(volg, IDX_VOL_SWAP) call field_interior_to_buffer(thetag, IDX_THETA_SWAP) #ifndef ENABLE_DRY_MODE call field_interior_to_buffer(qvg, IDX_QV_SWAP) @@ -461,6 +472,7 @@ subroutine par2grid_halo_swap_diag call interior_to_halo_communication + call field_buffer_to_halo(volg, IDX_VOL_SWAP, .false.) call field_buffer_to_halo(thetag, IDX_THETA_SWAP, .false.) #ifndef ENABLE_DRY_MODE call field_buffer_to_halo(qvg, IDX_QV_SWAP, .false.) @@ -610,6 +622,7 @@ subroutine saturation_adjustment double precision :: press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat integer :: n, iter +#ifndef ENABLE_DRY_MODE !$omp parallel default(shared) !$omp do private(n, iter, press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat) do n = 1, n_parcels @@ -644,6 +657,7 @@ subroutine saturation_adjustment end do !$omp end do !$omp end parallel +#endif end subroutine saturation_adjustment From e1091a74719a6881de592132a2e4d9fef3a63730 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Fri, 12 May 2023 22:54:21 +0100 Subject: [PATCH 10/34] Bugfixes in 1) Dry mode and 2) Diagnostic par2grid somehow needs volg recalculated --- src/3d/fields/fields.f90 | 2 +- src/3d/parcels/parcel_interpl.f90 | 28 +++++++++++++++++++++------- 2 files changed, 22 insertions(+), 8 deletions(-) diff --git a/src/3d/fields/fields.f90 b/src/3d/fields/fields.f90 index f54ba2f3a..2dc61d804 100644 --- a/src/3d/fields/fields.f90 +++ b/src/3d/fields/fields.f90 @@ -36,10 +36,10 @@ module fields double precision, allocatable, dimension(:, :, :) :: & #ifndef ENABLE_DRY_MODE - thetag, & ! dry buoyancy (or liquid-water buoyancy) qvg, & ! humidity qlg, & ! liquid water #endif + thetag, & ! dry buoyancy (or liquid-water buoyancy) tbuoyg, & ! buoyancy #ifndef NDEBUG sym_volg, & ! symmetry volume (debug mode only) diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index 58f0b6724..01fe1566a 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -48,13 +48,13 @@ module parcel_interpl integer, parameter :: n_field_swap = 5 ! restart indices for par2grid_diag - integer, parameter :: IDX_THETA_SWAP = 1 + integer, parameter :: IDX_THETA_SWAP = 2 #ifndef ENABLE_DRY_MODE - integer, parameter :: IDX_QV_SWAP = 2 & - , IDX_QL_SWAP = 3 - integer, parameter :: n_field_swap_diag = 3 + integer, parameter :: IDX_QV_SWAP = 3 & + , IDX_QL_SWAP = 4 + integer, parameter :: n_field_swap_diag = 4 #else - integer, parameter :: n_field_swap_diag = 1 + integer, parameter :: n_field_swap_diag = 2 #endif public :: par2grid & @@ -273,6 +273,7 @@ subroutine par2grid_diag(l_reuse) double precision :: pvol, weight(0:1,0:1,0:1) thetag = zero + volg = zero #ifndef ENABLE_DRY_MODE qvg = zero qlg = zero @@ -281,11 +282,11 @@ subroutine par2grid_diag(l_reuse) #ifndef ENABLE_DRY_MODE !$omp do private(n, p, i, j, k, points, pvol, weight) & !$omp& private( is, js, ks, weights) & - !$omp& reduction(+:nparg, nsparg, thetag, qvg, qlg) + !$omp& reduction(+:nparg, nsparg, thetag, volg, qvg, qlg) #else !$omp do private(n, p, i, j, k, points, pvol, weight) & !$omp& private( is, js, ks, weights) & - !$omp& reduction(+:nparg, nsparg, thetag) + !$omp& reduction(+:nparg, nsparg, thetag, volg) #endif do n = 1, n_parcels @@ -311,6 +312,8 @@ subroutine par2grid_diag(l_reuse) thetag(ks:ks+1, js:js+1, is:is+1) = thetag(ks:ks+1, js:js+1, is:is+1) & + weight * parcels%theta(n) + volg(ks:ks+1, js:js+1, is:is+1) = volg(ks:ks+1, js:js+1, is:is+1) & + + weight #ifndef ENABLE_DRY_MODE qvg(ks:ks+1, js:js+1, is:is+1) = qvg(ks:ks+1, js:js+1, is:is+1) & + weight * parcels%qv(n) @@ -324,6 +327,11 @@ subroutine par2grid_diag(l_reuse) !$omp parallel workshare ! apply free slip boundary condition + volg(0, :, :) = two * volg(0, :, :) + volg(nz, :, :) = two * volg(nz, :, :) + volg(1, :, :) = volg(1, :, :) + volg(-1, :, :) + volg(nz-1, :, :) = volg(nz-1, :, :) + volg(nz+1, :, :) + thetag(0, :, :) = two * thetag(0, :, :) thetag(nz, :, :) = two * thetag(nz, :, :) thetag(1, :, :) = thetag(1, :, :) + thetag(-1, :, :) @@ -434,6 +442,7 @@ subroutine par2grid_halo_swap_diag !------------------------------------------------------------------ ! Accumulate interior: + call field_halo_to_buffer(volg, IDX_VOL_SWAP) call field_halo_to_buffer(thetag, IDX_THETA_SWAP) #ifndef ENABLE_DRY_MODE call field_halo_to_buffer(qvg, IDX_QV_SWAP) @@ -444,6 +453,7 @@ subroutine par2grid_halo_swap_diag ! accumulate interior; after this operation ! all interior grid points have the correct value + call field_buffer_to_interior(volg, IDX_VOL_SWAP, .true.) call field_buffer_to_interior(thetag, IDX_THETA_SWAP, .true.) #ifndef ENABLE_DRY_MODE call field_buffer_to_interior(qvg, IDX_QV_SWAP, .true.) @@ -453,6 +463,7 @@ subroutine par2grid_halo_swap_diag !------------------------------------------------------------------ ! Fill halo: + call field_interior_to_buffer(volg, IDX_VOL_SWAP) call field_interior_to_buffer(thetag, IDX_THETA_SWAP) #ifndef ENABLE_DRY_MODE call field_interior_to_buffer(qvg, IDX_QV_SWAP) @@ -461,6 +472,7 @@ subroutine par2grid_halo_swap_diag call interior_to_halo_communication + call field_buffer_to_halo(volg, IDX_VOL_SWAP, .false.) call field_buffer_to_halo(thetag, IDX_THETA_SWAP, .false.) #ifndef ENABLE_DRY_MODE call field_buffer_to_halo(qvg, IDX_QV_SWAP, .false.) @@ -610,6 +622,7 @@ subroutine saturation_adjustment double precision :: press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat integer :: n, iter +#ifndef ENABLE_DRY_MODE !$omp parallel default(shared) !$omp do private(n, iter, press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat) do n = 1, n_parcels @@ -644,6 +657,7 @@ subroutine saturation_adjustment end do !$omp end do !$omp end parallel +#endif end subroutine saturation_adjustment From c6b5dff8b6001d344a0199c361ea7aefe9e54d5b Mon Sep 17 00:00:00 2001 From: sjboeing Date: Sat, 13 May 2023 08:09:37 +0100 Subject: [PATCH 11/34] Surface fluxes setup added --- python-scripts/surface_fluxes.py | 125 +++++++++++++++++++++++++++++++ 1 file changed, 125 insertions(+) create mode 100644 python-scripts/surface_fluxes.py diff --git a/python-scripts/surface_fluxes.py b/python-scripts/surface_fluxes.py new file mode 100644 index 000000000..e4b786f5f --- /dev/null +++ b/python-scripts/surface_fluxes.py @@ -0,0 +1,125 @@ +#!/usr/bin/env python +from tools.nc_fields import nc_fields +import numpy as np +import argparse + +#The surface flux problem has few parameters, and it is not worth trying to make an exact comparison with Sam's results because he made some odd choices for some of the parameters. The cleanest thing you can do is start with b = z and omega = 0, with f = 0 (rotation would be interesting, later). Then apply a surface flux of 1- units do not matter and db/dz and the flux set the time and length scales to be O(1). So, make the domain big enough, maybe 4L x 4L x L (in x, y and z) with L > 1, maybe 5. Use a uniform flux but slightly disturb the initial parcel positions - this is enough. I'll ask Sam to send his thesis to us. + +try: + parser = argparse.ArgumentParser( + description="Create surface flux setup" + ) + + parser.add_argument( + "--nx", + type=int, + required=False, + default=256, + help="number of cells in x", + ) + + parser.add_argument( + "--ny", + type=int, + required=False, + default=256, + help="number of cells in y", + ) + + parser.add_argument( + "--nz", + type=int, + required=False, + default=64, + help="number of cells in z", + ) + + parser.add_argument( + "--L", + type=float, + required=False, + default=3200.0, + help="domain extent", + ) + + args = parser.parse_args() + + lapse=0.003 + thetafluxmag=0.1 + + # number of cells + nx = args.nx + ny = args.ny + nz = args.nz + + L = args.L + + ncf = nc_fields() + + ncf.open('boundary_layer_setup' + str(nx) + 'x' + str(ny) + 'x' + str(nz) + '.nc') + + # domain origin + origin = (-2.0 * L, -2.0 * L, 0.0) + + # domain extent + extent = (4.0 * L, 4.0 * L, L) + + + # mesh spacings + dx = extent[0] / nx + dy = extent[1] / ny + dz = extent[2] / nz + + buoy = np.zeros((nz+1, ny, nx)) + + # ranges from 0 to nz + for k in range(nz+1): + zrel = k * dz + buoy[k, :, :] = 300.+lapse*zrel + + # add perturbation + rng = np.random.default_rng(seed=42) + noise = rng.uniform(low=0.0, high=0.01*(buoy.max()-300.), size=(nz+1, ny, nx)) + buoy += noise + + # write all provided fields + ncf.add_field('theta', buoy, unit='K', long_name='potential temperature') + + ncf.add_box(origin, extent, [nx, ny, nz]) + + ncf.close() + + # + # Setup surface fluxes: + # + + ncf_flux = nc_fields() + + ncf_flux.set_dim_names(['x', 'y']) + + ncf_flux.open('surface_flux_' + str(nx) + 'x' + str(ny) + '.nc') + + # domain origin + origin = (-2.0 * L, -2.0 * L) + + # domain extent + extent = (4.0 * L, 4.0 * L) + + + # mesh spacings + dx = extent[0] / nx + dy = extent[1] / ny + + thetaflux = np.ones((ny, nx))*thetafluxmag + qvflux = np.zeros((ny, nx)) + + ncf_flux.add_field('thetaflux', thetaflux, unit='K m/s') + ncf_flux.add_field('qvflux', qvflux, unit='kg/kg m/s') + + ncf_flux.add_box(origin, extent, [nx, ny]) + + ncf_flux.close() + +except Exception as err: + print(err) + From 02d27734e7ae4df4d12d221896458e99ea6356f1 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Sat, 13 May 2023 16:11:39 +0100 Subject: [PATCH 12/34] Fixes to run BOMEX, temporarily disable vorticity correction --- python-scripts/bomex_fluxes.py | 152 ++++++++++++++++++++++++++++++ src/3d/epic3d.f90 | 2 +- src/3d/parcels/parcel_interpl.f90 | 13 +-- 3 files changed, 160 insertions(+), 7 deletions(-) create mode 100644 python-scripts/bomex_fluxes.py diff --git a/python-scripts/bomex_fluxes.py b/python-scripts/bomex_fluxes.py new file mode 100644 index 000000000..e633fe1e2 --- /dev/null +++ b/python-scripts/bomex_fluxes.py @@ -0,0 +1,152 @@ +#!/usr/bin/env python +from tools.nc_fields import nc_fields +import numpy as np +import argparse + +try: + parser = argparse.ArgumentParser( + description="Create surface flux setup" + ) + + parser.add_argument( + "--nx", + type=int, + required=False, + default=192, + help="number of cells in x", + ) + + parser.add_argument( + "--ny", + type=int, + required=False, + default=192, + help="number of cells in y", + ) + + parser.add_argument( + "--nz", + type=int, + required=False, + default=96, + help="number of cells in z", + ) + + parser.add_argument( + "--L", + type=float, + required=False, + default=3200.0, + help="domain extent", + ) + + args = parser.parse_args() + + thetafluxmag=8.0e-3 + qvfluxmag=5.2e-5 + + # number of cells + nx = args.nx + ny = args.ny + nz = args.nz + + L = args.L + + ncf = nc_fields() + + ncf.open('bomex_setup' + str(nx) + 'x' + str(ny) + 'x' + str(nz) + '.nc') + + # domain origin + origin = (-1.0 * L, -1.0 * L, 0.0) + + # domain extent + extent = (2.0 * L, 2.0 * L, L) + + + # mesh spacings + dx = extent[0] / nx + dy = extent[1] / ny + dz = extent[2] / nz + + theta = np.zeros((nz+1, ny, nx)) + qv = np.zeros((nz+1, ny, nx)) + yvort = np.zeros((nz+1, ny, nx)) + novort = np.zeros((nz+1, ny, nx)) + + # ranges from 0 to nz + for k in range(nz+1): + zz = k * dz + if(zz < 520.): + theta[k, :,: ] = 298.7 + elif(zz < 1480): + theta[k, :, :] = 298.7 + (zz-520.)*(302.4-298.7)/(1480.-520.) + elif(zz < 2000): + theta[k, :, :] = 302.4 + (zz-1480.)*(308.2-302.4)/(2000.-1480.) + else: + theta[k, :, :] = 308.2 + (zz-2000.)*(311.85-308.2)/(3000.-2000.) + + # specific humidity + if(zz < 520.): + qv[k, :, :] = 1e-3*(17.0 + zz*(16.3-17.0)/520.) + elif(zz < 1480): + qv[k, :, :] = 1.e-3*(16.3 + (zz-520.)*(10.7-16.3)/(1480.-520.)) + elif(zz < 2000): + qv[k, :, :] = 1.e-3*(10.7 + (zz-1480.)*(4.2-10.7)/(2000.-1480.)) + else: + qv[k, :, :] = 1.e-3*(4.2 + (zz-2000.)*(3.-4.2)/(3000.-2000.)) + + if(zz > 699.): + yvort[k, :, :] = 0.5*(-4.61+8.75)/(3000.-700.) + if(zz > 701.): + yvort[k, :, :] = (-4.61+8.75)/(3000.-700.) + + # add perturbation + rng = np.random.default_rng(seed=42) + noise = rng.uniform(low=-0.05, high=0.05, size=(nz+1, ny, nx)) + theta += noise + + # write all provided fields + ncf.add_field('x_vorticity', novort, unit='1/s') + ncf.add_field('y_vorticity', yvort, unit='1/s') + ncf.add_field('z_vorticity', novort, unit='1/s') + ncf.add_field('theta', theta, unit='K', long_name='potential temperature') + ncf.add_field('qv', qv, unit='kg/kg', long_name='water vapour spec. hum.') + + ncf.add_box(origin, extent, [nx, ny, nz]) + + ncf.close() + + # + # Setup surface fluxes: + # + + ncf_flux = nc_fields() + + ncf_flux.set_dim_names(['x', 'y']) + + ncf_flux.open('bomex_flux_' + str(nx) + 'x' + str(ny) + '.nc') + + # domain origin + origin = (-1.0 * L, -1.0 * L) + + # domain extent + extent = (2.0 * L, 2.0 * L) + + + # mesh spacings + dx = extent[0] / nx + dy = extent[1] / ny + + thetaflux = np.ones((ny, nx))*thetafluxmag + qvflux = np.ones((ny, nx))*qvfluxmag + + ncf_flux.add_field('thetaflux', thetaflux, unit='K m/s') + ncf_flux.add_field('qvflux', qvflux, unit='kg/kg m/s') + + ncf_flux.add_box(origin, extent, [nx, ny]) + + ncf_flux.close() + +except Exception as err: + print(err) + diff --git a/src/3d/epic3d.f90 b/src/3d/epic3d.f90 index 714c73bca..1b3d672aa 100644 --- a/src/3d/epic3d.f90 +++ b/src/3d/epic3d.f90 @@ -122,7 +122,7 @@ subroutine run print "(a15, f0.4)", "time: ", t endif #endif - call apply_vortcor + !call apply_vortcor call ls_rk4_step(t) diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index 01fe1566a..a65145e9a 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -617,8 +617,9 @@ subroutine saturation_adjustment double precision, parameter :: qsa2 = -17.2693882 ! Constant in qsat equation double precision, parameter :: qsa3 = 35.86 ! Constant in qsat equation double precision, parameter :: qsa4 = 6.109 ! Constant in qsat equation - double precision, parameter :: pressure_scale_height = 8000.0 ! Constant in qsat equation - double precision, parameter :: ref_press = 100000.0 + double precision, parameter :: pressure_scale_height = 8500.0 + double precision, parameter :: surf_press = 101500.0 + double precision, parameter :: ref_press = 100000.0 double precision :: press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat integer :: n, iter @@ -626,7 +627,7 @@ subroutine saturation_adjustment !$omp parallel default(shared) !$omp do private(n, iter, press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat) do n = 1, n_parcels - press=ref_press*exp(-parcels%position(3, n)/pressure_scale_height) + press=surf_press*exp(-parcels%position(3, n)/pressure_scale_height) exn=(press/ref_press)**(r_d/c_p) temp=parcels%theta(n)*exn temp_start=temp @@ -634,7 +635,7 @@ subroutine saturation_adjustment qt_start=ql_start+parcels%qv(n) ! Test unsaturated case first temp_low=temp-(L_v/c_p)*ql_start - qsat_low = qsa1/(press*exp(qsa2*(temp_low - tk0c)/(temp_low - qsa3)) - qsa4) + qsat_low = qsa1/(0.01*press*exp(qsa2*(temp_low - tk0c)/(temp_low - qsa3)) - qsa4) if(qt_start < qsat_low) then ! Evaporate everything, if needed at all if(ql_start>0.) then parcels%theta(n)=parcels%theta(n)-(L_v/(c_p*exn))*ql_start @@ -644,11 +645,11 @@ subroutine saturation_adjustment ! Moist case: iterate a few times, start from temp instead of temp_low else do iter=1,4 - qsat=qsa1/(press*exp(qsa2*(temp - tk0c)/(temp - qsa3)) - qsa4) + qsat=qsa1/(0.01*press*exp(qsa2*(temp - tk0c)/(temp - qsa3)) - qsa4) ql_iter=max(qt_start-qsat,0.0) temp=temp_start-(L_v/c_p)*(ql_start-ql_iter) enddo - qsat=qsa1/(press*exp(qsa2*(temp - tk0c)/(temp - qsa3)) - qsa4) + qsat=qsa1/(0.01*press*exp(qsa2*(temp - tk0c)/(temp - qsa3)) - qsa4) ql_iter=max(qt_start-qsat,0.0) parcels%theta(n)=parcels%theta(n)-(L_v/(c_p*exn))*(ql_start-ql_iter) parcels%qv(n)=qt_start-ql_iter From 41c80a94742e508d0f0cd8fd9ac78be50d8e4fb5 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Sat, 13 May 2023 19:53:59 +0100 Subject: [PATCH 13/34] Fix to parcel correction --- src/3d/epic3d.f90 | 2 +- src/3d/parcels/parcel_correction.f90 | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/3d/epic3d.f90 b/src/3d/epic3d.f90 index 1b3d672aa..714c73bca 100644 --- a/src/3d/epic3d.f90 +++ b/src/3d/epic3d.f90 @@ -122,7 +122,7 @@ subroutine run print "(a15, f0.4)", "time: ", t endif #endif - !call apply_vortcor + call apply_vortcor call ls_rk4_step(t) diff --git a/src/3d/parcels/parcel_correction.f90 b/src/3d/parcels/parcel_correction.f90 index a2cac6676..5f3cebf4f 100644 --- a/src/3d/parcels/parcel_correction.f90 +++ b/src/3d/parcels/parcel_correction.f90 @@ -91,7 +91,7 @@ subroutine apply_vortcor call start_timer(vort_corr_timer) vsum = zero - dvor = - vor_bar + dvor = zero !$omp parallel default(shared) !$omp do private(n) reduction(+: dvor, vsum) @@ -121,7 +121,7 @@ subroutine apply_vortcor !$omp parallel default(shared) !$omp do private(n) do n = 1, n_parcels - parcels%vorticity(:, n) = parcels%vorticity(:, n) - dvor + parcels%vorticity(:, n) = parcels%vorticity(:, n) - (dvor - vor_bar) enddo !$omp end do !$omp end parallel From f8c16b94b98ecdde31ad3a91c591f47c792346d0 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Sun, 30 Jul 2023 16:59:54 +0100 Subject: [PATCH 14/34] Cleanup --- src/3d/parcels/parcel_container.f90 | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/3d/parcels/parcel_container.f90 b/src/3d/parcels/parcel_container.f90 index cd51025b4..4e4ae38b7 100644 --- a/src/3d/parcels/parcel_container.f90 +++ b/src/3d/parcels/parcel_container.f90 @@ -281,9 +281,10 @@ subroutine parcel_resize(new_size) call resize_array(parcels%vorticity, new_size, n_parcels) call resize_array(parcels%B, new_size, n_parcels) call resize_array(parcels%volume, new_size, n_parcels) - call resize_array(parcels%buoyancy, new_size, n_parcels) + call resize_array(parcels%theta, new_size, n_parcels) #ifndef ENABLE_DRY_MODE - call resize_array(parcels%humidity, new_size, n_parcels) + call resize_array(parcels%qv, new_size, n_parcels) + call resize_array(parcels%ql, new_size, n_parcels) #endif call parcel_ellipsoid_resize(new_size, n_parcels) From 3314ea951cbc49cab1168f606841e65bcaa11775 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Sun, 30 Jul 2023 17:03:26 +0100 Subject: [PATCH 15/34] Fix mistake in random merge test --- mpi-tests/test_parcel_split_random.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mpi-tests/test_parcel_split_random.f90 b/mpi-tests/test_parcel_split_random.f90 index 5d5f7e36f..ddf8552a5 100644 --- a/mpi-tests/test_parcel_split_random.f90 +++ b/mpi-tests/test_parcel_split_random.f90 @@ -87,7 +87,7 @@ program test_parcel_split_random if (rn(3) > 0.5d0) then call random_number(rn(3)) j = nint(n_parcels * rn(3)) + 1 - parcels%volume(j) = 1.1d0 * vmax + parcels%B(1, j) = 5.0d0 * parcels%B(1, j) parcels%theta(j) = 1.0d0 endif From d6e9e693a0dea3c20384840d16a2559ca6385c00 Mon Sep 17 00:00:00 2001 From: Matthias Frey Date: Mon, 31 Jul 2023 15:25:37 +0100 Subject: [PATCH 16/34] adjust amax --- src/3d/utils/parameters.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/3d/utils/parameters.f90 b/src/3d/utils/parameters.f90 index da55eec0c..f1c0a1004 100644 --- a/src/3d/utils/parameters.f90 +++ b/src/3d/utils/parameters.f90 @@ -145,7 +145,7 @@ subroutine update_parameters vmin = vcell / parcel%min_vratio - amax = minval(dx) + amax = (f34 * fpi) ** f13 * minval(dx) max_num_parcels = int(box%halo_ncell * parcel%min_vratio * parcel%size_factor) From 9c0c0080a00be1862b25df9b60c3f057db11674b Mon Sep 17 00:00:00 2001 From: sjboeing Date: Tue, 1 Aug 2023 08:27:04 +0100 Subject: [PATCH 17/34] Replace remaining binc --- src/3d/boundary_layer/bndry_fluxes.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/3d/boundary_layer/bndry_fluxes.f90 b/src/3d/boundary_layer/bndry_fluxes.f90 index 6a441e8d4..ae32c92b4 100644 --- a/src/3d/boundary_layer/bndry_fluxes.f90 +++ b/src/3d/boundary_layer/bndry_fluxes.f90 @@ -187,8 +187,8 @@ subroutine bndry_fluxes_time_step(dt) return endif - ! local maximum of absolute value (units: m/s**3) - abs_max = maxval(dabs(binc(box%lo(2):box%hi(2), box%lo(1):box%hi(1)))) + ! local maximum of absolute value + abs_max = maxval(dabs(thetaflux(box%lo(2):box%hi(2), box%lo(1):box%hi(1)))) ! get global abs_max call MPI_Allreduce(MPI_IN_PLACE, & From 9a6b5ebdc7da43c7a89fe500bd2751c36e11da7d Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Tue, 15 Aug 2023 17:35:56 +0100 Subject: [PATCH 18/34] BOMEX changes --- python-scripts/bomex_fluxes.py | 104 +++++++------ src/3d/parcels/parcel_ls_forcing.f90 | 214 +++++++++++++++++++++++++++ 2 files changed, 272 insertions(+), 46 deletions(-) create mode 100644 src/3d/parcels/parcel_ls_forcing.f90 diff --git a/python-scripts/bomex_fluxes.py b/python-scripts/bomex_fluxes.py index e633fe1e2..289c00a4c 100644 --- a/python-scripts/bomex_fluxes.py +++ b/python-scripts/bomex_fluxes.py @@ -4,9 +4,7 @@ import argparse try: - parser = argparse.ArgumentParser( - description="Create surface flux setup" - ) + parser = argparse.ArgumentParser(description="Create surface flux setup") parser.add_argument( "--nx", @@ -42,8 +40,8 @@ args = parser.parse_args() - thetafluxmag=8.0e-3 - qvfluxmag=5.2e-5 + thetafluxmag = 8.0e-3 + qvfluxmag = 5.2e-5 # number of cells nx = args.nx @@ -54,7 +52,7 @@ ncf = nc_fields() - ncf.open('bomex_setup' + str(nx) + 'x' + str(ny) + 'x' + str(nz) + '.nc') + ncf.open("bomex_setup" + str(nx) + "x" + str(ny) + "x" + str(nz) + ".nc") # domain origin origin = (-1.0 * L, -1.0 * L, 0.0) @@ -62,55 +60,71 @@ # domain extent extent = (2.0 * L, 2.0 * L, L) - # mesh spacings dx = extent[0] / nx dy = extent[1] / ny dz = extent[2] / nz - theta = np.zeros((nz+1, ny, nx)) - qv = np.zeros((nz+1, ny, nx)) - yvort = np.zeros((nz+1, ny, nx)) - novort = np.zeros((nz+1, ny, nx)) - + theta = np.zeros((nz + 1, ny, nx)) + qv = np.zeros((nz + 1, ny, nx)) + yvort = np.zeros((nz + 1, ny, nx)) + xvort = np.zeros((nz + 1, ny, nx)) + novort = np.zeros((nz + 1, ny, nx)) + # ranges from 0 to nz - for k in range(nz+1): + for k in range(nz + 1): zz = k * dz - if(zz < 520.): - theta[k, :,: ] = 298.7 - elif(zz < 1480): - theta[k, :, :] = 298.7 + (zz-520.)*(302.4-298.7)/(1480.-520.) - elif(zz < 2000): - theta[k, :, :] = 302.4 + (zz-1480.)*(308.2-302.4)/(2000.-1480.) + if zz < 520.0: + theta[k, :, :] = 298.7 + elif zz < 1480: + theta[k, :, :] = 298.7 + (zz - 520.0) * (302.4 - 298.7) / (1480.0 - 520.0) + elif zz < 2000: + theta[k, :, :] = 302.4 + (zz - 1480.0) * (308.2 - 302.4) / (2000.0 - 1480.0) else: - theta[k, :, :] = 308.2 + (zz-2000.)*(311.85-308.2)/(3000.-2000.) + theta[k, :, :] = 308.2 + (zz - 2000.0) * (311.85 - 308.2) / ( + 3000.0 - 2000.0 + ) # specific humidity - if(zz < 520.): - qv[k, :, :] = 1e-3*(17.0 + zz*(16.3-17.0)/520.) - elif(zz < 1480): - qv[k, :, :] = 1.e-3*(16.3 + (zz-520.)*(10.7-16.3)/(1480.-520.)) - elif(zz < 2000): - qv[k, :, :] = 1.e-3*(10.7 + (zz-1480.)*(4.2-10.7)/(2000.-1480.)) + if zz < 520.0: + qv[k, :, :] = 1e-3 * (17.0 + zz * (16.3 - 17.0) / 520.0) + elif zz < 1480: + qv[k, :, :] = 1.0e-3 * ( + 16.3 + (zz - 520.0) * (10.7 - 16.3) / (1480.0 - 520.0) + ) + elif zz < 2000: + qv[k, :, :] = 1.0e-3 * ( + 10.7 + (zz - 1480.0) * (4.2 - 10.7) / (2000.0 - 1480.0) + ) else: - qv[k, :, :] = 1.e-3*(4.2 + (zz-2000.)*(3.-4.2)/(3000.-2000.)) - - if(zz > 699.): - yvort[k, :, :] = 0.5*(-4.61+8.75)/(3000.-700.) - if(zz > 701.): - yvort[k, :, :] = (-4.61+8.75)/(3000.-700.) + qv[k, :, :] = 1.0e-3 * ( + 4.2 + (zz - 2000.0) * (3.0 - 4.2) / (3000.0 - 2000.0) + ) + + if zz < 300.0: + xvort[k, :, :] = 0.0043 * np.cos(np.pi * (zz + 600) / 1200.0) + 0.0023 + yvort[k, :, :] = 0.0062 * np.cos((np.pi * (zz - 300) / 600.0) ** 2) - 0.0067 + elif zz < 600.0: + xvort[k, :, :] = 0.0043 * np.cos(np.pi * (zz + 600) / 1200.0) + 0.0023 + yvort[k, :, :] = 0.0027 * np.cos(np.pi * (zz - 300) / 600.0) - 0.0032 + elif zz < 1400.0: + xvort[k, :, :] = -0.001 - 0.001 * np.cos(np.pi * (zz - 600.0) / 800.0) + yvort[k, :, :] = 0.005 * np.cos(np.pi * (zz - 1400.0) / 1600.0) - 0.0032 + else: + xvort[k, :, :] = 0.0 + yvort[k, :, :] = 0.0018 # add perturbation rng = np.random.default_rng(seed=42) - noise = rng.uniform(low=-0.05, high=0.05, size=(nz+1, ny, nx)) + noise = rng.uniform(low=-0.05, high=0.05, size=(nz + 1, ny, nx)) theta += noise # write all provided fields - ncf.add_field('x_vorticity', novort, unit='1/s') - ncf.add_field('y_vorticity', yvort, unit='1/s') - ncf.add_field('z_vorticity', novort, unit='1/s') - ncf.add_field('theta', theta, unit='K', long_name='potential temperature') - ncf.add_field('qv', qv, unit='kg/kg', long_name='water vapour spec. hum.') + ncf.add_field("x_vorticity", xvort, unit="1/s") + ncf.add_field("y_vorticity", yvort, unit="1/s") + ncf.add_field("z_vorticity", novort, unit="1/s") + ncf.add_field("theta", theta, unit="K", long_name="potential temperature") + ncf.add_field("qv", qv, unit="kg/kg", long_name="water vapour spec. hum.") ncf.add_box(origin, extent, [nx, ny, nz]) @@ -122,9 +136,9 @@ ncf_flux = nc_fields() - ncf_flux.set_dim_names(['x', 'y']) + ncf_flux.set_dim_names(["x", "y"]) - ncf_flux.open('bomex_flux_' + str(nx) + 'x' + str(ny) + '.nc') + ncf_flux.open("bomex_flux_" + str(nx) + "x" + str(ny) + ".nc") # domain origin origin = (-1.0 * L, -1.0 * L) @@ -132,16 +146,15 @@ # domain extent extent = (2.0 * L, 2.0 * L) - # mesh spacings dx = extent[0] / nx dy = extent[1] / ny - thetaflux = np.ones((ny, nx))*thetafluxmag - qvflux = np.ones((ny, nx))*qvfluxmag + thetaflux = np.ones((ny, nx)) * thetafluxmag + qvflux = np.ones((ny, nx)) * qvfluxmag - ncf_flux.add_field('thetaflux', thetaflux, unit='K m/s') - ncf_flux.add_field('qvflux', qvflux, unit='kg/kg m/s') + ncf_flux.add_field("thetaflux", thetaflux, unit="K m/s") + ncf_flux.add_field("qvflux", qvflux, unit="kg/kg m/s") ncf_flux.add_box(origin, extent, [nx, ny]) @@ -149,4 +162,3 @@ except Exception as err: print(err) - diff --git a/src/3d/parcels/parcel_ls_forcing.f90 b/src/3d/parcels/parcel_ls_forcing.f90 new file mode 100644 index 000000000..44f3ce58c --- /dev/null +++ b/src/3d/parcels/parcel_ls_forcing.f90 @@ -0,0 +1,214 @@ +! ============================================================================= +! This module contains the subroutines to do parcel-to-grid and grid-to-parcel +! interpolation. +! ============================================================================= +module parcel_ls_forcing + use constants, only : zero, one, pi + use mpi_timer, only : start_timer, stop_timer + use options, only : parcel + use parameters, only : nz, dxi + use parcel_container, only : parcels, n_parcels + use parcel_ellipsoid + use fields + use omp_lib + use mpi_utils, only : mpi_exit_on_error + use parcel_interpl, only : saturation_adjustment, par2grid_diag, trilinear + + implicit none + + private + + contains + + subroutine ls_tendencies(dt) + double precision, intent(in) :: dt + call apply_subsidence_and_vorticity_adjustment(dt) + call apply_ls_tendencies(dt) + call saturation adjustment + end subroutine ls_tendencies + ! + ! @pre + subroutine apply_subsidence_and_vorticity_adjustment(dt) + double precision, intent(in) :: dt + double precision :: weights(0:1,0:1,0:1) + double precision :: xf, yf, zf, xfc, yfc, zfc + double precision :: thetagradz, qcgradz, qlgradz, ww + integer :: n, nc, is, js, ks + double precision :: xvortbar(0:nz), yvortbar(0:nz) + + ! use par2grid_diag theta + ! use par2grid_diag ql+qv + ! to be replaced by special par2grid? + call par2grid_diag(.false.) + + ! code to apply subsidence, use local gradients + + !$omp parallel default(shared) + !$omp do private(n, is, js, ks, weights, xf, yf, zf, xfc, yfc, zfc, thetagradz, qvgradz, qlgradz, ww) + do n = 1, n_parcels + + call trilinear(parcels%position(:, n), is, js, ks, weights) + + xf = weights(0,0,1) + weights(0,1,1) + weights(1,0,1) + weights(1,1,1) ! fractional position along x + yf = weights(0,1,0) + weights(0,1,1) + weights(1,1,0) + weights(1,1,1) ! fractional position along y + zf = weights(1,0,0) + weights(1,0,1) + weights(1,1,0) + weights(1,1,1) ! fractional position along z + xfc=one-xf + yfc=one-yf + zfc=one-zf + + thetagradz = dxi(3)*(& + xfc * (& + yfc * (thetag(ks+1, js, is ) - thetag(ks, js, is)) & + + yf * (thetag(ks+1, js+1, is) - thetag(ks, js+1, is))) & + + xf * (& + yfc * (thetag(ks+1, js, is+1) - thetag(ks, js, is+1)) & + + yf * (thetag(ks+1, js+1, is+1) - thetag(ks, js+1, is+1)))) + + qvgradz = dxi(3)*(& + xfc * (& + yfc * (qvg(ks+1, js, is ) - qvg(ks, js, is)) & + + yf * (qvg(ks+1, js+1, is) - qvg(ks, js+1, is))) & + + xf * (& + yfc * (qvg(ks+1, js, is+1) - qvg(ks, js, is+1)) & + + yf * (qvg(ks+1, js+1, is+1) - qvg(ks, js+1, is+1)))) + + qlgradz = dxi(3)*(& + xfc * (& + yfc * (qlg(ks+1, js, is ) - qlg(ks, js, is)) & + + yf * (qlg(ks+1, js+1, is) - qlg(ks, js+1, is))) & + + xf * (& + yfc * (qlg(ks+1, js, is+1) - qlg(ks, js, is+1)) & + + yf * (qlg(ks+1, js+1, is+1) - qlg(ks, js+1, is+1)))) + + ww=get_bomex_subsidence_velocity(parcels%position(3, n)) + + parcels%theta(n) = parcels%theta(n)-ww*thetagradz + parcels%qv(n) = parcels%qv(n)-ww*qvgradz-ww*qlgradz + enddo + !$omp end do + !$omp end parallel + + ! code to apply vorticity adjustment + do nc = 1, 2 + call field_decompose_physical(vortg(:, :, :, nc), svor(:, :, :, nc)) + enddo + + ! ubar and vbar are used here to store the mean x and y components of the vorticity + ! may need a correction factor + if ((box%lo(1) == 0) .and. (box%lo(2) == 0)) then + xvortbar = svor(:, 0, 0, 1) + yvortbar = svor(:, 0, 0, 2) + endif + + !$omp parallel default(shared)parcels%position(:, n) + !$omp do private(n, is, js, ks, weights, zf, zfc) + do n = 1, n_parcels + + call trilinear(parcels%position(:, n), is, js, ks, weights) + + zf = weights(1,0,0) + weights(1,0,1) + weights(1,1,0) + weights(1,1,1) ! fractional position along z + zfc= one-zf + + parcels%vorticity(1, n) = parcels%vorticity(1, n) - zfc*xvortbar(ks) - zf*xvortbar(ks+1) + get_bomex_xvort(parcels%position(3, n)) + parcels%vorticity(2, n) = parcels%vorticity(2, n) - zfc*yvortbar(ks) - zf*yvortbar(ks+1) + get_bomex_yvort(parcels%position(3, n)) + enddo + !$omp end do + !$omp end parallel + + end subroutine apply_subsidence_and_vorticity_adjustment + + ! + ! @pre + subroutine apply_ls_tendencies + double precision, intent(in) :: dt + + !$omp parallel default(shared)parcels%position(:, n) + !$omp do private(n,) + do n = 1, n_parcels + parcels%theta(n) = parcels%theta(n) + get_bomex_theta_ls(parcels%position(3, n))*dt + parcels%qv(n) = parcels%qv(n) + get_bomex_qt_ls(parcels%position(3, n))*dt + enddo + !$omp end do + !$omp end parallel + + end subroutine apply_ls_tendencies + ! + ! @pre + pure function get_bomex_subsidence_velocity(zz): + if (zz < 1500.0) then + ww = zz*(-0.0065)/1500.0 + else if (z[k] < 2100.0) then + ww = -0.0065 + (zz-1500.0)*(0.0065)/(2100.0-1500.0) + else + ww = 0.0 + endif + return ww + end function get_bomex_subsidence_velocity + + ! + ! @pre + pure function get_bomex_theta_ls(zz) + double precision, intent(in) :: zz + double precision, intent(out) :: theta_ls + double precision, parameter :: iday=1./86400. + + if (zz < 1500.0) then + theta_ls = -2.0*iday + else + theta_ls = (-2.0 + (zz-1500.0)*(2.0/(3000.0-1500.0)))*iday + endif + return theta_ls + end function get_bomex_theta_ls + + ! + ! @pre + elemental function get_bomex_qt_ls(zz) result qt_ls + double precision, intent(in) :: zz + double precision, intent(out) :: qt_ls + + if(zz <= 300.0) then + qt_ls = -1.2e-8 + else if(zz <= 500.0) then + qt_ls = -1.2e-8 + (zz-300.)*(1.2e-8)/(500.0-300.0) + else + qt_ls = 0.0 + endif + return qt_ls + end function get_bomex_qt_ls + + ! + ! @pre + elemental function get_bomex_xvort(zz) result xvort + double precision, intent(in) :: zz + double precision, intent(out) :: xvort + + if (zz<300.0) then + xvort=0.0043*cos(pi*(zz+600)/1200.0)+0.0023 + else if (zz<600.0) then + xvort=0.0043*cos(pi*(zz+600)/1200.0)+0.0023 + else if (zz<1400.0) then + xvort=-0.001-0.001*cos(pi*(zz-600)/800.0) + else + xvort=0.0 + end if + + end function get_bomex_xvort + + ! @pre + elemental function get_bomex_yvort(zz) result yvort + double precision, intent(in) :: zz + double precision, intent(out) :: yvort + + if(zz<300.0) then + yvort=0.0062*cos((pi*(zz-300.0)/600.0)**2)-0.0067 + else if (zz<600.0) then + yvort=0.0027*cos(pi*(zz-300.0)/600.0)-0.0032 + else if (zz<1400.0) then + yvort=0.005*cos(pi*(zz-1400.0)/1600.0)-0.0032 + else + yvort=0.0018 + end if + + end subroutine get_bomex_yvort + +end module parcel_ls_forcing From b3d7abb0b8b4baea4dbe29f55ecadf4d46ad02d5 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Wed, 16 Aug 2023 12:45:28 +0100 Subject: [PATCH 19/34] Work in progress on ls forcings --- src/3d/Makefile.am | 1 + src/3d/boundary_layer/bndry_fluxes.f90 | 3 +- src/3d/parcels/parcel_interpl.f90 | 1 + ..._ls_forcing.f90 => parcel_ls_forcings.f90} | 133 +++++++++++------- src/3d/stepper/ls_rk.f90 | 3 + 5 files changed, 89 insertions(+), 52 deletions(-) rename src/3d/parcels/{parcel_ls_forcing.f90 => parcel_ls_forcings.f90} (63%) diff --git a/src/3d/Makefile.am b/src/3d/Makefile.am index 9a7207bfc..88c480b0b 100644 --- a/src/3d/Makefile.am +++ b/src/3d/Makefile.am @@ -29,6 +29,7 @@ epic3d_SOURCES = \ inversion/inversion_utils.f90 \ inversion/inversion.f90 \ parcels/parcel_correction.f90 \ + parcels/parcel_ls_forcings.f90 \ parcels/parcel_netcdf.f90 \ parcels/parcel_diagnostics_netcdf.f90 \ boundary_layer/bndry_fluxes.f90 \ diff --git a/src/3d/boundary_layer/bndry_fluxes.f90 b/src/3d/boundary_layer/bndry_fluxes.f90 index 6a441e8d4..9546daf73 100644 --- a/src/3d/boundary_layer/bndry_fluxes.f90 +++ b/src/3d/boundary_layer/bndry_fluxes.f90 @@ -9,6 +9,7 @@ module bndry_fluxes use parcel_container, only : n_parcels, parcels use netcdf_reader use omp_lib + use physics, only : gravity, theta_0 use options, only : time use mpi_utils, only : mpi_stop use field_mpi, only : field_mpi_alloc & @@ -188,7 +189,7 @@ subroutine bndry_fluxes_time_step(dt) endif ! local maximum of absolute value (units: m/s**3) - abs_max = maxval(dabs(binc(box%lo(2):box%hi(2), box%lo(1):box%hi(1)))) + abs_max = (gravity/theta_0)*maxval(dabs(thetaflux(box%lo(2):box%hi(2), box%lo(1):box%hi(1)))) ! get global abs_max call MPI_Allreduce(MPI_IN_PLACE, & diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index fafda3f63..e160b7b21 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -65,6 +65,7 @@ module parcel_interpl , grid2par_timer & , halo_swap_timer & , trilinear & + , saturation_adjustment & , bilinear contains diff --git a/src/3d/parcels/parcel_ls_forcing.f90 b/src/3d/parcels/parcel_ls_forcings.f90 similarity index 63% rename from src/3d/parcels/parcel_ls_forcing.f90 rename to src/3d/parcels/parcel_ls_forcings.f90 index 44f3ce58c..bf6385362 100644 --- a/src/3d/parcels/parcel_ls_forcing.f90 +++ b/src/3d/parcels/parcel_ls_forcings.f90 @@ -2,43 +2,50 @@ ! This module contains the subroutines to do parcel-to-grid and grid-to-parcel ! interpolation. ! ============================================================================= -module parcel_ls_forcing +module parcel_ls_forcings use constants, only : zero, one, pi use mpi_timer, only : start_timer, stop_timer use options, only : parcel - use parameters, only : nz, dxi + use parameters, only : nx,ny,nz, dxi, dx use parcel_container, only : parcels, n_parcels use parcel_ellipsoid use fields use omp_lib + use inversion_utils, only : field_decompose_physical use mpi_utils, only : mpi_exit_on_error - use parcel_interpl, only : saturation_adjustment, par2grid_diag, trilinear + use mpi_layout + use mpi_environment + use mpi_collectives, only : mpi_blocking_reduce + use parcel_interpl, only : saturation_adjustment, par2grid, par2grid_diag, trilinear implicit none private + public :: apply_ls_forcings + contains - subroutine ls_tendencies(dt) + subroutine apply_ls_forcings(dt) double precision, intent(in) :: dt call apply_subsidence_and_vorticity_adjustment(dt) call apply_ls_tendencies(dt) - call saturation adjustment - end subroutine ls_tendencies + call saturation_adjustment + end subroutine apply_ls_forcings ! ! @pre subroutine apply_subsidence_and_vorticity_adjustment(dt) double precision, intent(in) :: dt double precision :: weights(0:1,0:1,0:1) double precision :: xf, yf, zf, xfc, yfc, zfc - double precision :: thetagradz, qcgradz, qlgradz, ww - integer :: n, nc, is, js, ks - double precision :: xvortbar(0:nz), yvortbar(0:nz) + double precision :: thetagradz, qvgradz, qlgradz, ww + integer :: n, kk, is, js, ks + double precision :: xvortbar(0:nz), yvortbar(0:nz), nudgefac ! use par2grid_diag theta ! use par2grid_diag ql+qv ! to be replaced by special par2grid? + call par2grid(.false.) call par2grid_diag(.false.) ! code to apply subsidence, use local gradients @@ -82,35 +89,60 @@ subroutine apply_subsidence_and_vorticity_adjustment(dt) ww=get_bomex_subsidence_velocity(parcels%position(3, n)) - parcels%theta(n) = parcels%theta(n)-ww*thetagradz - parcels%qv(n) = parcels%qv(n)-ww*qvgradz-ww*qlgradz + parcels%theta(n) = parcels%theta(n)-dt*ww*thetagradz + parcels%qv(n) = parcels%qv(n)-dt*ww*(qvgradz+qlgradz) enddo !$omp end do !$omp end parallel - ! code to apply vorticity adjustment - do nc = 1, 2 - call field_decompose_physical(vortg(:, :, :, nc), svor(:, :, :, nc)) + do kk=0,nz + xvortbar(kk)= sum(vortg(kk,box%lo(2):box%hi(2),box%lo(1):box%hi(1),1)) + yvortbar(kk)= sum(vortg(kk,box%lo(2):box%hi(2),box%lo(1):box%hi(1),2)) + end do + + call MPI_Allreduce(MPI_IN_PLACE, & + xvortbar, & + nz, & + MPI_DOUBLE_PRECISION, & + MPI_SUM, & + world%comm, & + world%err) + call MPI_Allreduce(MPI_IN_PLACE, & + yvortbar, & + nz, & + MPI_DOUBLE_PRECISION, & + MPI_SUM, & + world%comm, & + world%err) + + do kk=0,nz + xvortbar(kk)= xvortbar(kk)/(nx*ny)-get_bomex_xvort(lower(3)+kk*dx(3)) + yvortbar(kk)= yvortbar(kk)/(nx*ny)-get_bomex_yvort(lower(3)+kk*dx(3)) enddo - ! ubar and vbar are used here to store the mean x and y components of the vorticity - ! may need a correction factor - if ((box%lo(1) == 0) .and. (box%lo(2) == 0)) then - xvortbar = svor(:, 0, 0, 1) - yvortbar = svor(:, 0, 0, 2) - endif + !if(cart%rank == cart%root) then + ! write(*,*) 'xvortbar' + ! write(*,*) xvortbar + ! write(*,*) 'yvortbar' + ! write(*,*) yvortbar + !end if + + + nudgefac=(1.0-exp(-dt/120.0)) - !$omp parallel default(shared)parcels%position(:, n) + !$omp parallel default(shared) !$omp do private(n, is, js, ks, weights, zf, zfc) do n = 1, n_parcels - + call trilinear(parcels%position(:, n), is, js, ks, weights) zf = weights(1,0,0) + weights(1,0,1) + weights(1,1,0) + weights(1,1,1) ! fractional position along z zfc= one-zf - parcels%vorticity(1, n) = parcels%vorticity(1, n) - zfc*xvortbar(ks) - zf*xvortbar(ks+1) + get_bomex_xvort(parcels%position(3, n)) - parcels%vorticity(2, n) = parcels%vorticity(2, n) - zfc*yvortbar(ks) - zf*yvortbar(ks+1) + get_bomex_yvort(parcels%position(3, n)) + parcels%vorticity(1, n) = parcels%vorticity(1, n) - zfc*xvortbar(ks)*nudgefac & + - zf*xvortbar(ks+1)*nudgefac + parcels%vorticity(2, n) = parcels%vorticity(2, n) - zfc*yvortbar(ks)*nudgefac & + - zf*yvortbar(ks+1)*nudgefac enddo !$omp end do !$omp end parallel @@ -119,11 +151,12 @@ end subroutine apply_subsidence_and_vorticity_adjustment ! ! @pre - subroutine apply_ls_tendencies + subroutine apply_ls_tendencies(dt) double precision, intent(in) :: dt + integer :: n - !$omp parallel default(shared)parcels%position(:, n) - !$omp do private(n,) + !$omp parallel default(shared) + !$omp do private(n) do n = 1, n_parcels parcels%theta(n) = parcels%theta(n) + get_bomex_theta_ls(parcels%position(3, n))*dt parcels%qv(n) = parcels%qv(n) + get_bomex_qt_ls(parcels%position(3, n))*dt @@ -134,22 +167,24 @@ subroutine apply_ls_tendencies end subroutine apply_ls_tendencies ! ! @pre - pure function get_bomex_subsidence_velocity(zz): - if (zz < 1500.0) then - ww = zz*(-0.0065)/1500.0 - else if (z[k] < 2100.0) then - ww = -0.0065 + (zz-1500.0)*(0.0065)/(2100.0-1500.0) - else - ww = 0.0 - endif - return ww + elemental function get_bomex_subsidence_velocity(zz) result (ww) + double precision, intent(in) :: zz + double precision :: ww + + if (zz < 1500.0) then + ww = zz*(-0.0065)/1500.0 + else if (zz < 2100.0) then + ww = -0.0065 + (zz-1500.0)*(0.0065)/(2100.0-1500.0) + else + ww = 0.0 + endif end function get_bomex_subsidence_velocity ! ! @pre - pure function get_bomex_theta_ls(zz) + elemental function get_bomex_theta_ls(zz) result (theta_ls) double precision, intent(in) :: zz - double precision, intent(out) :: theta_ls + double precision :: theta_ls double precision, parameter :: iday=1./86400. if (zz < 1500.0) then @@ -157,14 +192,13 @@ pure function get_bomex_theta_ls(zz) else theta_ls = (-2.0 + (zz-1500.0)*(2.0/(3000.0-1500.0)))*iday endif - return theta_ls end function get_bomex_theta_ls ! ! @pre - elemental function get_bomex_qt_ls(zz) result qt_ls + elemental function get_bomex_qt_ls(zz) result (qt_ls) double precision, intent(in) :: zz - double precision, intent(out) :: qt_ls + double precision :: qt_ls if(zz <= 300.0) then qt_ls = -1.2e-8 @@ -173,18 +207,15 @@ elemental function get_bomex_qt_ls(zz) result qt_ls else qt_ls = 0.0 endif - return qt_ls end function get_bomex_qt_ls ! ! @pre - elemental function get_bomex_xvort(zz) result xvort + elemental function get_bomex_xvort(zz) result (xvort) double precision, intent(in) :: zz - double precision, intent(out) :: xvort + double precision :: xvort - if (zz<300.0) then - xvort=0.0043*cos(pi*(zz+600)/1200.0)+0.0023 - else if (zz<600.0) then + if (zz<600.0) then xvort=0.0043*cos(pi*(zz+600)/1200.0)+0.0023 else if (zz<1400.0) then xvort=-0.001-0.001*cos(pi*(zz-600)/800.0) @@ -195,9 +226,9 @@ elemental function get_bomex_xvort(zz) result xvort end function get_bomex_xvort ! @pre - elemental function get_bomex_yvort(zz) result yvort + elemental function get_bomex_yvort(zz) result (yvort) double precision, intent(in) :: zz - double precision, intent(out) :: yvort + double precision :: yvort if(zz<300.0) then yvort=0.0062*cos((pi*(zz-300.0)/600.0)**2)-0.0067 @@ -209,6 +240,6 @@ elemental function get_bomex_yvort(zz) result yvort yvort=0.0018 end if - end subroutine get_bomex_yvort + end function get_bomex_yvort -end module parcel_ls_forcing +end module parcel_ls_forcings diff --git a/src/3d/stepper/ls_rk.f90 b/src/3d/stepper/ls_rk.f90 index b6e533a36..d3dc17194 100644 --- a/src/3d/stepper/ls_rk.f90 +++ b/src/3d/stepper/ls_rk.f90 @@ -11,6 +11,7 @@ module ls_rk use rk_utils, only: get_dBdt, get_time_step use utils, only : write_step use parcel_interpl, only : par2grid, grid2par + use parcel_ls_forcings, only : apply_ls_forcings use fields, only : velgradg, velog, vortg, vtend, tbuoyg use inversion_mod, only : vor2vel, vorticity_tendency use parcel_diagnostics, only : calculate_parcel_diagnostics @@ -123,6 +124,8 @@ subroutine ls_rk_step(t) call apply_parcel_reflective_bc call stop_timer(rk_timer) + call apply_ls_forcings(dt) + ! we need to subtract 14 calls since we start and stop ! the timer multiple times which increments n_calls timings(rk_timer)%n_calls = timings(rk_timer)%n_calls - (3 * n_stages - 1) From 80ea37a8c4e9a6a8ce8343449d51ef262c049d32 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Fri, 6 Oct 2023 08:23:28 +0100 Subject: [PATCH 20/34] FOMEX with damping diffusion --- epic_mean.py | 9 ++ examples/fomex.config | 37 +++++ src/3d/Makefile.am | 1 + src/3d/fields/fields.f90 | 20 +++ src/3d/parcels/parcel_damping.f90 | 255 ++++++++++++++++++++++++++++++ src/3d/stepper/ls_rk.f90 | 5 +- src/3d/stepper/rk_utils.f90 | 63 +++++++- 7 files changed, 388 insertions(+), 2 deletions(-) create mode 100644 epic_mean.py create mode 100755 examples/fomex.config create mode 100644 src/3d/parcels/parcel_damping.f90 diff --git a/epic_mean.py b/epic_mean.py new file mode 100644 index 000000000..b0eec659e --- /dev/null +++ b/epic_mean.py @@ -0,0 +1,9 @@ +from pylab import * +import xarray as xr + +ds=xr.open_dataset('fomex_fields.nc') +ds['mfcup']=ds['z_velocity']*(ds['z_velocity']>0.)*(ds['ql']>1e-8) +ds_mean=ds.mean(dim=["x", "y"]) +ds_mean.to_netcdf('fomex_mean.nc') +mfmean=ds_mean['mfcup'][-15:-1].mean(dim="t") +mfmean.to_netcdf('fomex_mfmean.nc') diff --git a/examples/fomex.config b/examples/fomex.config new file mode 100755 index 000000000..ff20b6127 --- /dev/null +++ b/examples/fomex.config @@ -0,0 +1,37 @@ +``` +&EPIC + + field_file = 'bomex_setup192x192x96.nc' ! input field file + flux_file = 'bomex_flux_192x192.nc' ! input field file + + ! + ! output info + ! + output%field_freq = 300 ![s] write after these many seconds to the field NetCDF file + output%parcel_freq = 3600 ![s] write after these many seconds to the parcel NetCDF file + output%parcel_stats_freq = 100 ![s] write after these many seconds to parcel stats NetCDF file + output%field_stats_freq = 100 ![s] write after these many seconds to the field stats NetCDF file + output%write_fields = .true. ! enable / disable field dump + output%write_parcels = .true. ! enable / disable parcel dump + output%write_parcel_stats = .true. ! enable / disable parcel statistics + output%write_field_stats = .true. ! enable / disable field statistics + output%overwrite = .true. ! replace existing NetCDF files + output%basename = 'fomex' ! NetCDF output base name + + ! + ! parcel info + ! + parcel%n_per_cell = 8 ! initial number of parcels per cell + parcel%lambda_max = 4.0 ! maximum parcel aspect ratio + parcel%min_vratio = 20.0 ! minimum ratio of grid cell volume / parcel volume + parcel%correction_iters = 2 ! how many parcel correction iterations + parcel%gradient_pref = 1.8 ! gradient correction prefactor + parcel%max_compression = 0.5 ! gradient correction maximum compression + + ! + ! stepper info + ! + time%limit = 21600.0 ! time limit (s) + time%alpha = 0.2 ! scaling factor for the strain and buoyancy gradient time step + time%precise_stop = .false. ! time limit exact +/ diff --git a/src/3d/Makefile.am b/src/3d/Makefile.am index 88c480b0b..81f2c55b3 100644 --- a/src/3d/Makefile.am +++ b/src/3d/Makefile.am @@ -23,6 +23,7 @@ epic3d_SOURCES = \ parcels/parcel_diagnostics.f90 \ parcels/parcel_interpl.f90 \ parcels/parcel_init.f90 \ + parcels/parcel_damping.f90 \ fields/field_diagnostics.f90 \ fields/field_netcdf.f90 \ fields/field_diagnostics_netcdf.f90 \ diff --git a/src/3d/fields/fields.f90 b/src/3d/fields/fields.f90 index 5d2d1d4b0..bc2abe1bb 100644 --- a/src/3d/fields/fields.f90 +++ b/src/3d/fields/fields.f90 @@ -21,6 +21,7 @@ module fields double precision, allocatable, dimension(:, :, :, :) :: & velog, & ! velocity vector field (u, v, w) vortg, & ! vorticity vector field (\xi, \eta, \zeta) + vortpg, & ! vorticity pertubation tendency vtend, & ! vorticity tendency velgradg ! velocity gradient tensor ! ordering: du/dx, du/dy, @@ -38,12 +39,16 @@ module fields #ifndef ENABLE_DRY_MODE qvg, & ! humidity qlg, & ! liquid water + qvpg, & ! humidity perturbation tendency + qlpg, & ! liquid water perturbation tendency #endif thetag, & ! dry buoyancy (or liquid-water buoyancy) + thetapg, & ! theta perturbation tendency tbuoyg, & ! buoyancy #ifndef NDEBUG sym_volg, & ! symmetry volume (debug mode only) #endif + strain_mag, & ! strain magnitude volg ! volume scalar field integer, allocatable, dimension(:, :, :) :: & @@ -77,6 +82,7 @@ subroutine field_alloc allocate(velog(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1), n_dim)) allocate(velgradg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1), 5)) + allocate(strain_mag(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) allocate(volg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) #ifndef NDEBUG @@ -84,14 +90,18 @@ subroutine field_alloc #endif allocate(vortg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1), n_dim)) + allocate(vortpg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1), n_dim)) allocate(vtend(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1), n_dim)) allocate(tbuoyg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) allocate(thetag(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) + allocate(thetapg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) #ifndef ENABLE_DRY_MODE allocate(qvg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) allocate(qlg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) + allocate(qvpg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) + allocate(qlpg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) #endif allocate(nparg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) @@ -108,13 +118,18 @@ subroutine field_default velog = zero velgradg = zero volg = zero + strain_mag = zero vortg = zero + vortpg = zero vtend = zero tbuoyg = zero + thetapg = zero thetag = zero #ifndef ENABLE_DRY_MODE qvg = zero qlg = zero + qvpg = zero + qlpg = zero #endif nparg = zero nsparg = zero @@ -131,14 +146,19 @@ subroutine field_dealloc if (allocated(velog)) then deallocate(velog) deallocate(velgradg) + deallocate(strain_mag) deallocate(volg) + deallocate(vortpg) deallocate(vortg) deallocate(vtend) deallocate(tbuoyg) + deallocate(thetapg) deallocate(thetag) #ifndef ENABLE_DRY_MODE deallocate(qvg) deallocate(qlg) + deallocate(qvpg) + deallocate(qlpg) #endif deallocate(nparg) deallocate(nsparg) diff --git a/src/3d/parcels/parcel_damping.f90 b/src/3d/parcels/parcel_damping.f90 new file mode 100644 index 000000000..0ba074452 --- /dev/null +++ b/src/3d/parcels/parcel_damping.f90 @@ -0,0 +1,255 @@ +! ============================================================================= +! This module contains the subroutines to do parcel-to-grid and grid-to-parcel +! interpolation. +! ============================================================================= +module parcel_damping + use constants, only : zero, one, two, f14 + use mpi_timer, only : start_timer, stop_timer + use parameters, only : nx, nz, vmin, l_bndry_zeta_zero + use options, only : parcel + use parcel_container, only : parcels, n_parcels + use parcel_bc, only : apply_periodic_bc + use parcel_ellipsoid + use parcel_interpl + use fields + use field_mpi, only : field_mpi_alloc & + , field_mpi_dealloc & + , field_buffer_to_halo & + , field_halo_to_buffer & + , field_buffer_to_interior & + , field_interior_to_buffer & + , interior_to_halo_communication & + , halo_to_interior_communication & + , field_halo_swap_scalar + use physics, only : glat, lambda_c, q_0 + use omp_lib + use mpi_utils, only : mpi_exit_on_error + implicit none + + private + + ! interpolation indices + ! (first dimension x, y, z; second dimension l-th index) + integer :: is, js, ks + + ! interpolation weights + double precision :: weights(0:1,0:1,0:1) + double precision :: weight(0:1,0:1,0:1) + + integer, parameter :: IDX_VOL_SWAP = 1 & + , IDX_VORP_X_SWAP = 2 & + , IDX_VORP_Y_SWAP = 3 & + , IDX_VORP_Z_SWAP = 4 & + , IDX_THETAP_SWAP = 5 +#ifndef ENABLE_DRY_MODE + integer, parameter :: IDX_QVP_SWAP = 6 + integer, parameter :: IDX_QLP_SWAP = 7 + + integer, parameter :: n_field_swap = 7 +#else + integer, parameter :: n_field_swap = 5 +#endif + + public :: parcel_damp + + contains + + subroutine parcel_damp(dt) + double precision, intent(in) :: dt + call par2grid(.false.) + call perturbation_damping(dt) + end subroutine parcel_damp + + ! + ! @pre + subroutine perturbation_damping(dt) + double precision, intent(in) :: dt + integer :: n, l + double precision :: parcel_strain_mag + double precision :: parcel_vortp(3) + double precision :: parcel_qvp + double precision :: parcel_qlp + double precision :: parcel_thetap + double precision :: reduce_fact + double precision, parameter :: pre_fact=1.85 + + !call start_timer(grid2par_timer) + + vortpg=zero +#ifndef ENABLE_DRY_MODE + qvpg=zero + qlpg=zero +#endif + thetapg=zero + volg=zero + + !$omp parallel default(shared) + !$omp do private(n, l, is, js, ks, weight, weights, reduce_fact, parcel_strain_mag) & +#ifndef ENABLE_DRY_MODE + !$omp& private(parcel_vortp, parcel_qvp, parcel_qlp, parcel_thetap)& + !$omp& reduction(+: vortpg, qvpg, qlpg, thetapg, volg) +#else + !$omp& private(parcel_vortp, parcel_thetap)& + !$omp& reduction(+: vortpg, thetapg, volg) +#endif + + do n = 1, n_parcels + + ! get interpolation weights and mesh indices + call trilinear(parcels%position(:, n), is, js, ks, weights) + + ! loop over grid points which are part of the interpolation + parcel_strain_mag=sum(weights * strain_mag(ks:ks+1, js:js+1, is:is+1)) + reduce_fact=(1.0-exp(-pre_fact*parcel_strain_mag*dt)) + do l=1,3 + parcel_vortp(l)=reduce_fact*(parcels%vorticity(l, n)-& + sum(weights * vortg(ks:ks+1, js:js+1, is:is+1, l))) + enddo +#ifndef ENABLE_DRY_MODE + parcel_qvp=reduce_fact*(parcels%qv(n)-& + sum(weights * qvg(ks:ks+1, js:js+1, is:is+1))) + parcel_qlp=reduce_fact*(parcels%ql(n)-& + sum(weights * qlg(ks:ks+1, js:js+1, is:is+1))) +#endif + parcel_thetap=reduce_fact*(parcels%theta(n)-& + sum(weights * thetag(ks:ks+1, js:js+1, is:is+1))) + ! reduce parcel perturbations + do l=1,3 + parcels%vorticity(l,n)=parcels%vorticity(l,n)-parcel_vortp(l) + enddo +#ifndef ENABLE_DRY_MODE + parcels%qv(n)=parcels%qv(n)-parcel_qvp + parcels%ql(n)=parcels%ql(n)-parcel_qlp +#endif + parcels%theta(n)=parcels%theta(n)-parcel_thetap + ! and put perturbations on grid using pointwise par2grid + + weight = parcels%volume(n) * weights + + do l = 1, 3 + vortpg(ks:ks+1, js:js+1, is:is+1, l) = vortpg(ks:ks+1, js:js+1, is:is+1, l) & + + weight *parcel_vortp(l) + enddo + thetapg(ks:ks+1, js:js+1, is:is+1) = thetapg(ks:ks+1, js:js+1, is:is+1) & + + weight * parcel_thetap +#ifndef ENABLE_DRY_MODE + qvpg(ks:ks+1, js:js+1, is:is+1) = qvpg(ks:ks+1, js:js+1, is:is+1) & + + weight * parcel_qvp + qlpg(ks:ks+1, js:js+1, is:is+1) = qlpg(ks:ks+1, js:js+1, is:is+1) & + + weight * parcel_qlp +#endif + volg(ks:ks+1, js:js+1, is:is+1) = volg(ks:ks+1, js:js+1, is:is+1) & + + weight + + enddo + !$omp end do + !$omp end parallel + + ! DO THE HALO STUFF + call perturbation_damping_halo_swap + + !$omp parallel workshare + ! calculate the average correction needed at grid point + ! exclude halo cells to avoid division by zero + do l = 1, 3 + vortpg(0:nz, :, :, l) = vortpg(0:nz, :, :, l) / volg(0:nz, :, :) + enddo + + +#ifndef ENABLE_DRY_MODE + qvpg(0:nz, :, :) = qvpg(0:nz, :, :) / volg(0:nz, :, :) + qlpg(0:nz, :, :) = qlpg(0:nz, :, :) / volg(0:nz, :, :) +#endif + thetapg(0:nz, :, :) = thetapg(0:nz, :, :) / volg(0:nz, :, :) + !$omp end parallel workshare + + !$omp parallel default(shared) + !$omp do private(n, l, is, js, ks, weights) & + do n = 1, n_parcels + call trilinear(parcels%position(:, n), is, js, ks, weights) + do l=1,3 + parcels%vorticity(l,n)=parcels%vorticity(l,n)+& + sum(weights * vortpg(ks:ks+1, js:js+1, is:is+1, l)) + enddo +#ifndef ENABLE_DRY_MODE + parcels%qv(n)=parcels%qv(n)+& + sum(weights * qvpg(ks:ks+1, js:js+1, is:is+1)) + parcels%ql(n)=parcels%ql(n)+& + sum(weights * qlpg(ks:ks+1, js:js+1, is:is+1)) +#endif + parcels%theta(n)=parcels%theta(n)+& + sum(weights * thetapg(ks:ks+1, js:js+1, is:is+1)) + enddo + !$omp end do + !$omp end parallel + + end subroutine perturbation_damping + + + subroutine perturbation_damping_halo_swap + ! we must first fill the interior grid points + ! correctly, and then the halo; otherwise + ! halo grid points do not have correct values at + ! corners where multiple processes share grid points. + + call field_mpi_alloc(n_field_swap, ndim=3) + + !------------------------------------------------------------------ + ! Accumulate interior: + + call field_halo_to_buffer(volg, IDX_VOL_SWAP) + call field_halo_to_buffer(vortpg(:, :, :, I_X), IDX_VORP_X_SWAP) + call field_halo_to_buffer(vortpg(:, :, :, I_Y), IDX_VORP_Y_SWAP) + call field_halo_to_buffer(vortpg(:, :, :, I_Z), IDX_VORP_Z_SWAP) + call field_halo_to_buffer(thetapg, IDX_THETAP_SWAP) +#ifndef ENABLE_DRY_MODE + call field_halo_to_buffer(qvpg, IDX_QVP_SWAP) + call field_halo_to_buffer(qlpg, IDX_QLP_SWAP) +#endif + + ! send halo data to valid regions of other processes + call halo_to_interior_communication + + ! accumulate interior; after this operation + ! all interior grid points have the correct value + call field_buffer_to_interior(volg, IDX_VOL_SWAP, .true.) + call field_buffer_to_interior(vortpg(:, :, :, I_X), IDX_VORP_X_SWAP, .true.) + call field_buffer_to_interior(vortpg(:, :, :, I_Y), IDX_VORP_Y_SWAP, .true.) + call field_buffer_to_interior(vortpg(:, :, :, I_Z), IDX_VORP_Z_SWAP, .true.) + call field_buffer_to_interior(thetapg, IDX_THETAP_SWAP, .true.) +#ifndef ENABLE_DRY_MODE + call field_buffer_to_interior(qvpg, IDX_QVP_SWAP, .true.) + call field_buffer_to_interior(qlpg, IDX_QLP_SWAP, .true.) +#endif + + !------------------------------------------------------------------ + ! Fill halo: + + call field_interior_to_buffer(volg, IDX_VOL_SWAP) + call field_interior_to_buffer(vortpg(:, :, :, I_X), IDX_VORP_X_SWAP) + call field_interior_to_buffer(vortpg(:, :, :, I_Y), IDX_VORP_Y_SWAP) + call field_interior_to_buffer(vortpg(:, :, :, I_Z), IDX_VORP_Z_SWAP) + call field_interior_to_buffer(thetapg, IDX_THETAP_SWAP) +#ifndef ENABLE_DRY_MODE + call field_interior_to_buffer(qvpg, IDX_QVP_SWAP) + call field_interior_to_buffer(qlpg, IDX_QLP_SWAP) +#endif + + call interior_to_halo_communication + + call field_buffer_to_halo(volg, IDX_VOL_SWAP, .false.) + call field_buffer_to_halo(vortpg(:, :, :, I_X), IDX_VORP_X_SWAP, .false.) + call field_buffer_to_halo(vortpg(:, :, :, I_Y), IDX_VORP_Y_SWAP, .false.) + call field_buffer_to_halo(vortpg(:, :, :, I_Z), IDX_VORP_Z_SWAP, .false.) + call field_buffer_to_halo(thetapg, IDX_THETAP_SWAP, .false.) +#ifndef ENABLE_DRY_MODE + call field_buffer_to_halo(qvpg, IDX_QVP_SWAP, .false.) + call field_buffer_to_halo(qlpg, IDX_QLP_SWAP, .false.) +#endif + + call field_mpi_dealloc + + end subroutine perturbation_damping_halo_swap + + +end module parcel_damping diff --git a/src/3d/stepper/ls_rk.f90 b/src/3d/stepper/ls_rk.f90 index d3dc17194..6e1b23e2f 100644 --- a/src/3d/stepper/ls_rk.f90 +++ b/src/3d/stepper/ls_rk.f90 @@ -8,9 +8,10 @@ module ls_rk use parcel_container use parcel_bc use parcel_mpi, only : parcel_communicate - use rk_utils, only: get_dBdt, get_time_step + use rk_utils, only: get_dBdt, get_time_step, get_strain_magnitude_field use utils, only : write_step use parcel_interpl, only : par2grid, grid2par + use parcel_damping, only : parcel_damp use parcel_ls_forcings, only : apply_ls_forcings use fields, only : velgradg, velog, vortg, vtend, tbuoyg use inversion_mod, only : vor2vel, vorticity_tendency @@ -124,6 +125,8 @@ subroutine ls_rk_step(t) call apply_parcel_reflective_bc call stop_timer(rk_timer) + call get_strain_magnitude_field + call parcel_damp(dt) call apply_ls_forcings(dt) ! we need to subtract 14 calls since we start and stop diff --git a/src/3d/stepper/rk_utils.f90 b/src/3d/stepper/rk_utils.f90 index cf9bbceb5..97bd831b2 100644 --- a/src/3d/stepper/rk_utils.f90 +++ b/src/3d/stepper/rk_utils.f90 @@ -1,7 +1,7 @@ module rk_utils use dimensions, only : n_dim, I_X, I_Y, I_Z use parcel_ellipsoid, only : get_B33, I_B11, I_B12, I_B13, I_B22, I_B23 - use fields, only : velgradg, tbuoyg, vortg, I_DUDX, I_DUDY, I_DVDY, I_DWDX, I_DWDY + use fields, only : velgradg, tbuoyg, vortg, I_DUDX, I_DUDY, I_DVDY, I_DWDX, I_DWDY, strain_mag use field_mpi, only : field_halo_fill_scalar use constants, only : zero, one, two, f12 use parameters, only : nx, ny, nz, dxi, vcell @@ -212,4 +212,65 @@ function get_time_step(t) result(dt) endif end function get_time_step + ! @param[in] t is the time + ! @returns the time step + subroutine get_strain_magnitude_field + double precision :: strain(n_dim, n_dim) + integer :: ix, iy, iz + + ! + ! velocity strain + ! + do ix = box%lo(1), box%hi(1) + do iy = box%lo(2), box%hi(2) + do iz = 0, nz + ! get local symmetrised strain matrix, i.e. 1/ 2 * (S + S^T) + ! where + ! /u_x u_y u_z\ + ! S = |v_x v_y v_z| + ! \w_x w_y w_z/ + ! with u_* = du/d* (also derivatives of v and w). + ! The derivatives dv/dx, du/dz, dv/dz and dw/dz are calculated + ! with vorticity or the assumption of incompressibility + ! (du/dx + dv/dy + dw/dz = 0): + ! dv/dx = \zeta + du/dy + ! du/dz = \eta + dw/dx + ! dv/dz = dw/dy - \xi + ! dw/dz = - (du/dx + dv/dy) + ! + ! / 2 * u_x u_y + v_x u_z + w_x\ + ! 1/2 * (S + S^T) = 1/2 * |u_y + v_x 2 * v_y v_z + w_y| + ! \u_z + w_x v_z + w_y 2 * w_z/ + ! + ! S11 = du/dx + ! S12 = 1/2 * (du/dy + dv/dx) = 1/2 * (2 * du/dy + \zeta) = du/dy + 1/2 * \zeta + ! S13 = 1/2 * (du/dz + dw/dx) = 1/2 * (\eta + 2 * dw/dx) = 1/2 * \eta + dw/dx + ! S22 = dv/dy + ! S23 = 1/2 * (dv/dz + dw/dy) = 1/2 * (2 * dw/dy - \xi) = dw/dy - 1/2 * \xi + ! S33 = dw/dz = - (du/dx + dv/dy) + strain(1, 1) = velgradg(iz, iy, ix, I_DUDX) ! S11 + strain(1, 2) = velgradg(iz, iy, ix, I_DUDY) + f12 * vortg(iz, iy, ix, I_Z) ! S12 + strain(1, 3) = velgradg(iz, iy, ix, I_DWDX) + f12 * vortg(iz, iy, ix, I_Y) ! S13 + strain(2, 1) = strain(1, 2) + strain(2, 2) = velgradg(iz, iy, ix, I_DVDY) ! S22 + strain(2, 3) = velgradg(iz, iy, ix, I_DWDY) - f12 * vortg(iz, iy, ix, I_X) ! S23 + strain(3, 1) = strain(1, 3) + strain(3, 2) = strain(2, 3) + strain(3, 3) = -(velgradg(iz, iy, ix, I_DUDX) + velgradg(iz, iy, ix, I_DVDY)) ! S33 + strain_mag(iz, iy, ix)=sqrt(2.0*strain(1, 1)*strain(1, 1)+& + strain(1, 2)*strain(1, 2)+& + strain(1, 3)*strain(1, 3)+& + strain(2, 1)*strain(2, 1)+& + strain(2, 2)*strain(2, 2)+& + strain(2, 3)*strain(2, 3)+& + strain(3, 1)*strain(3, 1)+& + strain(3, 2)*strain(3, 2)+& + strain(3, 3)*strain(3, 3)) + enddo + enddo + enddo + + end subroutine get_strain_magnitude_field + + end module rk_utils From 80423ca4726b0d3c41e401273595b8455a229168 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Fri, 6 Oct 2023 14:54:35 +0100 Subject: [PATCH 21/34] Damping changes to prevent negative numbers --- src/3d/parcels/parcel_damping.f90 | 39 +++++++++++-------------------- 1 file changed, 14 insertions(+), 25 deletions(-) diff --git a/src/3d/parcels/parcel_damping.f90 b/src/3d/parcels/parcel_damping.f90 index 0ba074452..279286369 100644 --- a/src/3d/parcels/parcel_damping.f90 +++ b/src/3d/parcels/parcel_damping.f90 @@ -71,7 +71,7 @@ subroutine perturbation_damping(dt) double precision :: parcel_qlp double precision :: parcel_thetap double precision :: reduce_fact - double precision, parameter :: pre_fact=1.85 + double precision, parameter :: pre_fact=1.0 !call start_timer(grid2par_timer) @@ -102,27 +102,13 @@ subroutine perturbation_damping(dt) parcel_strain_mag=sum(weights * strain_mag(ks:ks+1, js:js+1, is:is+1)) reduce_fact=(1.0-exp(-pre_fact*parcel_strain_mag*dt)) do l=1,3 - parcel_vortp(l)=reduce_fact*(parcels%vorticity(l, n)-& - sum(weights * vortg(ks:ks+1, js:js+1, is:is+1, l))) + parcel_vortp(l)=reduce_fact*parcels%vorticity(l, n) enddo #ifndef ENABLE_DRY_MODE - parcel_qvp=reduce_fact*(parcels%qv(n)-& - sum(weights * qvg(ks:ks+1, js:js+1, is:is+1))) - parcel_qlp=reduce_fact*(parcels%ql(n)-& - sum(weights * qlg(ks:ks+1, js:js+1, is:is+1))) + parcel_qvp=reduce_fact*parcels%qv(n) + parcel_qlp=reduce_fact*parcels%ql(n) #endif - parcel_thetap=reduce_fact*(parcels%theta(n)-& - sum(weights * thetag(ks:ks+1, js:js+1, is:is+1))) - ! reduce parcel perturbations - do l=1,3 - parcels%vorticity(l,n)=parcels%vorticity(l,n)-parcel_vortp(l) - enddo -#ifndef ENABLE_DRY_MODE - parcels%qv(n)=parcels%qv(n)-parcel_qvp - parcels%ql(n)=parcels%ql(n)-parcel_qlp -#endif - parcels%theta(n)=parcels%theta(n)-parcel_thetap - ! and put perturbations on grid using pointwise par2grid + parcel_thetap=reduce_fact*parcels%theta(n) weight = parcels%volume(n) * weights @@ -138,8 +124,9 @@ subroutine perturbation_damping(dt) qlpg(ks:ks+1, js:js+1, is:is+1) = qlpg(ks:ks+1, js:js+1, is:is+1) & + weight * parcel_qlp #endif + ! use volg to store contributed volume here volg(ks:ks+1, js:js+1, is:is+1) = volg(ks:ks+1, js:js+1, is:is+1) & - + weight + + weight * reduce_fact enddo !$omp end do @@ -164,20 +151,22 @@ subroutine perturbation_damping(dt) !$omp end parallel workshare !$omp parallel default(shared) - !$omp do private(n, l, is, js, ks, weights) & + !$omp do private(n, l, is, js, ks, weights, parcel_strain_mag, reduce_fact) do n = 1, n_parcels call trilinear(parcels%position(:, n), is, js, ks, weights) + parcel_strain_mag=sum(weights * strain_mag(ks:ks+1, js:js+1, is:is+1)) + reduce_fact=(1.0-exp(-pre_fact*parcel_strain_mag*dt)) do l=1,3 - parcels%vorticity(l,n)=parcels%vorticity(l,n)+& + parcels%vorticity(l,n)=parcels%vorticity(l,n)*(1-reduce_fact)+reduce_fact*& sum(weights * vortpg(ks:ks+1, js:js+1, is:is+1, l)) enddo #ifndef ENABLE_DRY_MODE - parcels%qv(n)=parcels%qv(n)+& + parcels%qv(n)=parcels%qv(n)*(1-reduce_fact)+reduce_fact*& sum(weights * qvpg(ks:ks+1, js:js+1, is:is+1)) - parcels%ql(n)=parcels%ql(n)+& + parcels%ql(n)=parcels%ql(n)*(1-reduce_fact)+reduce_fact*& sum(weights * qlpg(ks:ks+1, js:js+1, is:is+1)) #endif - parcels%theta(n)=parcels%theta(n)+& + parcels%theta(n)=parcels%theta(n)*(1-reduce_fact)+reduce_fact*& sum(weights * thetapg(ks:ks+1, js:js+1, is:is+1)) enddo !$omp end do From 08e2c94470a0a8782864cc592426cd90731746ea Mon Sep 17 00:00:00 2001 From: sjboeing Date: Sat, 7 Oct 2023 14:09:23 +0100 Subject: [PATCH 22/34] Set surface pressure like in MONC --- src/3d/parcels/parcel_interpl.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index a26f6420a..e8a2f51bc 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -608,7 +608,7 @@ subroutine saturation_adjustment double precision, parameter :: qsa3 = 35.86 ! Constant in qsat equation double precision, parameter :: qsa4 = 6.109 ! Constant in qsat equation double precision, parameter :: pressure_scale_height = 8619.0 ! Scale height for bomex - double precision, parameter :: surf_press = 101500.0 + double precision, parameter :: surf_press = 100000.0 double precision, parameter :: ref_press = 100000.0 double precision :: press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat integer :: n, iter From b4fa7041d689ef5229c1dd04793795afad7e68e7 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Sat, 7 Oct 2023 14:09:43 +0100 Subject: [PATCH 23/34] Remove vortcor --- src/3d/epic3d.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/3d/epic3d.f90 b/src/3d/epic3d.f90 index 9c5fff289..949bb591e 100644 --- a/src/3d/epic3d.f90 +++ b/src/3d/epic3d.f90 @@ -130,7 +130,7 @@ subroutine run print "(a15, f0.4)", "time: ", t endif #endif - call apply_vortcor + !call apply_vortcor call ls_rk_step(t) @@ -147,7 +147,7 @@ subroutine run ! write final step (we only write if we really advanced in time) if (t > time%initial) then - call apply_vortcor + !call apply_vortcor call write_last_step(t) endif From 8e4ccbd44d716a5b597cc3ef7c3817689ca27421 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Sat, 7 Oct 2023 14:10:22 +0100 Subject: [PATCH 24/34] Remove needless call 2 par2grid. Cosmetics on 1/1.0 --- src/3d/parcels/parcel_damping.f90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/3d/parcels/parcel_damping.f90 b/src/3d/parcels/parcel_damping.f90 index 279286369..4dfb76c92 100644 --- a/src/3d/parcels/parcel_damping.f90 +++ b/src/3d/parcels/parcel_damping.f90 @@ -56,7 +56,6 @@ module parcel_damping subroutine parcel_damp(dt) double precision, intent(in) :: dt - call par2grid(.false.) call perturbation_damping(dt) end subroutine parcel_damp @@ -110,7 +109,7 @@ subroutine perturbation_damping(dt) #endif parcel_thetap=reduce_fact*parcels%theta(n) - weight = parcels%volume(n) * weights + weight = parcels%volume(n) * weights do l = 1, 3 vortpg(ks:ks+1, js:js+1, is:is+1, l) = vortpg(ks:ks+1, js:js+1, is:is+1, l) & @@ -157,16 +156,16 @@ subroutine perturbation_damping(dt) parcel_strain_mag=sum(weights * strain_mag(ks:ks+1, js:js+1, is:is+1)) reduce_fact=(1.0-exp(-pre_fact*parcel_strain_mag*dt)) do l=1,3 - parcels%vorticity(l,n)=parcels%vorticity(l,n)*(1-reduce_fact)+reduce_fact*& + parcels%vorticity(l,n)=parcels%vorticity(l,n)*(1.0-reduce_fact)+reduce_fact*& sum(weights * vortpg(ks:ks+1, js:js+1, is:is+1, l)) enddo #ifndef ENABLE_DRY_MODE - parcels%qv(n)=parcels%qv(n)*(1-reduce_fact)+reduce_fact*& + parcels%qv(n)=parcels%qv(n)*(1.0-reduce_fact)+reduce_fact*& sum(weights * qvpg(ks:ks+1, js:js+1, is:is+1)) - parcels%ql(n)=parcels%ql(n)*(1-reduce_fact)+reduce_fact*& + parcels%ql(n)=parcels%ql(n)*(1.0-reduce_fact)+reduce_fact*& sum(weights * qlpg(ks:ks+1, js:js+1, is:is+1)) #endif - parcels%theta(n)=parcels%theta(n)*(1-reduce_fact)+reduce_fact*& + parcels%theta(n)=parcels%theta(n)*(1.0-reduce_fact)+reduce_fact*& sum(weights * thetapg(ks:ks+1, js:js+1, is:is+1)) enddo !$omp end do From 3444e0666e0b78ac86bb33cb08ccf57fcf244099 Mon Sep 17 00:00:00 2001 From: sjboeing Date: Thu, 12 Oct 2023 13:24:23 +0100 Subject: [PATCH 25/34] Use the much simpler approach which exploits par2grid, including correct saturation adjustmet at every substep --- src/3d/parcels/parcel_damping.f90 | 198 +++++------------------------- src/3d/parcels/parcel_interpl.f90 | 32 +++-- src/3d/stepper/ls_rk.f90 | 6 +- 3 files changed, 59 insertions(+), 177 deletions(-) diff --git a/src/3d/parcels/parcel_damping.f90 b/src/3d/parcels/parcel_damping.f90 index 4dfb76c92..ca2bdb62e 100644 --- a/src/3d/parcels/parcel_damping.f90 +++ b/src/3d/parcels/parcel_damping.f90 @@ -35,6 +35,7 @@ module parcel_damping ! interpolation weights double precision :: weights(0:1,0:1,0:1) double precision :: weight(0:1,0:1,0:1) + double precision :: time_fact(0:1,0:1,0:1) integer, parameter :: IDX_VOL_SWAP = 1 & , IDX_VORP_X_SWAP = 2 & @@ -56,6 +57,7 @@ module parcel_damping subroutine parcel_damp(dt) double precision, intent(in) :: dt + call par2grid_diag !get all gridded fields, including qv, ql and theta call perturbation_damping(dt) end subroutine parcel_damp @@ -63,181 +65,47 @@ end subroutine parcel_damp ! @pre subroutine perturbation_damping(dt) double precision, intent(in) :: dt - integer :: n, l - double precision :: parcel_strain_mag - double precision :: parcel_vortp(3) - double precision :: parcel_qvp - double precision :: parcel_qlp - double precision :: parcel_thetap - double precision :: reduce_fact + integer :: n, p, l, ii, jj, kk double precision, parameter :: pre_fact=1.0 + double precision :: points(3, 4) + double precision :: pvol !call start_timer(grid2par_timer) - vortpg=zero -#ifndef ENABLE_DRY_MODE - qvpg=zero - qlpg=zero -#endif - thetapg=zero - volg=zero - - !$omp parallel default(shared) - !$omp do private(n, l, is, js, ks, weight, weights, reduce_fact, parcel_strain_mag) & -#ifndef ENABLE_DRY_MODE - !$omp& private(parcel_vortp, parcel_qvp, parcel_qlp, parcel_thetap)& - !$omp& reduction(+: vortpg, qvpg, qlpg, thetapg, volg) -#else - !$omp& private(parcel_vortp, parcel_thetap)& - !$omp& reduction(+: vortpg, thetapg, volg) -#endif - +! !$omp parallel default(shared) +! !$omp do private(n, l, is, js, ks, weight, weights, reduce_fact, parcel_strain_mag) & do n = 1, n_parcels - - ! get interpolation weights and mesh indices - call trilinear(parcels%position(:, n), is, js, ks, weights) - - ! loop over grid points which are part of the interpolation - parcel_strain_mag=sum(weights * strain_mag(ks:ks+1, js:js+1, is:is+1)) - reduce_fact=(1.0-exp(-pre_fact*parcel_strain_mag*dt)) - do l=1,3 - parcel_vortp(l)=reduce_fact*parcels%vorticity(l, n) - enddo + pvol = parcels%volume(n) + points = get_ellipsoid_points(parcels%position(:, n), & + pvol, parcels%B(:, n), n, .false.) + + ! we have 4 points per ellipsoid + do p = 1, 4 + call trilinear(points(:, p), is, js, ks, weights) + weight=0.25*weights + do ii=0,1 + do jj=0,1 + do kk=0,1 + time_fact(kk,jj,ii)=1.0-exp(-pre_fact*strain_mag(ks+kk, js+jj, is+ii)*dt) + enddo + enddo + enddo + do l=1,3 + parcels%vorticity(l,n)=parcels%vorticity(l,n)*(1.0-sum(weight*time_fact))& + +sum(weight*time_fact*vortg(ks:ks+1, js:js+1, is:is+1, l)) + enddo + parcels%theta(n)=parcels%theta(n)*(1.0-sum(weight*time_fact))& + +sum(weight*time_fact*thetag(ks:ks+1, js:js+1, is:is+1)) #ifndef ENABLE_DRY_MODE - parcel_qvp=reduce_fact*parcels%qv(n) - parcel_qlp=reduce_fact*parcels%ql(n) -#endif - parcel_thetap=reduce_fact*parcels%theta(n) - - weight = parcels%volume(n) * weights - - do l = 1, 3 - vortpg(ks:ks+1, js:js+1, is:is+1, l) = vortpg(ks:ks+1, js:js+1, is:is+1, l) & - + weight *parcel_vortp(l) - enddo - thetapg(ks:ks+1, js:js+1, is:is+1) = thetapg(ks:ks+1, js:js+1, is:is+1) & - + weight * parcel_thetap -#ifndef ENABLE_DRY_MODE - qvpg(ks:ks+1, js:js+1, is:is+1) = qvpg(ks:ks+1, js:js+1, is:is+1) & - + weight * parcel_qvp - qlpg(ks:ks+1, js:js+1, is:is+1) = qlpg(ks:ks+1, js:js+1, is:is+1) & - + weight * parcel_qlp -#endif - ! use volg to store contributed volume here - volg(ks:ks+1, js:js+1, is:is+1) = volg(ks:ks+1, js:js+1, is:is+1) & - + weight * reduce_fact - - enddo - !$omp end do - !$omp end parallel - - ! DO THE HALO STUFF - call perturbation_damping_halo_swap - - !$omp parallel workshare - ! calculate the average correction needed at grid point - ! exclude halo cells to avoid division by zero - do l = 1, 3 - vortpg(0:nz, :, :, l) = vortpg(0:nz, :, :, l) / volg(0:nz, :, :) - enddo - - -#ifndef ENABLE_DRY_MODE - qvpg(0:nz, :, :) = qvpg(0:nz, :, :) / volg(0:nz, :, :) - qlpg(0:nz, :, :) = qlpg(0:nz, :, :) / volg(0:nz, :, :) -#endif - thetapg(0:nz, :, :) = thetapg(0:nz, :, :) / volg(0:nz, :, :) - !$omp end parallel workshare - - !$omp parallel default(shared) - !$omp do private(n, l, is, js, ks, weights, parcel_strain_mag, reduce_fact) - do n = 1, n_parcels - call trilinear(parcels%position(:, n), is, js, ks, weights) - parcel_strain_mag=sum(weights * strain_mag(ks:ks+1, js:js+1, is:is+1)) - reduce_fact=(1.0-exp(-pre_fact*parcel_strain_mag*dt)) - do l=1,3 - parcels%vorticity(l,n)=parcels%vorticity(l,n)*(1.0-reduce_fact)+reduce_fact*& - sum(weights * vortpg(ks:ks+1, js:js+1, is:is+1, l)) + parcels%qv(n)=parcels%qv(n)*(1.0-sum(weight*time_fact))& + +sum(weight*time_fact*qvg(ks:ks+1, js:js+1, is:is+1)) + parcels%ql(n)=parcels%ql(n)*(1.0-sum(weight*time_fact))& + +sum(weight*time_fact*qlg(ks:ks+1, js:js+1, is:is+1)) enddo -#ifndef ENABLE_DRY_MODE - parcels%qv(n)=parcels%qv(n)*(1.0-reduce_fact)+reduce_fact*& - sum(weights * qvpg(ks:ks+1, js:js+1, is:is+1)) - parcels%ql(n)=parcels%ql(n)*(1.0-reduce_fact)+reduce_fact*& - sum(weights * qlpg(ks:ks+1, js:js+1, is:is+1)) #endif - parcels%theta(n)=parcels%theta(n)*(1.0-reduce_fact)+reduce_fact*& - sum(weights * thetapg(ks:ks+1, js:js+1, is:is+1)) - enddo - !$omp end do - !$omp end parallel + enddo end subroutine perturbation_damping - subroutine perturbation_damping_halo_swap - ! we must first fill the interior grid points - ! correctly, and then the halo; otherwise - ! halo grid points do not have correct values at - ! corners where multiple processes share grid points. - - call field_mpi_alloc(n_field_swap, ndim=3) - - !------------------------------------------------------------------ - ! Accumulate interior: - - call field_halo_to_buffer(volg, IDX_VOL_SWAP) - call field_halo_to_buffer(vortpg(:, :, :, I_X), IDX_VORP_X_SWAP) - call field_halo_to_buffer(vortpg(:, :, :, I_Y), IDX_VORP_Y_SWAP) - call field_halo_to_buffer(vortpg(:, :, :, I_Z), IDX_VORP_Z_SWAP) - call field_halo_to_buffer(thetapg, IDX_THETAP_SWAP) -#ifndef ENABLE_DRY_MODE - call field_halo_to_buffer(qvpg, IDX_QVP_SWAP) - call field_halo_to_buffer(qlpg, IDX_QLP_SWAP) -#endif - - ! send halo data to valid regions of other processes - call halo_to_interior_communication - - ! accumulate interior; after this operation - ! all interior grid points have the correct value - call field_buffer_to_interior(volg, IDX_VOL_SWAP, .true.) - call field_buffer_to_interior(vortpg(:, :, :, I_X), IDX_VORP_X_SWAP, .true.) - call field_buffer_to_interior(vortpg(:, :, :, I_Y), IDX_VORP_Y_SWAP, .true.) - call field_buffer_to_interior(vortpg(:, :, :, I_Z), IDX_VORP_Z_SWAP, .true.) - call field_buffer_to_interior(thetapg, IDX_THETAP_SWAP, .true.) -#ifndef ENABLE_DRY_MODE - call field_buffer_to_interior(qvpg, IDX_QVP_SWAP, .true.) - call field_buffer_to_interior(qlpg, IDX_QLP_SWAP, .true.) -#endif - - !------------------------------------------------------------------ - ! Fill halo: - - call field_interior_to_buffer(volg, IDX_VOL_SWAP) - call field_interior_to_buffer(vortpg(:, :, :, I_X), IDX_VORP_X_SWAP) - call field_interior_to_buffer(vortpg(:, :, :, I_Y), IDX_VORP_Y_SWAP) - call field_interior_to_buffer(vortpg(:, :, :, I_Z), IDX_VORP_Z_SWAP) - call field_interior_to_buffer(thetapg, IDX_THETAP_SWAP) -#ifndef ENABLE_DRY_MODE - call field_interior_to_buffer(qvpg, IDX_QVP_SWAP) - call field_interior_to_buffer(qlpg, IDX_QLP_SWAP) -#endif - - call interior_to_halo_communication - - call field_buffer_to_halo(volg, IDX_VOL_SWAP, .false.) - call field_buffer_to_halo(vortpg(:, :, :, I_X), IDX_VORP_X_SWAP, .false.) - call field_buffer_to_halo(vortpg(:, :, :, I_Y), IDX_VORP_Y_SWAP, .false.) - call field_buffer_to_halo(vortpg(:, :, :, I_Z), IDX_VORP_Z_SWAP, .false.) - call field_buffer_to_halo(thetapg, IDX_THETAP_SWAP, .false.) -#ifndef ENABLE_DRY_MODE - call field_buffer_to_halo(qvpg, IDX_QVP_SWAP, .false.) - call field_buffer_to_halo(qlpg, IDX_QLP_SWAP, .false.) -#endif - - call field_mpi_dealloc - - end subroutine perturbation_damping_halo_swap - - end module parcel_damping diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index e8a2f51bc..9e650f5fe 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -601,6 +601,7 @@ pure subroutine trilinear(pos, ii, jj, kk, ww) end subroutine trilinear + subroutine saturation_adjustment double precision, parameter :: tk0c = 273.15 ! Temperature of freezing in Kelvin double precision, parameter :: qsa1 = 3.8 ! Top in equation to calculate qsat @@ -611,11 +612,12 @@ subroutine saturation_adjustment double precision, parameter :: surf_press = 100000.0 double precision, parameter :: ref_press = 100000.0 double precision :: press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat + double precision :: err_at_temp, err_at_temp_inv_deriv,efact,divfact integer :: n, iter - -#ifndef ENABLE_DRY_MODE - !$omp parallel default(shared) - !$omp do private(n, iter, press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat) + +!!! #ifndef ENABLE_DRY_MODE +!!! !$omp parallel default(shared) +!!! !$omp do private(n, iter, press, exn, temp, temp_low, qsat_low, qt_start, ql_start, ql_iter, temp_start, qsat) do n = 1, n_parcels press=surf_press*exp(-parcels%position(3, n)/pressure_scale_height) exn=(press/ref_press)**(r_d/c_p) @@ -633,11 +635,21 @@ subroutine saturation_adjustment parcels%ql(n)=0. end if ! Moist case: iterate a few times, start from temp instead of temp_low + ! Use Newton-Raphson to converge else - do iter=1,4 - qsat=qsa1/(0.01*press*exp(qsa2*(temp - tk0c)/(temp - qsa3)) - qsa4) + do iter=1,3 + efact=0.01*press*exp(qsa2*(temp - tk0c)/(temp - qsa3)) + qsat=qsa1/(efact - qsa4) ql_iter=max(qt_start-qsat,0.0) - temp=temp_start-(L_v/c_p)*(ql_start-ql_iter) + err_at_temp=temp-(temp_start-(L_v/c_p)*(ql_start-ql_iter)) + if(ql_iter>0.0) then + !calculate 1/(d err/ dt) to save a division latet on + divfact=((efact - qsa4)*(efact - qsa4)*(temp - qsa3)*(temp - qsa3)) + err_at_temp_inv_deriv=divfact/(divfact+(L_v/c_p)*(qsa1*qsa2*efact*(qsa3-tk0c))) + else + err_at_temp_inv_deriv=1.0 + endif + temp=temp-err_at_temp*err_at_temp_inv_deriv enddo qsat=qsa1/(0.01*press*exp(qsa2*(temp - tk0c)/(temp - qsa3)) - qsa4) ql_iter=max(qt_start-qsat,0.0) @@ -646,9 +658,9 @@ subroutine saturation_adjustment parcels%ql(n)=ql_iter end if end do - !$omp end do - !$omp end parallel -#endif +!!! !$omp end do +!!! !$omp end parallel +!!!#endif end subroutine saturation_adjustment diff --git a/src/3d/stepper/ls_rk.f90 b/src/3d/stepper/ls_rk.f90 index 6e1b23e2f..4261839cf 100644 --- a/src/3d/stepper/ls_rk.f90 +++ b/src/3d/stepper/ls_rk.f90 @@ -10,7 +10,7 @@ module ls_rk use parcel_mpi, only : parcel_communicate use rk_utils, only: get_dBdt, get_time_step, get_strain_magnitude_field use utils, only : write_step - use parcel_interpl, only : par2grid, grid2par + use parcel_interpl, only : par2grid, grid2par, saturation_adjustment use parcel_damping, only : parcel_damp use parcel_ls_forcings, only : apply_ls_forcings use fields, only : velgradg, velog, vortg, vtend, tbuoyg @@ -198,8 +198,10 @@ subroutine ls_rk_substep(dt, step) enddo !$omp end parallel do - call stop_timer(rk_timer) + ! call saturation adjustment after each integration + call saturation_adjustment + call stop_timer(rk_timer) if (step == n_stages) then call parcel_communicate return From 12b7e118d73edaffcafed2508a8e75afc8a5dfd5 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Wed, 23 Oct 2024 12:44:24 +0100 Subject: [PATCH 26/34] Changes to ensure compilation works --- mpi-tests/test_utils.f90 | 8 +- src/3d/Makefile.am | 1 - src/3d/parcels/parcel_damping.f90 | 150 ++++++----- src/3d/parcels/parcel_interpl.f90 | 3 +- src/3d/parcels/parcel_netcdf.f90 | 399 +++++++++++++++++++++++------- 5 files changed, 386 insertions(+), 175 deletions(-) diff --git a/mpi-tests/test_utils.f90 b/mpi-tests/test_utils.f90 index 5248150bf..066b39b6f 100644 --- a/mpi-tests/test_utils.f90 +++ b/mpi-tests/test_utils.f90 @@ -170,7 +170,7 @@ subroutine setup_parcels(xlen, ylen, zlen, l_shuffle, l_variable_nppc) parcels%vorticity(3, l) = 20.0d0 * rn(6) - 10.d0 ! buoyancy between -1 and 1: y = 2 * x - 1 - parcels%buoyancy(l) = 2.0d0 * rn(7) - 1.d0 + parcels%theta(l) = 2.0d0 * rn(7) - 1.d0 if ((x >= xlo) .and. (x <= xhi) .and. & (y >= ylo) .and. (y <= yhi) .and. & @@ -242,9 +242,9 @@ subroutine shuffleall parcels%vorticity(:, rand_target) = parcels%vorticity(:, shuffle_index) parcels%vorticity(:, shuffle_index) = tmp_vec - tmp_var = parcels%buoyancy(rand_target) - parcels%buoyancy(rand_target) = parcels%buoyancy(shuffle_index) - parcels%buoyancy(shuffle_index) = tmp_var + tmp_var = parcels%theta(rand_target) + parcels%theta(rand_target) = parcels%theta(shuffle_index) + parcels%theta(shuffle_index) = tmp_var tmp_var = parcels%volume(rand_target) parcels%volume(rand_target) = parcels%volume(shuffle_index) diff --git a/src/3d/Makefile.am b/src/3d/Makefile.am index 4e6118c6c..f9ca509e7 100644 --- a/src/3d/Makefile.am +++ b/src/3d/Makefile.am @@ -23,7 +23,6 @@ epic3d_SOURCES = \ parcels/parcel_diagnostics.f90 \ parcels/parcel_interpl.f90 \ parcels/parcel_init.f90 \ - parcels/parcel_damping.f90 \ fields/field_diagnostics.f90 \ fields/field_netcdf.f90 \ fields/field_diagnostics_netcdf.f90 \ diff --git a/src/3d/parcels/parcel_damping.f90 b/src/3d/parcels/parcel_damping.f90 index e811fec58..97606aa94 100644 --- a/src/3d/parcels/parcel_damping.f90 +++ b/src/3d/parcels/parcel_damping.f90 @@ -1,6 +1,6 @@ ! ============================================================================= ! This module contains the subroutines to do damping of parcel properties to -! gridded fields in a conservative manner. It does this by nudging all the +! gridded fields in a conservative manner. It does this by nudging all the ! parcels associated with a grid point to the grid point value, with the strength ! of damping proportional to the grid point contribution to the gridded value and ! the strain rate at the grid point. @@ -8,13 +8,15 @@ module parcel_damping use constants, only : f14, zero, one use mpi_timer, only : start_timer, stop_timer - use parameters, only : nx, nz, vmin + use parameters, only : nx, nz, vmin use parcel_container, only : parcels, n_parcels use parcel_ellipsoid use parcel_interpl use fields + use parameters, only : lower, upper use omp_lib - use mpi_layout, only : box + use mpi_layout, only : box + use mpi_utils, only : mpi_exit_on_error use options, only : damping use inversion_mod, only : vor2vel use rk_utils, only : get_strain_magnitude_field @@ -27,12 +29,12 @@ module parcel_damping ! (first dimension x, y, z; second dimension l-th index) integer :: is, js, ks integer :: damping_timer - + ! interpolation weights double precision :: weights(0:1,0:1,0:1) double precision :: weight(0:1,0:1,0:1) double precision :: time_fact(0:1,0:1,0:1) - + public :: parcel_damp, damping_timer contains @@ -40,8 +42,13 @@ module parcel_damping subroutine parcel_damp(dt) double precision, intent(in) :: dt + if (damping%l_vorticity .and. damping%l_surface_vorticity) then + call mpi_exit_on_error("damping%l_vorticity and damping%l_surface_vorticity both activated, only one allowed") + elseif (damping%l_scalars .and. damping%l_surface_scalars) then + call mpi_exit_on_error("damping%l_scalars and damping%l_surface_scalars both activated, only one allowed") + endif if (damping%l_vorticity .or. damping%l_scalars .or. & - damping%l_surface_vorticity .or. damping%l_surface_scalars) then + damping%l_surface_vorticity .or. damping%l_surface_scalars) then ! ensure gridded fields are up to date call par2grid(.false.) call vor2vel @@ -68,26 +75,26 @@ subroutine parcel_damp(dt) end subroutine parcel_damp - ! - ! @pre + ! + ! @pre: the strain must be calculated and the gridded fields updated subroutine perturbation_damping(dt, l_reuse) double precision, intent(in) :: dt logical, intent(in) :: l_reuse #if defined (ENABLE_P2G_1POINT) && !defined (NDEBUG) logical :: l_reuse_dummy #endif - integer :: n, p, l + integer :: n, p, l, surface_index double precision :: points(3, n_points_p2g) double precision :: pvol ! tendencies need to be summed up between associated 4 points ! before modifying the parcel attribute double precision :: vortend(3) - double precision :: thetatend #ifndef ENABLE_DRY_MODE - double precision :: qltend double precision :: qvtend + double precision :: qltend #endif - + double precision :: thetatend + call start_timer(damping_timer) ! This is only here to allow debug compilation @@ -97,63 +104,51 @@ subroutine perturbation_damping(dt, l_reuse) #endif !$omp parallel default(shared) - !$omp do private(n, p, l, points, pvol, weight) & + !$omp do private(n, p, l, points, pvol, weight, surface_index) & #ifndef ENABLE_DRY_MODE - !$omp& private(is, js, ks, weights, vortend, thetatend, qvtend, qltend, time_fact) + !$omp& private(is, js, ks, weights, vortend, qvtend, qltend, thetatend, time_fact) #else - !$omp& private(is, js, ks, weights, vortend, thetatend, time_fact) + !$omp& private(is, js, ks, weights, vortend, thetatend, time_fact) #endif do n = 1, n_parcels + ! check if only surface damping applies and we are far from surfaces + ! put in a buffer here as parcels can get stretched in integration + if(.not.(damping%l_vorticity .or. damping%l_scalars)) then + if(parcels%position(3, n) > lower(3) + 2 * dx(3)) then + if(parcels%position(3, n) < upper(3) - 2 * dx(3)) then + cycle + end if + end if + endif + pvol = parcels%volume(n) #ifndef ENABLE_P2G_1POINT points = get_ellipsoid_points(parcels%position(:, n), & - parcels%B(:, n), n, l_reuse) + pvol, parcels%B(:, n), n, l_reuse) #else points(:, 1) = parcels%position(:, n) #endif vortend = zero - thetatend = zero #ifndef ENABLE_DRY_MODE qvtend = zero qltend = zero #endif + thetatend = zero ! we have 4 points per ellipsoid do p = 1, n_points_p2g call trilinear(points(:, p), is, js, ks, weights) weight = point_weight_p2g * weights + if (damping%l_vorticity) then ! Note this exponential factor can be different for vorticity/scalars time_fact = one - exp(-damping%vorticity_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) - do l = 1,3 + do l = 1, 3 vortend(l) = vortend(l)+sum(weight * time_fact * (vortg(ks:ks+1, js:js+1, is:is+1, l) & - parcels%vorticity(l,n))) enddo - else if (damping%l_surface_vorticity) then - ! outside the bounds - if (ks < box%lo(3)) then - ! Note this exponential factor can be different for vorticity/scalars - time_fact = one - exp(-damping%vorticity_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) - do l = 1,3 - vortend(l) = vortend(l)+sum(weight(1, :, :) * time_fact(1, :, :) * & - (vortg(ks+1, js:js+1, is:is+1, l) - parcels%vorticity(l,n))) - enddo - elseif ((ks < box%lo(3)+1) .or. (ks+1 > box%hi(3))) then - ! Note this exponential factor can be different for vorticity/scalars - time_fact = one - exp(-damping%vorticity_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) - do l = 1,3 - vortend(l) = vortend(l)+sum(weight(0, :, :) * time_fact(0, :, :) * & - (vortg(ks, js:js+1, is:is+1, l) - parcels%vorticity(l,n))) - enddo - elseif (ks+1 > box%hi(3)-1) then - ! Note this exponential factor can be different for vorticity/scalars - time_fact = one - exp(-damping%vorticity_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) - do l = 1,3 - vortend(l) = vortend(l)+sum(weight(1, :, :) * time_fact(1, :, :) * & - (vortg(ks+1, js:js+1, is:is+1, l) - parcels%vorticity(l,n))) - enddo - endif endif + if (damping%l_scalars) then time_fact = one - exp(-damping%scalars_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) #ifndef ENABLE_DRY_MODE @@ -161,47 +156,48 @@ subroutine perturbation_damping(dt, l_reuse) qltend = qltend + sum(weight * time_fact * (qlg(ks:ks+1, js:js+1, is:is+1) - parcels%ql(n))) #endif thetatend = thetatend + sum(weight * time_fact * (thetag(ks:ks+1, js:js+1, is:is+1) - parcels%theta(n))) - else if (damping%l_surface_scalars) then - ! outside the bounds - if (ks < box%lo(3)) then - ! Note this exponential factor can be different for vorticity/scalars - time_fact = one - exp(-damping%scalars_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) -#ifndef ENABLE_DRY_MODE - qvtend = qvtend + sum(weight(1, :, :) * time_fact(1, :, :) * & - (qvg(ks+1, js:js+1, is:is+1) - parcels%qv(n))) - qltend = qltend + sum(weight(1, :, :) * time_fact(1, :, :) * & - (qlg(ks+1, js:js+1, is:is+1) - parcels%ql(n))) -#endif - thetatend = thetatend + sum(weight(1, :, :) * time_fact(1, :, :) * & - (thetag(ks+1, js:js+1, is:is+1) - parcels%theta(n))) - elseif ((ks < box%lo(3)+1) .or. (ks+1 > box%hi(3))) then - ! Note this exponential factor can be different for vorticity/scalars - time_fact = one - exp(-damping%scalars_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) -#ifndef ENABLE_DRY_MODE - qvtend = qvtend + sum(weight(0, :, :) * time_fact(0, :, :) * & - (qvg(ks, js:js+1, is:is+1) - parcels%qv(n))) - qltend = qltend + sum(weight(0, :, :) * time_fact(0, :, :) * & - (qlg(ks, js:js+1, is:is+1) - parcels%ql(n))) -#endif - thetatend = thetatend + sum(weight(0, :, :) * time_fact(0, :, :) * & - (thetag(ks, js:js+1, is:is+1) - parcels%theta(n))) - elseif (ks+1 > box%hi(3)-1) then - ! Note this exponential factor can be different for vorticity/scalars - time_fact = one - exp(-damping%scalars_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) + endif + + if (damping%l_surface_vorticity .or. damping%l_surface_scalars) then + ! Index to keep track of grid cells right above/below boundary + ! This is because the damping only happens at the boundary level + ! Consistent with reflection used in parcel_damp + if ((ks == box%lo(3)-1) .or. (ks == box%hi(3)-1)) then + surface_index = 1 ! below lower or below upper boundary + elseif ((ks == box%lo(3)) .or. (ks == box%hi(3))) then + surface_index = 0 ! above lower or above upper boundary + else + cycle ! continue loop if not near a surface + endif + else + cycle ! continue loop if no surface damping + endif + + if (damping%l_surface_vorticity) then + ! Note this exponential factor can be different for vorticity/scalars + time_fact = one - exp(-damping%vorticity_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) + do l = 1, 3 + vortend(l) = vortend(l)+sum(weight(surface_index, :, :) * time_fact(surface_index, :, :) * & + (vortg(ks+surface_index, js:js+1, is:is+1, l) - parcels%vorticity(l,n))) + enddo + endif + + if (damping%l_surface_scalars) then + ! Note this exponential factor can be different for vorticity/scalars + time_fact = one - exp(-damping%scalars_prefactor * strain_mag(ks:ks+1, js:js+1, is:is+1) * dt) #ifndef ENABLE_DRY_MODE - qvtend = qvtend + sum(weight(1, :, :) * time_fact(1, :, :) * & - (qvg(ks+1, js:js+1, is:is+1) - parcels%qv(n))) - qltend = qltend + sum(weight(1, :, :) * time_fact(1, :, :) * & - (qlg(ks+1, js:js+1, is:is+1) - parcels%ql(n))) + qvtend = qvtend + sum(weight(surface_index, :, :) * time_fact(surface_index, :, :) * & + (qvg(ks+surface_index, js:js+1, is:is+1) - parcels%qv(n))) + qltend = qltend + sum(weight(surface_index, :, :) * time_fact(surface_index, :, :) * & + (qlg(ks+surface_index, js:js+1, is:is+1) - parcels%ql(n))) #endif - thetatend = thetatend + sum(weight(1, :, :) * time_fact(1, :, :) * & - (thetag(ks+1, js:js+1, is:is+1) - parcels%theta(n))) - endif + thetatend = thetatend + sum(weight(surface_index, :, :) * time_fact(surface_index, :, :) * & + (thetag(ks+surface_index, js:js+1, is:is+1) - parcels%theta(n))) endif enddo ! Add all the tendencies only at the end if (damping%l_vorticity .or. damping%l_surface_vorticity) then - do l=1,3 + do l=1, 3 parcels%vorticity(l,n) = parcels%vorticity(l,n) + vortend(l) enddo endif diff --git a/src/3d/parcels/parcel_interpl.f90 b/src/3d/parcels/parcel_interpl.f90 index 1e9efe694..9b6dc3c79 100644 --- a/src/3d/parcels/parcel_interpl.f90 +++ b/src/3d/parcels/parcel_interpl.f90 @@ -63,6 +63,7 @@ module parcel_interpl integer, parameter :: n_field_swap_diag = 4 #else integer, parameter :: n_field_swap_diag = 2 +#endif #ifndef ENABLE_G2P_1POINT integer, parameter :: n_points_g2p = 4 @@ -89,7 +90,7 @@ module parcel_interpl , halo_swap_timer & , trilinear & , saturation_adjustment & - , bilinear + , bilinear & , n_points_p2g & , point_weight_p2g diff --git a/src/3d/parcels/parcel_netcdf.f90 b/src/3d/parcels/parcel_netcdf.f90 index 700ada6fb..15fe24e8a 100644 --- a/src/3d/parcels/parcel_netcdf.f90 +++ b/src/3d/parcels/parcel_netcdf.f90 @@ -15,6 +15,10 @@ module parcel_netcdf use options, only : write_netcdf_options use physics, only : write_physical_quantities use mpi_environment + use mpi_datatypes, only : MPI_INTEGER_64BIT + use mpi_layout, only : box + use mpi_ops, only : MPI_SUM_64BIT + use datatypes, only : int64 use mpi_utils, only : mpi_exit_on_error, mpi_print, mpi_check_for_error use fields, only : is_contained implicit none @@ -35,29 +39,50 @@ module parcel_netcdf double precision :: restart_time integer, parameter :: NC_START = 1 & - , NC_VOL = 2 & - , NC_X_POS = 3 & - , NC_Y_POS = 4 & - , NC_Z_POS = 5 & - , NC_THETA = 6 & - , NC_X_VOR = 7 & - , NC_Y_VOR = 8 & - , NC_Z_VOR = 9 & - , NC_B11 = 10 & - , NC_B12 = 11 & - , NC_B13 = 12 & - , NC_B22 = 13 & - , NC_B23 = 14 + , NC_XLO = 2 & + , NC_XHI = 3 & + , NC_YLO = 4 & + , NC_YHI = 5 & + , NC_VOL = 6 & + , NC_X_POS = 7 & + , NC_Y_POS = 8 & + , NC_Z_POS = 9 & + , NC_THETA = 10 & + , NC_X_VOR = 11 & + , NC_Y_VOR = 12 & + , NC_Z_VOR = 13 & + , NC_B11 = 14 & + , NC_B12 = 15 & + , NC_B13 = 16 & + , NC_B22 = 17 & + , NC_B23 = 18 logical :: l_first_write = .true. + logical :: l_unable = .false. #ifndef ENABLE_DRY_MODE - integer, parameter :: NC_QV = 15 - integer, parameter :: NC_QL = 16 + integer, parameter :: NC_QV = 19 & + , NC_QL = 20 +#ifdef ENABLE_LABELS + integer, parameter :: NC_LABEL = 21 & + , NC_DILUTION = 22 + + type(netcdf_info) :: nc_dset(NC_DILUTION) +#else type(netcdf_info) :: nc_dset(NC_QL) +#endif + +#else + +#ifdef ENABLE_LABELS + integer, parameter :: NC_LABEL = 19 & + , NC_DILUTION = 20 + + type(netcdf_info) :: nc_dset(NC_DILUTION) #else type(netcdf_info) :: nc_dset(NC_B23) +#endif #endif public :: create_netcdf_parcel_file & @@ -76,7 +101,7 @@ subroutine create_netcdf_parcel_file(basename, overwrite, l_restart) logical, intent(in) :: l_restart logical :: l_exist integer :: dimids(2) - integer :: n + integer :: n, n_total call set_netcdf_parcel_output @@ -102,6 +127,21 @@ subroutine create_netcdf_parcel_file(basename, overwrite, l_restart) return endif + ! all cores must know the correct number of total parcels + n_total_parcels = n_parcels + call MPI_Allreduce(MPI_IN_PLACE, n_total_parcels, 1, MPI_INTEGER_64BIT, & + MPI_SUM_64BIT, world%comm, world%err) + + if ((world%rank == world%root) .and. (n_total_parcels > huge(n_total))) then + print *, "WARNING: Unable to write parcels to the NetCDF file" + print *, " as the number of total parcel exceeds integer limit." + l_unable = .true. + return + endif + l_unable = .false. + + n_total = int(n_total_parcels) + call create_netcdf_file(ncfname, overwrite, ncid) ! define global attributes @@ -116,15 +156,10 @@ subroutine create_netcdf_parcel_file(basename, overwrite, l_restart) call write_netcdf_options(ncid) - ! all cores must know the correct number of total parcels - n_total_parcels = n_parcels - call MPI_Allreduce(MPI_IN_PLACE, n_total_parcels, 1, MPI_INTEGER, & - MPI_SUM, world%comm, world%err) - ! define dimensions - call define_netcdf_dimension(ncid=ncid, & - name='n_parcels', & - dimsize=n_total_parcels, & + call define_netcdf_dimension(ncid=ncid, & + name='n_parcels', & + dimsize=n_total, & dimid=npar_dim_id) call define_netcdf_dimension(ncid=ncid, & @@ -137,19 +172,20 @@ subroutine create_netcdf_parcel_file(basename, overwrite, l_restart) dimids = (/npar_dim_id, t_dim_id/) ! define parcel attributes - n = NC_START - if (nc_dset(n)%l_enabled) then - call define_netcdf_dataset(ncid=ncid, & - name=nc_dset(n)%name, & - long_name=nc_dset(n)%long_name, & - std_name=nc_dset(n)%std_name, & - unit=nc_dset(n)%unit, & - dtype=nc_dset(n)%dtype, & - dimids=(/mpi_dim_id/), & - varid=nc_dset(n)%varid) - endif - - do n = 2, size(nc_dset) + do n = NC_START, NC_YHI + if (nc_dset(n)%l_enabled) then + call define_netcdf_dataset(ncid=ncid, & + name=nc_dset(n)%name, & + long_name=nc_dset(n)%long_name, & + std_name=nc_dset(n)%std_name, & + unit=nc_dset(n)%unit, & + dtype=nc_dset(n)%dtype, & + dimids=(/mpi_dim_id/), & + varid=nc_dset(n)%varid) + endif + enddo + + do n = NC_VOL, size(nc_dset) if (nc_dset(n)%l_enabled) then call define_netcdf_dataset(ncid=ncid, & name=nc_dset(n)%name, & @@ -175,6 +211,9 @@ subroutine write_netcdf_parcels(t) integer :: cnt(2), start(2) integer :: recvcounts(world%size) integer :: sendbuf(world%size), start_index +#ifdef ENABLE_LABELS + integer :: n +#endif call start_timer(parcel_io_timer) @@ -185,6 +224,11 @@ subroutine write_netcdf_parcels(t) call create_netcdf_parcel_file(trim(ncbasename), .true., .false.) + if (l_unable) then + call stop_timer(parcel_io_timer) + return + endif + call open_netcdf_file(ncfname, NF90_WRITE, ncid) ! we must write the boundary flag here @@ -223,6 +267,26 @@ subroutine write_netcdf_parcels(t) start=(/1+world%rank, 1/), cnt=(/1, 1/)) endif + if (nc_dset(NC_XLO)%l_enabled) then + call write_netcdf_dataset(ncid, nc_dset(NC_XLO)%varid, (/box%lo(1)/), & + start=(/1+world%rank, 1/), cnt=(/1, 1/)) + endif + + if (nc_dset(NC_XHI)%l_enabled) then + call write_netcdf_dataset(ncid, nc_dset(NC_XHI)%varid, (/box%hi(1)/), & + start=(/1+world%rank, 1/), cnt=(/1, 1/)) + endif + + if (nc_dset(NC_YLO)%l_enabled) then + call write_netcdf_dataset(ncid, nc_dset(NC_YLO)%varid, (/box%lo(2)/), & + start=(/1+world%rank, 1/), cnt=(/1, 1/)) + endif + + if (nc_dset(NC_YHI)%l_enabled) then + call write_netcdf_dataset(ncid, nc_dset(NC_YHI)%varid, (/box%hi(2)/), & + start=(/1+world%rank, 1/), cnt=(/1, 1/)) + endif + call write_parcel_attribute(NC_X_POS, parcels%position(1, :), start, cnt) call write_parcel_attribute(NC_Y_POS, parcels%position(2, :), start, cnt) call write_parcel_attribute(NC_Z_POS, parcels%position(3, :), start, cnt) @@ -244,6 +308,16 @@ subroutine write_netcdf_parcels(t) #ifndef ENABLE_DRY_MODE call write_parcel_attribute(NC_QV, parcels%qv, start, cnt) call write_parcel_attribute(NC_QL, parcels%ql, start, cnt) +#endif +#ifdef ENABLE_LABELS + call write_parcel_attribute_int(NC_LABEL, parcels%label, start, cnt) + call write_parcel_attribute(NC_DILUTION, parcels%dilution, start, cnt) + ! reset the labels to Fortran index which corresponds to current label + ! reset the dilution to get this from time step to time step + do n = 1, n_parcels + parcels%label(n) = start_index + n - 1 + parcels%dilution(n) = 0 + end do #endif ! increment counter n_writes = n_writes + 1 @@ -268,15 +342,29 @@ subroutine write_parcel_attribute(id, pdata, start, cnt) endif end subroutine write_parcel_attribute +#ifdef ENABLE_LABELS + subroutine write_parcel_attribute_int(id, pdata, start, cnt) + integer, intent(in) :: id + integer(kind=8), intent(in) :: pdata(:) + integer, intent(in) :: cnt(2), start(2) + + if (nc_dset(id)%l_enabled) then + call write_netcdf_dataset(ncid, nc_dset(id)%varid, & + pdata(1:n_parcels), & + start, cnt) + endif + end subroutine write_parcel_attribute_int +#endif + !:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: subroutine read_netcdf_parcels(fname) character(*), intent(in) :: fname integer :: start_index, num_indices, end_index - integer, allocatable :: invalid(:) - integer :: n, m, n_total, pfirst, plast - integer :: start(2) + integer :: n, n_total, pfirst, plast integer :: avail_size, n_remaining, n_read + integer :: start(2), xlo, xhi, ylo, yhi + logical :: l_same_world_size call start_timer(parcel_io_timer) @@ -284,14 +372,16 @@ subroutine read_netcdf_parcels(fname) call open_netcdf_file(fname, NF90_NOWRITE, ncid) - call get_num_parcels(ncid, n_total_parcels) + call get_num_parcels(ncid, n_total) - if (has_dataset(ncid, 'start_index')) then - call get_dimension_size(ncid, 'world%size', num_indices) + n_total_parcels = n_total - if (num_indices .ne. world%size) then - call mpi_exit_on_error("The number of MPI ranks disagree!") - endif + ! The number of MPI ranks disagree! We cannot use the 'start_index' + ! to read in parcels + call get_dimension_size(ncid, 'world%size', num_indices) + l_same_world_size = (num_indices == world%size) + + if (l_same_world_size .and. has_dataset(ncid, 'start_index')) then if (world%rank < world%size - 1) then ! we must add +1 since the start index is 1 @@ -301,9 +391,8 @@ subroutine read_netcdf_parcels(fname) end_index = start(2) - 1 else ! the last MPI rank must only read the start index - call read_netcdf_dataset(ncid, 'start_index', start, (/num_indices/), (/1/)) - start_index = start(1) - end_index = n_total_parcels + call read_netcdf_dataset(ncid, 'start_index', start_index, num_indices) + end_index = n_total endif n_parcels = end_index - start_index + 1 @@ -315,46 +404,70 @@ subroutine read_netcdf_parcels(fname) endif call read_chunk(start_index, end_index, 1) + else if (has_dataset(ncid, 'xlo') .and. has_dataset(ncid, 'xhi') .and. & + has_dataset(ncid, 'ylo') .and. has_dataset(ncid, 'yhi') .and. & + has_dataset(ncid, 'start_index')) then + ! + ! READ PARCEL WITH REJECTION METHOD BUT MAKING USE OF + ! MPI BOX LAYOUT + ! + call mpi_print("WARNING: MPI ranks disagree. Reading parcels with optimised rejection method!") + + n_parcels = 0 + pfirst = 1 + + do n = 1, num_indices + + ! read local box + call read_netcdf_dataset(ncid, 'xlo', xlo, start=n) + call read_netcdf_dataset(ncid, 'xhi', xhi, start=n) + call read_netcdf_dataset(ncid, 'ylo', ylo, start=n) + call read_netcdf_dataset(ncid, 'yhi', yhi, start=n) + + ! check if box overlap (19 April 2024, https://stackoverflow.com/a/3269471): + if ((xlo <= box%hi(1)) .and. (box%lo(1) <= xhi) .and. & + (ylo <= box%hi(2)) .and. (box%lo(2) <= yhi)) then + + ! get start and end index: + if (n < num_indices) then + call read_netcdf_dataset(ncid, 'start_index', start, (/n/), (/2/)) + start_index = start(1) + ! we must subtract 1, otherwise rank reads the first parcel of the next domain + end_index = start(2) - 1 + else + ! for the last index we can only read the start index + call read_netcdf_dataset(ncid, 'start_index', start_index, num_indices) + call get_num_parcels(ncid, n_total) + end_index = n_total + endif + + call rejection_method(start_index, end_index, pfirst) + + ! set pfirst to the end of the parcel container + pfirst = n_parcels + 1 + endif + enddo else ! ! READ PARCELS WITH REJECTION METHOD ! (reject all parcels that are not part of ! the sub-domain owned by *this* MPI rank) ! - call mpi_print("WARNING: The start index is not provided. All MPI ranks read all parcels!") + call mpi_print("WARNING: Unable to retrieve information for fast parcel reading.") + call mpi_print(" All MPI ranks read all parcels!") + start_index = 1 - end_index = min(max_num_parcels, n_total_parcels) + end_index = min(max_num_parcels, n_total) pfirst = 1 - n_remaining = n_total_parcels - - ! if all MPI ranks read all parcels, each MPI rank must delete the parcels - ! not belonging to its domain - allocate(invalid(0:end_index)) + n_remaining = n_total + n_parcels = 0 do while (start_index <= end_index) - call read_chunk(start_index, end_index, pfirst) - n_read = end_index - start_index + 1 n_remaining = n_remaining - n_read - n_parcels = pfirst + n_read - 1 - - m = 1 - do n = pfirst, n_parcels - if (is_contained(parcels%position(:, n))) then - cycle - endif - - invalid(m) = n - - m = m + 1 - enddo - - ! remove last increment - m = m - 1 - ! updates the variable n_parcels - call parcel_delete(invalid(0:m), n_del=m) + call rejection_method(start_index, end_index, pfirst) ! adjust the chunk size to fit the remaining memory ! in the parcel container @@ -362,7 +475,7 @@ subroutine read_netcdf_parcels(fname) ! update start index to fill container pfirst = 1 + n_parcels - plast = min(pfirst + avail_size, n_total_parcels, max_num_parcels) + plast = min(pfirst + avail_size, n_total, max_num_parcels) ! we must make sure that we have enough data in the ! file as well as in the parcel container @@ -372,8 +485,6 @@ subroutine read_netcdf_parcels(fname) start_index = 1 + end_index end_index = end_index + n_read enddo - - deallocate(invalid) endif call close_netcdf_file(ncid) @@ -400,6 +511,45 @@ subroutine read_netcdf_parcels(fname) end subroutine read_netcdf_parcels + !:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + + subroutine rejection_method(start_index, end_index, pfirst) + integer, intent(in) :: start_index + integer, intent(in) :: end_index + integer, intent(in) :: pfirst + integer :: m, k, n_read + integer, allocatable :: invalid(:) + + call read_chunk(start_index, end_index, pfirst) + n_read = end_index - start_index + 1 + n_parcels = n_parcels + n_read + + ! if all MPI ranks read all parcels, each MPI rank must delete the parcels + ! not belonging to its domain + allocate(invalid(0:n_read)) + + m = 1 + do k = pfirst, n_parcels + if (is_contained(parcels%position(:, k))) then + cycle + endif + + invalid(m) = k + + m = m + 1 + enddo + + ! remove last increment + m = m - 1 + + ! updates the variable n_parcels + call parcel_delete(invalid(0:m), n_del=m) + + deallocate(invalid) + + end subroutine rejection_method + + !:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ! This subroutine assumes the NetCDF file to be open. subroutine read_chunk(first, last, pfirst) @@ -407,6 +557,9 @@ subroutine read_chunk(first, last, pfirst) logical :: l_valid = .false. integer :: cnt(2), start(2) integer :: num, plast +#ifdef ENABLE_LABELS + integer :: n +#endif num = last - first + 1 plast = pfirst + num - 1 @@ -513,19 +666,29 @@ subroutine read_chunk(first, last, pfirst) #ifndef ENABLE_DRY_MODE if (has_dataset(ncid, 'qv')) then + l_valid = .true. call read_netcdf_dataset(ncid, 'qv', & parcels%qv(pfirst:plast), start, cnt) endif - if (has_dataset(ncid, 'ql')) then + l_valid = .true. call read_netcdf_dataset(ncid, 'ql', & parcels%ql(pfirst:plast), start, cnt) endif #endif +#ifdef ENABLE_LABELS + ! reset the labels to Fortran index which corresponds to current label + ! reset the dilution to get this from time step to time step + do n = pfirst, plast + parcels%label(n) = first + n - pfirst + parcels%dilution(n) = 0 + end do +#endif + if (.not. l_valid) then call mpi_exit_on_error(& - "Either the parcel buoyancy or vorticity must be present! Exiting.") + "Either the parcel theta or vorticity must be present! Exiting.") endif end subroutine read_chunk @@ -551,9 +714,17 @@ subroutine set_netcdf_parcel_output #ifndef ENABLE_DRY_MODE nc_dset(NC_QV)%l_enabled = .true. nc_dset(NC_QL)%l_enabled = .true. +#endif +#ifdef ENABLE_LABELS + nc_dset(NC_LABEL)%l_enabled = .true. + nc_dset(NC_DILUTION)%l_enabled = .true. #endif nc_dset(NC_VOL)%l_enabled = .true. nc_dset(NC_START)%l_enabled = .true. + nc_dset(NC_XLO)%l_enabled = .true. + nc_dset(NC_XHI)%l_enabled = .true. + nc_dset(NC_YLO)%l_enabled = .true. + nc_dset(NC_YHI)%l_enabled = .true. nc_dset(NC_B11)%l_enabled = .true. nc_dset(NC_B12)%l_enabled = .true. nc_dset(NC_B13)%l_enabled = .true. @@ -581,6 +752,10 @@ subroutine set_netcdf_parcel_output print *, "" endif nc_dset(NC_START)%l_enabled = .true. + nc_dset(NC_XLO)%l_enabled = .true. + nc_dset(NC_XHI)%l_enabled = .true. + nc_dset(NC_YLO)%l_enabled = .true. + nc_dset(NC_YHI)%l_enabled = .true. nc_dset(NC_X_POS)%l_enabled = .true. nc_dset(NC_Y_POS)%l_enabled = .true. nc_dset(NC_Z_POS)%l_enabled = .true. @@ -591,6 +766,10 @@ subroutine set_netcdf_parcel_output #ifndef ENABLE_DRY_MODE nc_dset(NC_QV)%l_enabled = .true. nc_dset(NC_QL)%l_enabled = .true. +#endif +#ifdef ENABLE_LABELS + nc_dset(NC_LABEL)%l_enabled = .true. + nc_dset(NC_DILUTION)%l_enabled = .true. #endif nc_dset(NC_VOL)%l_enabled = .true. nc_dset(NC_B11)%l_enabled = .true. @@ -635,7 +814,7 @@ subroutine set_netcdf_parcel_output if ((.not. l_enabled_restart) .and. (world%rank == world%root)) then print *, "WARNING: EPIC will not be able to restart from a parcel file." print *, " You must at least write the B-shape matrix, parcel position" - print *, " parcel volume and parcel vorticity or buoyancy to enable a" + print *, " parcel volume and parcel vorticity or theta to enable a" print *, " restart. If you intend to restart from a parcel file later," print *, " you must stop the simulation immediately. Furthermore, you can" print *, " write the MPI 'start_index' to speed up the restart." @@ -672,6 +851,30 @@ subroutine set_netcdf_parcel_info unit='1', & dtype=NF90_INT) + nc_dset(NC_XLO) = netcdf_info(name='xlo', & + long_name='lower box boundary in x', & + std_name='', & + unit='1', & + dtype=NF90_INT) + + nc_dset(NC_XHI) = netcdf_info(name='xhi', & + long_name='upper box boundary in x', & + std_name='', & + unit='1', & + dtype=NF90_INT) + + nc_dset(NC_YLO) = netcdf_info(name='ylo', & + long_name='lower box boundary in y', & + std_name='', & + unit='1', & + dtype=NF90_INT) + + nc_dset(NC_YHI) = netcdf_info(name='yhi', & + long_name='upper box boundary in y', & + std_name='', & + unit='1', & + dtype=NF90_INT) + nc_dset(NC_B11) = netcdf_info(name='B11', & long_name='B11 element of shape matrix', & std_name='', & @@ -726,23 +929,35 @@ subroutine set_netcdf_parcel_info unit='1/s', & dtype=NF90_DOUBLE) - nc_dset(NC_THETA) = netcdf_info(name='theta', & - long_name='potential temperature', & + nc_dset(NC_THETA) = netcdf_info(name='theta' , & + long_name='parcel potential temperature', & std_name='', & unit='K', & dtype=NF90_DOUBLE) #ifndef ENABLE_DRY_MODE - nc_dset(NC_QV) = netcdf_info(name='qv', & - long_name='water vapor mixing ratio', & - std_name='', & - unit='kg/kg', & + nc_dset(NC_QV) = netcdf_info(name='qv', & + long_name='parcel water vapour mixing ratio', & + std_name='', & + unit='1', & + dtype=NF90_DOUBLE) + nc_dset(NC_QL) = netcdf_info(name='ql', & + long_name='parcel liquid water mixing ratio', & + std_name='', & + unit='1', & dtype=NF90_DOUBLE) - - nc_dset(NC_QL) = netcdf_info(name='ql', & - long_name='liquid water mixing ratio', & - std_name='', & - unit='kg/kg', & +#endif +#ifdef ENABLE_LABELS + nc_dset(NC_LABEL) = netcdf_info(name='label', & + long_name='parcel label', & + std_name='', & + unit='1', & + dtype=NF90_INT64) + + nc_dset(NC_DILUTION) = netcdf_info(name='dilution', & + long_name='parcel log dilution', & + std_name='', & + unit='1', & dtype=NF90_DOUBLE) #endif end subroutine set_netcdf_parcel_info From 7a32e18a5ba611479083dd214aef674ca1f84a5f Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Wed, 23 Oct 2024 15:50:36 +0100 Subject: [PATCH 27/34] Remove additional fields no longer used --- src/3d/fields/fields.f90 | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/src/3d/fields/fields.f90 b/src/3d/fields/fields.f90 index e5155f235..2d27820bd 100644 --- a/src/3d/fields/fields.f90 +++ b/src/3d/fields/fields.f90 @@ -21,7 +21,6 @@ module fields double precision, allocatable, dimension(:, :, :, :) :: & velog, & ! velocity vector field (u, v, w) vortg, & ! vorticity vector field (\xi, \eta, \zeta) - vortpg, & ! vorticity pertubation tendency vtend, & ! vorticity tendency velgradg ! velocity gradient tensor ! ordering: du/dx, du/dy, @@ -39,11 +38,8 @@ module fields #ifndef ENABLE_DRY_MODE qvg, & ! humidity qlg, & ! liquid water - qvpg, & ! humidity perturbation tendency - qlpg, & ! liquid water perturbation tendency #endif thetag, & ! dry buoyancy (or liquid-water buoyancy) - thetapg, & ! theta perturbation tendency tbuoyg, & ! buoyancy #ifndef NDEBUG sym_volg, & ! symmetry volume (debug mode only) @@ -94,18 +90,14 @@ subroutine field_alloc #endif allocate(vortg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1), n_dim)) - allocate(vortpg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1), n_dim)) allocate(vtend(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1), n_dim)) allocate(tbuoyg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) allocate(thetag(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) - allocate(thetapg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) #ifndef ENABLE_DRY_MODE allocate(qvg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) allocate(qlg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) - allocate(qvpg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) - allocate(qlpg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) #endif allocate(nparg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) @@ -124,16 +116,12 @@ subroutine field_default volg = zero strain_mag = zero vortg = zero - vortpg = zero vtend = zero tbuoyg = zero - thetapg = zero thetag = zero #ifndef ENABLE_DRY_MODE qvg = zero qlg = zero - qvpg = zero - qlpg = zero #endif nparg = zero nsparg = zero @@ -152,17 +140,13 @@ subroutine field_dealloc deallocate(velgradg) deallocate(strain_mag) deallocate(volg) - deallocate(vortpg) deallocate(vortg) deallocate(vtend) deallocate(tbuoyg) - deallocate(thetapg) deallocate(thetag) #ifndef ENABLE_DRY_MODE deallocate(qvg) deallocate(qlg) - deallocate(qvpg) - deallocate(qlpg) #endif deallocate(nparg) deallocate(nsparg) From 6641f3b7da555e655e514eb143c35acf3f40064a Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Wed, 23 Oct 2024 15:52:52 +0100 Subject: [PATCH 28/34] Delete post-processing script that only calculates mean mass-flux --- epic_mean.py | 9 --------- 1 file changed, 9 deletions(-) delete mode 100644 epic_mean.py diff --git a/epic_mean.py b/epic_mean.py deleted file mode 100644 index b0eec659e..000000000 --- a/epic_mean.py +++ /dev/null @@ -1,9 +0,0 @@ -from pylab import * -import xarray as xr - -ds=xr.open_dataset('fomex_fields.nc') -ds['mfcup']=ds['z_velocity']*(ds['z_velocity']>0.)*(ds['ql']>1e-8) -ds_mean=ds.mean(dim=["x", "y"]) -ds_mean.to_netcdf('fomex_mean.nc') -mfmean=ds_mean['mfcup'][-15:-1].mean(dim="t") -mfmean.to_netcdf('fomex_mfmean.nc') From f2d23a46b06ee319bf96d6854a5b659372a4c861 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Wed, 23 Oct 2024 16:32:27 +0100 Subject: [PATCH 29/34] Add options for ls_forcings --- examples/fomex.config | 3 +++ src/3d/parcels/parcel_ls_forcings.f90 | 13 ++++++++----- src/3d/utils/options.f90 | 15 ++++++++++++++- 3 files changed, 25 insertions(+), 6 deletions(-) diff --git a/examples/fomex.config b/examples/fomex.config index ff20b6127..48a7e374c 100755 --- a/examples/fomex.config +++ b/examples/fomex.config @@ -27,6 +27,9 @@ parcel%correction_iters = 2 ! how many parcel correction iterations parcel%gradient_pref = 1.8 ! gradient correction prefactor parcel%max_compression = 0.5 ! gradient correction maximum compression + + ! BOMEX ls forcings + forcings%l_ls_forcings = .true. ! use BOMEX large-scale forcings ! ! stepper info diff --git a/src/3d/parcels/parcel_ls_forcings.f90 b/src/3d/parcels/parcel_ls_forcings.f90 index 52da29f73..8fdcf5eb7 100644 --- a/src/3d/parcels/parcel_ls_forcings.f90 +++ b/src/3d/parcels/parcel_ls_forcings.f90 @@ -5,7 +5,7 @@ module parcel_ls_forcings use constants, only : zero, one, pi use mpi_timer, only : start_timer, stop_timer - use options, only : parcel + use options, only : parcel, forcings use parameters, only : nx,ny,nz, dxi, dx use parcel_container, only : parcels, n_parcels use parcel_ellipsoid @@ -27,10 +27,13 @@ module parcel_ls_forcings contains subroutine apply_ls_forcings(dt) - double precision, intent(in) :: dt - call apply_subsidence_and_vorticity_adjustment(dt) - call apply_ls_tendencies(dt) - call saturation_adjustment + double precision, intent(in) :: dt + if(forcings%l_ls_forcings) then + call apply_subsidence_and_vorticity_adjustment(dt) + call apply_ls_tendencies(dt) + call saturation_adjustment + end if + end subroutine apply_ls_forcings ! ! @pre diff --git a/src/3d/utils/options.f90 b/src/3d/utils/options.f90 index af37a4de6..618258615 100644 --- a/src/3d/utils/options.f90 +++ b/src/3d/utils/options.f90 @@ -77,6 +77,17 @@ module options ! logical :: allow_larger_anisotropy = .false. + + ! + ! + ! + type forcings_type + ! use large-scale forcing + logical :: l_ls_forcings = .false. + end type forcings_type + + type(forcings_type) :: forcings + ! ! parcel options ! @@ -131,7 +142,7 @@ subroutine read_config_file logical :: exists = .false. ! namelist definitions - namelist /EPIC/ field_file, flux_file, rk_order, boundary, output, parcel, time, damping + namelist /EPIC/ field_file, flux_file, rk_order, boundary, output, parcel, forcings, time, damping ! check whether file exists inquire(file=filename, exist=exists) @@ -188,6 +199,8 @@ subroutine write_netcdf_options(ncid) call write_netcdf_attribute(ncid, "correction_iters", parcel%correction_iters) call write_netcdf_attribute(ncid, "gradient_pref", parcel%gradient_pref) call write_netcdf_attribute(ncid, "max_compression", parcel%max_compression) + + call write_netcdf_attribute(ncid, "l_ls_forcings", forcings%l_ls_forcings) call write_netcdf_attribute(ncid, "parcel_freq", output%parcel_freq) call write_netcdf_attribute(ncid, "field_freq", output%field_freq) From d7b60de7c56df928628fd9a9c932c06d545e59e8 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Thu, 24 Oct 2024 10:49:12 +0100 Subject: [PATCH 30/34] Remove double allocation --- python-scripts/tools/epic_config.py.in | 26 -------------------------- src/3d/fields/fields.f90 | 1 - 2 files changed, 27 deletions(-) delete mode 100644 python-scripts/tools/epic_config.py.in diff --git a/python-scripts/tools/epic_config.py.in b/python-scripts/tools/epic_config.py.in deleted file mode 100644 index e86001961..000000000 --- a/python-scripts/tools/epic_config.py.in +++ /dev/null @@ -1,26 +0,0 @@ -# Name of package -package = "@PACKAGE@" - -# Define to the address where bug reports for this package should be sent. -package_bugreport = "@PACKAGE_BUGREPORT@" - -# Define to the full name of this package. -package_name = "@PACKAGE_NAME@" - -# Define to the full name and version of this package. -package_string = "@PACKAGE_STRING@" - -# Define to the one symbol short name of this package. -package_tarname = "@PACKAGE_TARNAME@" - -# Define to the home page for this package. -package_url = "@PACKAGE_URL@" - -# Define to the version of this package. -package_version = "@PACKAGE_VERSION@" - -# Version number of package -version = "@VERSION@" - -# Version of the CF-convention -cf_version = "CF-1.8" diff --git a/src/3d/fields/fields.f90 b/src/3d/fields/fields.f90 index 2d27820bd..2e9a2e676 100644 --- a/src/3d/fields/fields.f90 +++ b/src/3d/fields/fields.f90 @@ -83,7 +83,6 @@ subroutine field_alloc allocate(strain_mag(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) allocate(volg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) - allocate(strain_mag(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) #ifndef NDEBUG allocate(sym_volg(hlo(3):hhi(3), hlo(2):hhi(2), hlo(1):hhi(1))) From ee973b67a261b8e49d39754fac918f56a128add3 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Fri, 25 Oct 2024 15:28:34 +0100 Subject: [PATCH 31/34] Whitespace: revert --- mpi-tests/test_parcel_merge_random.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/mpi-tests/test_parcel_merge_random.f90 b/mpi-tests/test_parcel_merge_random.f90 index 90bd05f46..d221e18b3 100644 --- a/mpi-tests/test_parcel_merge_random.f90 +++ b/mpi-tests/test_parcel_merge_random.f90 @@ -89,6 +89,7 @@ program test_parcel_merge_random if (rn(3) > 0.5d0) then call random_number(rn(3)) j = nint(n_parcels * rn(3)) + 1 + if (.not. picked(j)) then parcels%volume(j) = 0.9d0 * vmin picked(j) = .true. From da12cae22097288e65911326a03fc324d345cf36 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Fri, 25 Oct 2024 15:29:29 +0100 Subject: [PATCH 32/34] Add call to saturation adjustment, remove needless call to get_strain_magnitude --- src/3d/epic3d.f90 | 7 ++++++- src/3d/stepper/ls_rk.f90 | 1 - 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/src/3d/epic3d.f90 b/src/3d/epic3d.f90 index 332d6b569..9b8930d9c 100644 --- a/src/3d/epic3d.f90 +++ b/src/3d/epic3d.f90 @@ -37,6 +37,7 @@ program epic3d use inversion_utils, only : init_inversion, finalise_inversion use parcel_interpl, only : grid2par_timer, & par2grid_timer, & + saturation_adjustment, & halo_swap_timer use parcel_init, only : init_timer use ls_rk, only : ls_rk_step, rk_timer, ls_rk_setup @@ -133,6 +134,7 @@ subroutine run do while (t < time%limit) + ! no longer apply vorticity correction for real cases !call apply_vortcor call ls_rk_step(t) @@ -149,9 +151,12 @@ subroutine run call apply_gradient(parcel%gradient_pref, parcel%max_compression, .true.) enddo + ! call saturation adjustment again after all corrections + call saturation_adjustment + enddo - ! write final step (we only write if we really advanced in time) + ! write final step (we only write if we really advanced in time) if (t > time%initial) then !call apply_vortcor call write_last_step(t) diff --git a/src/3d/stepper/ls_rk.f90 b/src/3d/stepper/ls_rk.f90 index 490ebeb21..cb266923e 100644 --- a/src/3d/stepper/ls_rk.f90 +++ b/src/3d/stepper/ls_rk.f90 @@ -129,7 +129,6 @@ subroutine ls_rk_step(t) call apply_parcel_reflective_bc call stop_timer(rk_timer) - call get_strain_magnitude_field call parcel_damp(dt) call apply_ls_forcings(dt) From cbba6cf1f309bdb0db4d206b491a3c7b348904ec Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Fri, 25 Oct 2024 15:29:52 +0100 Subject: [PATCH 33/34] File renaming --- python-scripts/{bomex_fluxes.py => bomex_with_fluxes.py} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename python-scripts/{bomex_fluxes.py => bomex_with_fluxes.py} (100%) diff --git a/python-scripts/bomex_fluxes.py b/python-scripts/bomex_with_fluxes.py similarity index 100% rename from python-scripts/bomex_fluxes.py rename to python-scripts/bomex_with_fluxes.py From e53efe9e3e2c5d98c7a7e0e2dddd6949833a72b9 Mon Sep 17 00:00:00 2001 From: Steven Boeing Date: Fri, 25 Oct 2024 16:17:03 +0100 Subject: [PATCH 34/34] Revent epic_config.py.in --- python-scripts/tools/epic_config.py.in | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100644 python-scripts/tools/epic_config.py.in diff --git a/python-scripts/tools/epic_config.py.in b/python-scripts/tools/epic_config.py.in new file mode 100644 index 000000000..e86001961 --- /dev/null +++ b/python-scripts/tools/epic_config.py.in @@ -0,0 +1,26 @@ +# Name of package +package = "@PACKAGE@" + +# Define to the address where bug reports for this package should be sent. +package_bugreport = "@PACKAGE_BUGREPORT@" + +# Define to the full name of this package. +package_name = "@PACKAGE_NAME@" + +# Define to the full name and version of this package. +package_string = "@PACKAGE_STRING@" + +# Define to the one symbol short name of this package. +package_tarname = "@PACKAGE_TARNAME@" + +# Define to the home page for this package. +package_url = "@PACKAGE_URL@" + +# Define to the version of this package. +package_version = "@PACKAGE_VERSION@" + +# Version number of package +version = "@VERSION@" + +# Version of the CF-convention +cf_version = "CF-1.8"