!> @file nesting_offl_mod.f90 !------------------------------------------------------------------------------! ! This file is part of the PALM model system. ! ! PALM is free software: you can redistribute it and/or modify it under the ! terms of the GNU General Public License as published by the Free Software ! Foundation, either version 3 of the License, or (at your option) any later ! version. ! ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 1997-2018 Leibniz Universitaet Hannover !------------------------------------------------------------------------------! ! ! Current revisions: ! ------------------ ! ! ! Former revisions: ! ----------------- ! $Id: nesting_offl_mod.f90 3579 2018-11-29 15:32:39Z eckhard $ ! Check implemented for offline nesting in child domain ! ! 3413 2018-10-24 10:28:44Z suehring ! Keyword ID set ! ! 3404 2018-10-23 13:29:11Z suehring ! Consider time-dependent geostrophic wind components in offline nesting ! ! ! Initial Revision: ! - separate offline nesting from large_scale_nudging_mod ! - revise offline nesting, adjust for usage of synthetic turbulence generator ! - adjust Rayleigh damping depending on the time-depending atmospheric ! conditions ! ! ! Description: ! ------------ !> Offline nesting in larger-scale models. Boundary conditions for the simulation !> are read from NetCDF file and are prescribed onto the respective arrays. !> Further, a mass-flux correction is performed to maintain the mass balance. !--------------------------------------------------------------------------------! MODULE nesting_offl_mod USE arrays_3d, & ONLY: dzw, e, diss, pt, pt_init, q, q_init, s, u, u_init, ug, v, & v_init, vg, w, zu, zw USE control_parameters, & ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, bc_dirichlet_s, & dt_3d, dz, constant_diffusion, humidity, message_string, & nesting_offline, neutral, passive_scalar, rans_mode, rans_tke_e,& time_since_reference_point, volume_flow USE cpulog, & ONLY: cpu_log, log_point USE grid_variables USE indices, & ONLY: nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nys, & nysv, nysg, nyn, nyng, nzb, nz, nzt, wall_flags_0 USE kinds USE netcdf_data_input_mod, & ONLY: nest_offl USE pegrid REAL(wp) :: zi_ribulk = 0.0_wp !< boundary-layer depth according to bulk Richardson criterion, i.e. the height where Ri_bulk exceeds the critical !< bulk Richardson number of 0.25 SAVE PRIVATE ! !-- Public subroutines PUBLIC nesting_offl_bc, nesting_offl_check_parameters, nesting_offl_header,& nesting_offl_init, nesting_offl_mass_conservation, nesting_offl_parin ! !-- Public variables PUBLIC zi_ribulk INTERFACE nesting_offl_bc MODULE PROCEDURE nesting_offl_bc END INTERFACE nesting_offl_bc INTERFACE nesting_offl_check_parameters MODULE PROCEDURE nesting_offl_check_parameters END INTERFACE nesting_offl_check_parameters INTERFACE nesting_offl_header MODULE PROCEDURE nesting_offl_header END INTERFACE nesting_offl_header INTERFACE nesting_offl_init MODULE PROCEDURE nesting_offl_init END INTERFACE nesting_offl_init INTERFACE nesting_offl_mass_conservation MODULE PROCEDURE nesting_offl_mass_conservation END INTERFACE nesting_offl_mass_conservation INTERFACE nesting_offl_parin MODULE PROCEDURE nesting_offl_parin END INTERFACE nesting_offl_parin CONTAINS !------------------------------------------------------------------------------! ! Description: ! ------------ !> In this subroutine a constant mass within the model domain is guaranteed. !> Larger-scale models may be based on a compressible equation system, which is !> not consistent with PALMs incompressible equation system. In order to avoid !> a decrease or increase of mass during the simulation, non-divergent flow !> through the lateral and top boundaries is compensated by the vertical wind !> component at the top boundary. !------------------------------------------------------------------------------! SUBROUTINE nesting_offl_mass_conservation IMPLICIT NONE INTEGER(iwp) :: i !< grid index in x-direction INTEGER(iwp) :: j !< grid index in y-direction INTEGER(iwp) :: k !< grid index in z-direction REAL(wp) :: d_area_t !< inverse of the total area of the horizontal model domain REAL(wp) :: w_correct !< vertical velocity increment required to compensate non-divergent flow through the boundaries REAL(wp), DIMENSION(1:3) :: volume_flow_l !< local volume flow CALL cpu_log( log_point(58), 'offline nesting', 'start' ) volume_flow = 0.0_wp volume_flow_l = 0.0_wp d_area_t = 1.0_wp / ( ( nx + 1 ) * dx * ( ny + 1 ) * dy ) IF ( bc_dirichlet_l ) THEN i = nxl DO j = nys, nyn DO k = nzb+1, nzt volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k) * dy & * MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,i), 1 ) ) ENDDO ENDDO ENDIF IF ( bc_dirichlet_r ) THEN i = nxr+1 DO j = nys, nyn DO k = nzb+1, nzt volume_flow_l(1) = volume_flow_l(1) - u(k,j,i) * dzw(k) * dy & * MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,i), 1 ) ) ENDDO ENDDO ENDIF IF ( bc_dirichlet_s ) THEN j = nys DO i = nxl, nxr DO k = nzb+1, nzt volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k) * dx & * MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,i), 2 ) ) ENDDO ENDDO ENDIF IF ( bc_dirichlet_n ) THEN j = nyn+1 DO i = nxl, nxr DO k = nzb+1, nzt volume_flow_l(2) = volume_flow_l(2) - v(k,j,i) * dzw(k) * dx & * MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,i), 2 ) ) ENDDO ENDDO ENDIF ! !-- Top boundary k = nzt DO i = nxl, nxr DO j = nys, nyn volume_flow_l(3) = volume_flow_l(3) - w(k,j,i) * dx * dy ENDDO ENDDO #if defined( __parallel ) IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) CALL MPI_ALLREDUCE( volume_flow_l, volume_flow, 3, MPI_REAL, MPI_SUM, & comm2d, ierr ) #else volume_flow = volume_flow_l #endif w_correct = SUM( volume_flow ) * d_area_t DO i = nxl, nxr DO j = nys, nyn DO k = nzt, nzt + 1 w(k,j,i) = w(k,j,i) + w_correct ENDDO ENDDO ENDDO CALL cpu_log( log_point(58), 'offline nesting', 'stop' ) END SUBROUTINE nesting_offl_mass_conservation !------------------------------------------------------------------------------! ! Description: ! ------------ !> Set the lateral and top boundary conditions in case the PALM domain is !> nested offline in a mesoscale model. Further, average boundary data and !> determine mean profiles, further used for correct damping in the sponge !> layer. !------------------------------------------------------------------------------! SUBROUTINE nesting_offl_bc IMPLICIT NONE INTEGER(iwp) :: i !< running index x-direction INTEGER(iwp) :: j !< running index y-direction INTEGER(iwp) :: k !< running index z-direction REAL(wp) :: fac_dt !< interpolation factor REAL(wp), DIMENSION(nzb:nzt+1) :: pt_ref !< reference profile for potential temperature REAL(wp), DIMENSION(nzb:nzt+1) :: pt_ref_l !< reference profile for potential temperature on subdomain REAL(wp), DIMENSION(nzb:nzt+1) :: q_ref !< reference profile for mixing ratio on subdomain REAL(wp), DIMENSION(nzb:nzt+1) :: q_ref_l !< reference profile for mixing ratio on subdomain REAL(wp), DIMENSION(nzb:nzt+1) :: u_ref !< reference profile for u-component on subdomain REAL(wp), DIMENSION(nzb:nzt+1) :: u_ref_l !< reference profile for u-component on subdomain REAL(wp), DIMENSION(nzb:nzt+1) :: v_ref !< reference profile for v-component on subdomain REAL(wp), DIMENSION(nzb:nzt+1) :: v_ref_l !< reference profile for v-component on subdomain CALL cpu_log( log_point(58), 'offline nesting', 'start' ) ! !-- Set mean profiles, derived from boundary data, to zero pt_ref = 0.0_wp q_ref = 0.0_wp u_ref = 0.0_wp v_ref = 0.0_wp pt_ref_l = 0.0_wp q_ref_l = 0.0_wp u_ref_l = 0.0_wp v_ref_l = 0.0_wp ! !-- Determine interpolation factor and limit it to 1. This is because !-- t+dt can slightly exceed time(tind_p) before boundary data is updated !-- again. fac_dt = ( time_since_reference_point - nest_offl%time(nest_offl%tind) & + dt_3d ) / & ( nest_offl%time(nest_offl%tind_p) - nest_offl%time(nest_offl%tind) ) fac_dt = MIN( 1.0_wp, fac_dt ) ! !-- Set boundary conditions of u-, v-, w-component, as well as q, and pt. !-- Note, boundary values at the left boundary: i=-1 (v,w,pt,q) and !-- i=0 (u), at the right boundary: i=nxr+1 (all), at the south boundary: !-- j=-1 (u,w,pt,q) and j=0 (v), at the north boundary: j=nyn+1 (all). !-- Please note, at the left (for u) and south (for v) boundary, values !-- for u and v are set also at i/j=-1, since these values are used in !-- boundary_conditions() to restore prognostic values. !-- Further, sum up data to calculate mean profiles from boundary data, !-- used for Rayleigh damping. IF ( bc_dirichlet_l ) THEN DO j = nys, nyn DO k = nzb+1, nzt u(k,j,0) = interpolate_in_time( nest_offl%u_left(0,k,j), & nest_offl%u_left(1,k,j), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,0), 1 ) ) u(k,j,-1) = u(k,j,0) ENDDO u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,0) ENDDO DO j = nys, nyn DO k = nzb+1, nzt-1 w(k,j,-1) = interpolate_in_time( nest_offl%w_left(0,k,j), & nest_offl%w_left(1,k,j), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,-1), 3 ) ) ENDDO ENDDO DO j = nysv, nyn DO k = nzb+1, nzt v(k,j,-1) = interpolate_in_time( nest_offl%v_left(0,k,j), & nest_offl%v_left(1,k,j), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,-1), 2 ) ) ENDDO v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,-1) ENDDO IF ( .NOT. neutral ) THEN DO j = nys, nyn DO k = nzb+1, nzt pt(k,j,-1) = interpolate_in_time( nest_offl%pt_left(0,k,j), & nest_offl%pt_left(1,k,j), & fac_dt ) ENDDO pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,-1) ENDDO ENDIF IF ( humidity ) THEN DO j = nys, nyn DO k = nzb+1, nzt q(k,j,-1) = interpolate_in_time( nest_offl%q_left(0,k,j), & nest_offl%q_left(1,k,j), & fac_dt ) ENDDO q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,-1) ENDDO ENDIF ENDIF IF ( bc_dirichlet_r ) THEN DO j = nys, nyn DO k = nzb+1, nzt u(k,j,nxr+1) = interpolate_in_time( nest_offl%u_right(0,k,j), & nest_offl%u_right(1,k,j), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,nxr+1), 1 ) ) ENDDO u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,nxr+1) ENDDO DO j = nys, nyn DO k = nzb+1, nzt-1 w(k,j,nxr+1) = interpolate_in_time( nest_offl%w_right(0,k,j), & nest_offl%w_right(1,k,j), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,nxr+1), 3 ) ) ENDDO ENDDO DO j = nysv, nyn DO k = nzb+1, nzt v(k,j,nxr+1) = interpolate_in_time( nest_offl%v_right(0,k,j), & nest_offl%v_right(1,k,j), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,j,nxr+1), 2 ) ) ENDDO v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,nxr+1) ENDDO IF ( .NOT. neutral ) THEN DO j = nys, nyn DO k = nzb+1, nzt pt(k,j,nxr+1) = interpolate_in_time( & nest_offl%pt_right(0,k,j), & nest_offl%pt_right(1,k,j), & fac_dt ) ENDDO pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,nxr+1) ENDDO ENDIF IF ( humidity ) THEN DO j = nys, nyn DO k = nzb+1, nzt q(k,j,nxr+1) = interpolate_in_time( & nest_offl%q_right(0,k,j), & nest_offl%q_right(1,k,j), & fac_dt ) ENDDO q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,nxr+1) ENDDO ENDIF ENDIF IF ( bc_dirichlet_s ) THEN DO i = nxl, nxr DO k = nzb+1, nzt v(k,0,i) = interpolate_in_time( nest_offl%v_south(0,k,i), & nest_offl%v_south(1,k,i), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,0,i), 2 ) ) v(k,-1,i) = v(k,0,i) ENDDO v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,0,i) ENDDO DO i = nxl, nxr DO k = nzb+1, nzt-1 w(k,-1,i) = interpolate_in_time( nest_offl%w_south(0,k,i), & nest_offl%w_south(1,k,i), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,-1,i), 3 ) ) ENDDO ENDDO DO i = nxlu, nxr DO k = nzb+1, nzt u(k,-1,i) = interpolate_in_time( nest_offl%u_south(0,k,i), & nest_offl%u_south(1,k,i), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,-1,i), 1 ) ) ENDDO u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,-1,i) ENDDO IF ( .NOT. neutral ) THEN DO i = nxl, nxr DO k = nzb+1, nzt pt(k,-1,i) = interpolate_in_time( & nest_offl%pt_south(0,k,i), & nest_offl%pt_south(1,k,i), & fac_dt ) ENDDO pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,-1,i) ENDDO ENDIF IF ( humidity ) THEN DO i = nxl, nxr DO k = nzb+1, nzt q(k,-1,i) = interpolate_in_time( & nest_offl%q_south(0,k,i), & nest_offl%q_south(1,k,i), & fac_dt ) ENDDO q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,-1,i) ENDDO ENDIF ENDIF IF ( bc_dirichlet_n ) THEN DO i = nxl, nxr DO k = nzb+1, nzt v(k,nyn+1,i) = interpolate_in_time( nest_offl%v_north(0,k,i), & nest_offl%v_north(1,k,i), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,nyn+1,i), 2 ) ) ENDDO v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,nyn+1,i) ENDDO DO i = nxl, nxr DO k = nzb+1, nzt-1 w(k,nyn+1,i) = interpolate_in_time( nest_offl%w_north(0,k,i), & nest_offl%w_north(1,k,i), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,nyn+1,i), 3 ) ) ENDDO ENDDO DO i = nxlu, nxr DO k = nzb+1, nzt u(k,nyn+1,i) = interpolate_in_time( nest_offl%u_north(0,k,i), & nest_offl%u_north(1,k,i), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(k,nyn+1,i), 1 ) ) ENDDO u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,nyn+1,i) ENDDO IF ( .NOT. neutral ) THEN DO i = nxl, nxr DO k = nzb+1, nzt pt(k,nyn+1,i) = interpolate_in_time( & nest_offl%pt_north(0,k,i), & nest_offl%pt_north(1,k,i), & fac_dt ) ENDDO pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,nyn+1,i) ENDDO ENDIF IF ( humidity ) THEN DO i = nxl, nxr DO k = nzb+1, nzt q(k,nyn+1,i) = interpolate_in_time( & nest_offl%q_north(0,k,i), & nest_offl%q_north(1,k,i), & fac_dt ) ENDDO q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,nyn+1,i) ENDDO ENDIF ENDIF ! !-- Top boundary DO i = nxlu, nxr DO j = nys, nyn u(nzt+1,j,i) = interpolate_in_time( nest_offl%u_top(0,j,i), & nest_offl%u_top(1,j,i), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(nzt+1,j,i), 1 ) ) u_ref_l(nzt+1) = u_ref_l(nzt+1) + u(nzt+1,j,i) ENDDO ENDDO DO i = nxl, nxr DO j = nysv, nyn v(nzt+1,j,i) = interpolate_in_time( nest_offl%v_top(0,j,i), & nest_offl%v_top(1,j,i), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(nzt+1,j,i), 2 ) ) v_ref_l(nzt+1) = v_ref_l(nzt+1) + v(nzt+1,j,i) ENDDO ENDDO DO i = nxl, nxr DO j = nys, nyn w(nzt,j,i) = interpolate_in_time( nest_offl%w_top(0,j,i), & nest_offl%w_top(1,j,i), & fac_dt ) * & MERGE( 1.0_wp, 0.0_wp, & BTEST( wall_flags_0(nzt,j,i), 3 ) ) w(nzt+1,j,i) = w(nzt,j,i) ENDDO ENDDO IF ( .NOT. neutral ) THEN DO i = nxl, nxr DO j = nys, nyn pt(nzt+1,j,i) = interpolate_in_time( nest_offl%pt_top(0,j,i), & nest_offl%pt_top(1,j,i), & fac_dt ) pt_ref_l(nzt+1) = pt_ref_l(nzt+1) + pt(nzt+1,j,i) ENDDO ENDDO ENDIF IF ( humidity ) THEN DO i = nxl, nxr DO j = nys, nyn q(nzt+1,j,i) = interpolate_in_time( nest_offl%q_top(0,j,i), & nest_offl%q_top(1,j,i), & fac_dt ) q_ref_l(nzt+1) = q_ref_l(nzt+1) + q(nzt+1,j,i) ENDDO ENDDO ENDIF ! !-- Moreover, set Neumann boundary condition for subgrid-scale TKE, !-- passive scalar, dissipation, and chemical species if required IF ( rans_mode .AND. rans_tke_e ) THEN IF ( bc_dirichlet_l ) diss(:,:,nxl-1) = diss(:,:,nxl) IF ( bc_dirichlet_r ) diss(:,:,nxr+1) = diss(:,:,nxr) IF ( bc_dirichlet_s ) diss(:,nys-1,:) = diss(:,nys,:) IF ( bc_dirichlet_n ) diss(:,nyn+1,:) = diss(:,nyn,:) ENDIF IF ( .NOT. constant_diffusion ) THEN IF ( bc_dirichlet_l ) e(:,:,nxl-1) = e(:,:,nxl) IF ( bc_dirichlet_r ) e(:,:,nxr+1) = e(:,:,nxr) IF ( bc_dirichlet_s ) e(:,nys-1,:) = e(:,nys,:) IF ( bc_dirichlet_n ) e(:,nyn+1,:) = e(:,nyn,:) e(nzt+1,:,:) = e(nzt,:,:) ENDIF IF ( passive_scalar ) THEN IF ( bc_dirichlet_l ) s(:,:,nxl-1) = s(:,:,nxl) IF ( bc_dirichlet_r ) s(:,:,nxr+1) = s(:,:,nxr) IF ( bc_dirichlet_s ) s(:,nys-1,:) = s(:,nys,:) IF ( bc_dirichlet_n ) s(:,nyn+1,:) = s(:,nyn,:) ENDIF CALL exchange_horiz( u, nbgp ) CALL exchange_horiz( v, nbgp ) CALL exchange_horiz( w, nbgp ) IF ( .NOT. neutral ) CALL exchange_horiz( pt, nbgp ) IF ( humidity ) CALL exchange_horiz( q, nbgp ) ! !-- In case of Rayleigh damping, where the profiles u_init, v_init !-- q_init and pt_init are still used, update these profiles from the !-- averaged boundary data. !-- But first, average these data. #if defined( __parallel ) CALL MPI_ALLREDUCE( u_ref_l, u_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, & comm2d, ierr ) CALL MPI_ALLREDUCE( v_ref_l, v_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, & comm2d, ierr ) IF ( humidity ) THEN CALL MPI_ALLREDUCE( q_ref_l, q_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, & comm2d, ierr ) ENDIF IF ( .NOT. neutral ) THEN CALL MPI_ALLREDUCE( pt_ref_l, pt_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM,& comm2d, ierr ) ENDIF #else u_ref = u_ref_l v_ref = v_ref_l IF ( humidity ) q_ref = q_ref_l IF ( .NOT. neutral ) pt_ref = pt_ref_l #endif ! !-- Average data. Note, reference profiles up to nzt are derived from lateral !-- boundaries, at the model top it is derived from the top boundary. Thus, !-- number of input data is different from nzb:nzt compared to nzt+1. !-- Derived from lateral boundaries. u_ref(nzb:nzt) = u_ref(nzb:nzt) / REAL( 2.0_wp * ( ny + 1 + nx ), & KIND = wp ) v_ref(nzb:nzt) = v_ref(nzb:nzt) / REAL( 2.0_wp * ( ny + nx + 1 ), & KIND = wp ) IF ( humidity ) & q_ref(nzb:nzt) = q_ref(nzb:nzt) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), & KIND = wp ) IF ( .NOT. neutral ) & pt_ref(nzb:nzt) = pt_ref(nzb:nzt) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), & KIND = wp ) ! !-- Derived from top boundary. u_ref(nzt+1) = u_ref(nzt+1) / REAL( ( ny + 1 ) * ( nx ), KIND = wp ) v_ref(nzt+1) = v_ref(nzt+1) / REAL( ( ny ) * ( nx + 1 ), KIND = wp ) IF ( humidity ) & q_ref(nzt+1) = q_ref(nzt+1) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp ) IF ( .NOT. neutral ) & pt_ref(nzt+1) = pt_ref(nzt+1) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp ) ! !-- Write onto init profiles, which are used for damping u_init = u_ref v_init = v_ref IF ( humidity ) q_init = q_ref IF ( .NOT. neutral ) pt_init = pt_ref ! !-- Set bottom boundary condition IF ( humidity ) q_init(nzb) = q_init(nzb+1) IF ( .NOT. neutral ) pt_init(nzb) = pt_init(nzb+1) ! !-- Further, adjust Rayleigh damping height in case of time-changing conditions. !-- Therefore, calculate boundary-layer depth first. CALL calc_zi CALL adjust_sponge_layer ! !-- Update geostrophic wind components from dynamic input file. DO k = nzb+1, nzt ug(k) = interpolate_in_time( nest_offl%ug(0,k), nest_offl%ug(1,k), & fac_dt ) vg(k) = interpolate_in_time( nest_offl%vg(0,k), nest_offl%vg(1,k), & fac_dt ) ENDDO ug(nzt+1) = ug(nzt) vg(nzt+1) = vg(nzt) CALL cpu_log( log_point(58), 'offline nesting', 'stop' ) END SUBROUTINE nesting_offl_bc !------------------------------------------------------------------------------! ! Description: !------------------------------------------------------------------------------! !> Calculates the boundary-layer depth from the boundary data, according to !> bulk-Richardson criterion. !------------------------------------------------------------------------------! SUBROUTINE calc_zi USE basic_constants_and_equations_mod, & ONLY: g USE kinds USE surface_mod, & ONLY: get_topography_top_index, get_topography_top_index_ji IMPLICIT NONE INTEGER(iwp) :: i !< loop index in x-direction INTEGER(iwp) :: j !< loop index in y-direction INTEGER(iwp) :: k !< loop index in z-direction INTEGER(iwp) :: k_surface !< topography top index in z-direction REAL(wp) :: ri_bulk !< bulk Richardson number REAL(wp) :: ri_bulk_crit = 0.25_wp !< critical bulk Richardson number REAL(wp) :: topo_max !< maximum topography level in model domain REAL(wp) :: topo_max_l !< maximum topography level in subdomain REAL(wp) :: u_comp !< u-component REAL(wp) :: v_comp !< v-component REAL(wp) :: vpt_surface !< near-surface virtual potential temperature REAL(wp) :: zi_l !< mean boundary-layer depth on subdomain REAL(wp) :: zi_local !< local boundary-layer depth REAL(wp), DIMENSION(nzb:nzt+1) :: vpt_col !< vertical profile of virtual potential temperature at (j,i)-grid point ! !-- Calculate mean boundary-layer height from boundary data. !-- Start with the left and right boundaries. zi_l = 0.0_wp IF ( bc_dirichlet_l .OR. bc_dirichlet_r ) THEN ! !-- Determine index along x. Please note, index indicates boundary !-- grid point for scalars. i = MERGE( -1, nxr + 1, bc_dirichlet_l ) DO j = nys, nyn ! !-- Determine topography top index at current (j,i) index k_surface = get_topography_top_index_ji( j, i, 's' ) ! !-- Pre-compute surface virtual temperature. Therefore, use 2nd !-- prognostic level according to Heinze et al. (2017). IF ( humidity ) THEN vpt_surface = pt(k_surface+2,j,i) * & ( 1.0_wp + 0.61_wp * q(k_surface+2,j,i) ) vpt_col = pt(:,j,i) * ( 1.0_wp + 0.61_wp * q(:,j,i) ) ELSE vpt_surface = pt(k_surface+2,j,i) vpt_col = pt(:,j,i) ENDIF ! !-- Calculate local boundary layer height from bulk Richardson number, !-- i.e. the height where the bulk Richardson number exceeds its !-- critical value of 0.25 (according to Heinze et al., 2017). !-- Note, no interpolation of u- and v-component is made, as both !-- are mainly mean inflow profiles with very small spatial variation. zi_local = 0.0_wp DO k = k_surface+1, nzt u_comp = MERGE( u(k,j,i+1), u(k,j,i), bc_dirichlet_l ) v_comp = v(k,j,i) ri_bulk = zu(k) * g / vpt_surface * & ( vpt_col(k) - vpt_surface ) / & ( u_comp * u_comp + v_comp * v_comp ) IF ( zi_local == 0.0_wp .AND. ri_bulk > ri_bulk_crit ) & zi_local = zu(k) ENDDO ! !-- Assure that the minimum local boundary-layer depth is at least at !-- the second vertical grid level. zi_l = zi_l + MAX( zi_local, zu(k_surface+2) ) ENDDO ENDIF ! !-- Do the same at the north and south boundaries. IF ( bc_dirichlet_s .OR. bc_dirichlet_n ) THEN j = MERGE( -1, nyn + 1, bc_dirichlet_s ) DO i = nxl, nxr k_surface = get_topography_top_index_ji( j, i, 's' ) IF ( humidity ) THEN vpt_surface = pt(k_surface+2,j,i) * & ( 1.0_wp + 0.61_wp * q(k_surface+2,j,i) ) vpt_col = pt(:,j,i) * ( 1.0_wp + 0.61_wp * q(:,j,i) ) ELSE vpt_surface = pt(k_surface+2,j,i) vpt_col = pt(:,j,i) ENDIF zi_local = 0.0_wp DO k = k_surface+1, nzt u_comp = u(k,j,i) v_comp = MERGE( v(k,j+1,i), v(k,j,i), bc_dirichlet_s ) ri_bulk = zu(k) * g / vpt_surface * & ( vpt_col(k) - vpt_surface ) / & ( u_comp * u_comp + v_comp * v_comp ) IF ( zi_local == 0.0_wp .AND. ri_bulk > 0.25_wp ) & zi_local = zu(k) ENDDO zi_l = zi_l + MAX( zi_local, zu(k_surface+2) ) ENDDO ENDIF #if defined( __parallel ) CALL MPI_ALLREDUCE( zi_l, zi_ribulk, 1, MPI_REAL, MPI_SUM, & comm2d, ierr ) #else zi_ribulk = zi_l #endif zi_ribulk = zi_ribulk / REAL( 2 * nx + 2 * ny, KIND = wp ) ! !-- Finally, check if boundary layer depth is not below the any topography. !-- zi_ribulk will be used to adjust rayleigh damping height, i.e. the !-- lower level of the sponge layer, as well as to adjust the synthetic !-- turbulence generator accordingly. If Rayleigh damping would be applied !-- near buildings, etc., this would spoil the simulation results. topo_max_l = zw(MAXVAL( get_topography_top_index( 's' ))) #if defined( __parallel ) CALL MPI_ALLREDUCE( topo_max_l, topo_max, 1, MPI_REAL, MPI_MAX, & comm2d, ierr ) #else topo_max = topo_max_l #endif zi_ribulk = MAX( zi_ribulk, topo_max ) END SUBROUTINE calc_zi !------------------------------------------------------------------------------! ! Description: !------------------------------------------------------------------------------! !> Adjust the height where the rayleigh damping starts, i.e. the lower level !> of the sponge layer. !------------------------------------------------------------------------------! SUBROUTINE adjust_sponge_layer USE arrays_3d, & ONLY: rdf, rdf_sc, zu USE basic_constants_and_equations_mod, & ONLY: pi USE control_parameters, & ONLY: rayleigh_damping_height, rayleigh_damping_factor USE kinds IMPLICIT NONE INTEGER(iwp) :: k !< loop index in z-direction REAL(wp) :: rdh !< updated Rayleigh damping height IF ( rayleigh_damping_height > 0.0_wp .AND. & rayleigh_damping_factor > 0.0_wp ) THEN ! !-- Update Rayleigh-damping height and re-calculate height-depending !-- damping coefficients. !-- Assure that rayleigh damping starts well above the boundary layer. rdh = MIN( MAX( zi_ribulk * 1.3_wp, 10.0_wp * dz(1) ), & 0.8_wp * zu(nzt), rayleigh_damping_height ) ! !-- Update Rayleigh damping factor DO k = nzb+1, nzt IF ( zu(k) >= rdh ) THEN rdf(k) = rayleigh_damping_factor * & ( SIN( pi * 0.5_wp * ( zu(k) - rdh ) & / ( zu(nzt) - rdh ) ) & )**2 ENDIF ENDDO rdf_sc = rdf ENDIF END SUBROUTINE adjust_sponge_layer !------------------------------------------------------------------------------! ! Description: ! ------------ !> Performs consistency checks !------------------------------------------------------------------------------! SUBROUTINE nesting_offl_check_parameters USE control_parameters, & ONLY: child_domain, message_string, nesting_offline IMPLICIT NONE ! !-- Perform checks IF ( nesting_offline .AND. child_domain ) THEN message_string = 'Offline nesting is only applicable in root model.' CALL message( 'stg_check_parameters', 'PA0622', 1, 2, 0, 6, 0 ) ENDIF END SUBROUTINE nesting_offl_check_parameters !------------------------------------------------------------------------------! ! Description: ! ------------ !> Reads the parameter list nesting_offl_parameters !------------------------------------------------------------------------------! SUBROUTINE nesting_offl_parin IMPLICIT NONE CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file NAMELIST /nesting_offl_parameters/ nesting_offline line = ' ' ! !-- Try to find stg package REWIND ( 11 ) line = ' ' DO WHILE ( INDEX( line, '&nesting_offl_parameters' ) == 0 ) READ ( 11, '(A)', END=20 ) line ENDDO BACKSPACE ( 11 ) ! !-- Read namelist READ ( 11, nesting_offl_parameters, ERR = 10, END = 20 ) GOTO 20 10 BACKSPACE( 11 ) READ( 11 , '(A)') line CALL parin_fail_message( 'nesting_offl_parameters', line ) 20 CONTINUE END SUBROUTINE nesting_offl_parin !------------------------------------------------------------------------------! ! Description: ! ------------ !> Writes information about offline nesting into HEADER file !------------------------------------------------------------------------------! SUBROUTINE nesting_offl_header ( io ) IMPLICIT NONE INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file WRITE ( io, 1 ) IF ( nesting_offline ) THEN WRITE ( io, 3 ) ELSE WRITE ( io, 2 ) ENDIF 1 FORMAT (//' Offline nesting in COSMO model:'/ & ' -------------------------------'/) 2 FORMAT (' --> No offlince nesting is used (default) ') 3 FORMAT (' --> Offlince nesting is used. Boundary data is read from dynamic input file ') END SUBROUTINE nesting_offl_header !------------------------------------------------------------------------------! ! Description: ! ------------ !> Allocate arrays used to read boundary data from NetCDF file and initialize !> boundary data. !------------------------------------------------------------------------------! SUBROUTINE nesting_offl_init USE netcdf_data_input_mod, & ONLY: netcdf_data_input_offline_nesting IMPLICIT NONE !-- Allocate arrays for geostrophic wind components. Arrays will !-- incorporate 2 time levels in order to interpolate in between. ALLOCATE( nest_offl%ug(0:1,1:nzt) ) ALLOCATE( nest_offl%vg(0:1,1:nzt) ) ! !-- Allocate arrays for reading boundary values. Arrays will incorporate 2 !-- time levels in order to interpolate in between. IF ( bc_dirichlet_l ) THEN ALLOCATE( nest_offl%u_left(0:1,nzb+1:nzt,nys:nyn) ) ALLOCATE( nest_offl%v_left(0:1,nzb+1:nzt,nysv:nyn) ) ALLOCATE( nest_offl%w_left(0:1,nzb+1:nzt-1,nys:nyn) ) IF ( humidity ) ALLOCATE( nest_offl%q_left(0:1,nzb+1:nzt,nys:nyn) ) IF ( .NOT. neutral ) ALLOCATE( nest_offl%pt_left(0:1,nzb+1:nzt,nys:nyn) ) ENDIF IF ( bc_dirichlet_r ) THEN ALLOCATE( nest_offl%u_right(0:1,nzb+1:nzt,nys:nyn) ) ALLOCATE( nest_offl%v_right(0:1,nzb+1:nzt,nysv:nyn) ) ALLOCATE( nest_offl%w_right(0:1,nzb+1:nzt-1,nys:nyn) ) IF ( humidity ) ALLOCATE( nest_offl%q_right(0:1,nzb+1:nzt,nys:nyn) ) IF ( .NOT. neutral ) ALLOCATE( nest_offl%pt_right(0:1,nzb+1:nzt,nys:nyn) ) ENDIF IF ( bc_dirichlet_n ) THEN ALLOCATE( nest_offl%u_north(0:1,nzb+1:nzt,nxlu:nxr) ) ALLOCATE( nest_offl%v_north(0:1,nzb+1:nzt,nxl:nxr) ) ALLOCATE( nest_offl%w_north(0:1,nzb+1:nzt-1,nxl:nxr) ) IF ( humidity ) ALLOCATE( nest_offl%q_north(0:1,nzb+1:nzt,nxl:nxr) ) IF ( .NOT. neutral ) ALLOCATE( nest_offl%pt_north(0:1,nzb+1:nzt,nxl:nxr) ) ENDIF IF ( bc_dirichlet_s ) THEN ALLOCATE( nest_offl%u_south(0:1,nzb+1:nzt,nxlu:nxr) ) ALLOCATE( nest_offl%v_south(0:1,nzb+1:nzt,nxl:nxr) ) ALLOCATE( nest_offl%w_south(0:1,nzb+1:nzt-1,nxl:nxr) ) IF ( humidity ) ALLOCATE( nest_offl%q_south(0:1,nzb+1:nzt,nxl:nxr) ) IF ( .NOT. neutral ) ALLOCATE( nest_offl%pt_south(0:1,nzb+1:nzt,nxl:nxr) ) ENDIF ALLOCATE( nest_offl%u_top(0:1,nys:nyn,nxlu:nxr) ) ALLOCATE( nest_offl%v_top(0:1,nysv:nyn,nxl:nxr) ) ALLOCATE( nest_offl%w_top(0:1,nys:nyn,nxl:nxr) ) IF ( humidity ) ALLOCATE( nest_offl%q_top(0:1,nys:nyn,nxl:nxr) ) IF ( .NOT. neutral ) ALLOCATE( nest_offl%pt_top(0:1,nys:nyn,nxl:nxr) ) ! !-- Read COSMO data at lateral and top boundaries CALL netcdf_data_input_offline_nesting ! !-- Initialize boundary data. IF ( bc_dirichlet_l ) THEN u(nzb+1:nzt,nys:nyn,0) = nest_offl%u_left(0,nzb+1:nzt,nys:nyn) v(nzb+1:nzt,nysv:nyn,-1) = nest_offl%v_left(0,nzb+1:nzt,nysv:nyn) w(nzb+1:nzt-1,nys:nyn,-1) = nest_offl%w_left(0,nzb+1:nzt-1,nys:nyn) IF ( .NOT. neutral ) pt(nzb+1:nzt,nys:nyn,-1) = & nest_offl%pt_left(0,nzb+1:nzt,nys:nyn) IF ( humidity ) q(nzb+1:nzt,nys:nyn,-1) = & nest_offl%q_left(0,nzb+1:nzt,nys:nyn) ENDIF IF ( bc_dirichlet_r ) THEN u(nzb+1:nzt,nys:nyn,nxr+1) = nest_offl%u_right(0,nzb+1:nzt,nys:nyn) v(nzb+1:nzt,nysv:nyn,nxr+1) = nest_offl%v_right(0,nzb+1:nzt,nysv:nyn) w(nzb+1:nzt-1,nys:nyn,nxr+1) = nest_offl%w_right(0,nzb+1:nzt-1,nys:nyn) IF ( .NOT. neutral ) pt(nzb+1:nzt,nys:nyn,nxr+1) = & nest_offl%pt_right(0,nzb+1:nzt,nys:nyn) IF ( humidity ) q(nzb+1:nzt,nys:nyn,nxr+1) = & nest_offl%q_right(0,nzb+1:nzt,nys:nyn) ENDIF IF ( bc_dirichlet_s ) THEN u(nzb+1:nzt,-1,nxlu:nxr) = nest_offl%u_south(0,nzb+1:nzt,nxlu:nxr) v(nzb+1:nzt,0,nxl:nxr) = nest_offl%v_south(0,nzb+1:nzt,nxl:nxr) w(nzb+1:nzt-1,-1,nxl:nxr) = nest_offl%w_south(0,nzb+1:nzt-1,nxl:nxr) IF ( .NOT. neutral ) pt(nzb+1:nzt,-1,nxl:nxr) = & nest_offl%pt_south(0,nzb+1:nzt,nxl:nxr) IF ( humidity ) q(nzb+1:nzt,-1,nxl:nxr) = & nest_offl%q_south(0,nzb+1:nzt,nxl:nxr) ENDIF IF ( bc_dirichlet_n ) THEN u(nzb+1:nzt,nyn+1,nxlu:nxr) = nest_offl%u_north(0,nzb+1:nzt,nxlu:nxr) v(nzb+1:nzt,nyn+1,nxl:nxr) = nest_offl%v_north(0,nzb+1:nzt,nxl:nxr) w(nzb+1:nzt-1,nyn+1,nxl:nxr) = nest_offl%w_north(0,nzb+1:nzt-1,nxl:nxr) IF ( .NOT. neutral ) pt(nzb+1:nzt,nyn+1,nxl:nxr) = & nest_offl%pt_north(0,nzb+1:nzt,nxl:nxr) IF ( humidity ) q(nzb+1:nzt,nyn+1,nxl:nxr) = & nest_offl%q_north(0,nzb+1:nzt,nxl:nxr) ENDIF ! !-- Initialize geostrophic wind components. Actually this is already done in !-- init_3d_model when initializing_action = 'inifor', however, in speical !-- case of user-defined initialization this will be done here again, in !-- order to have a consistent initialization. ug(nzb+1:nzt) = nest_offl%ug(0,nzb+1:nzt) vg(nzb+1:nzt) = nest_offl%vg(0,nzb+1:nzt) ! !-- Set bottom and top boundary condition for geostrophic wind components ug(nzt+1) = ug(nzt) vg(nzt+1) = vg(nzt) ug(nzb) = ug(nzb+1) vg(nzb) = vg(nzb+1) ! !-- Initial calculation of the boundary layer depth from the prescribed !-- boundary data. This is requiered for initialize the synthetic turbulence !-- generator correctly. CALL calc_zi ! !-- After boundary data is initialized, mask topography at the !-- boundaries for the velocity components. u = MERGE( u, 0.0_wp, BTEST( wall_flags_0, 1 ) ) v = MERGE( v, 0.0_wp, BTEST( wall_flags_0, 2 ) ) w = MERGE( w, 0.0_wp, BTEST( wall_flags_0, 3 ) ) CALL calc_zi ! !-- After boundary data is initialized, ensure mass conservation CALL nesting_offl_mass_conservation END SUBROUTINE nesting_offl_init !------------------------------------------------------------------------------! ! Description: !------------------------------------------------------------------------------! !> Interpolation function, used to interpolate boundary data in time. !------------------------------------------------------------------------------! FUNCTION interpolate_in_time( var_t1, var_t2, fac ) USE kinds IMPLICIT NONE REAL(wp) :: interpolate_in_time !< time-interpolated boundary value REAL(wp) :: var_t1 !< boundary value at t1 REAL(wp) :: var_t2 !< boundary value at t2 REAL(wp) :: fac !< interpolation factor interpolate_in_time = ( 1.0_wp - fac ) * var_t1 + fac * var_t2 END FUNCTION interpolate_in_time END MODULE nesting_offl_mod