MODULE bdyvol !!====================================================================== !! *** MODULE bdyvol *** !! Ocean dynamic : Volume constraint when unstructured boundary !! and Free surface are used !!====================================================================== !! History : 1.0 ! 2005-01 (J. Chanut, A. Sellar) Original code !! - ! 2006-01 (J. Chanut) Bug correction !! 3.0 ! 2008-04 (NEMO team) add in the reference version !!---------------------------------------------------------------------- #if defined key_bdy && defined key_dynspg_flt !!---------------------------------------------------------------------- !! 'key_bdy' and unstructured open boundary conditions !! 'key_dynspg_flt' filtered free surface !!---------------------------------------------------------------------- USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE bdy_oce ! ocean open boundary conditions USE lib_mpp ! for mppsum USE in_out_manager ! I/O manager USE sbc_oce ! ocean surface boundary conditions IMPLICIT NONE PRIVATE PUBLIC bdy_vol ! routine called by dynspg_flt.h90 !! * Substitutions # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) !! $Id: bdyvol.F90 1146 2008-06-25 11:42:56Z rblod $ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE bdy_vol( kt ) !!---------------------------------------------------------------------- !! *** ROUTINE bdyvol *** !! !! ** Purpose : This routine is called in dynspg_flt to control !! the volume of the system. A correction velocity is calculated !! to correct the total transport through the unstructured OBC. !! The total depth used is constant (H0) to be consistent with the !! linear free surface coded in OPA 8.2 !! !! ** Method : The correction velocity (zubtpecor here) is defined calculating !! the total transport through all open boundaries (trans_bdy) minus !! the cumulate E-P flux (z_cflxemp) divided by the total lateral !! surface (bdysurftot) of the unstructured boundary. !! zubtpecor = [trans_bdy - z_cflxemp ]*(1./bdysurftot) !! with z_cflxemp => sum of (Evaporation minus Precipitation) !! over all the domain in m3/s at each time step. !! z_cflxemp < 0 when precipitation dominate !! z_cflxemp > 0 when evaporation dominate !! !! There are 2 options (user's desiderata): !! 1/ The volume changes according to E-P, this is the default !! option. In this case the cumulate E-P flux are setting to !! zero (z_cflxemp=0) to calculate the correction velocity. So !! it will only balance the flux through open boundaries. !! (set volbdy to 0 in tne namelist for this option) !! 2/ The volume is constant even with E-P flux. In this case !! the correction velocity must balance both the flux !! through open boundaries and the ones through the free !! surface. !! (set volbdy to 1 in tne namelist for this option) !!---------------------------------------------------------------------- INTEGER, INTENT( in ) :: kt ! ocean time-step index !! INTEGER :: ji, jj, jk, jb, jgrd INTEGER :: ii, ij REAL(wp) :: zubtpecor, z_cflxemp, ztranst, zraur !!----------------------------------------------------------------------------- IF( kt == nit000 ) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*)'bdy_vol : Correction of velocities along unstructured OBC' IF(lwp) WRITE(numout,*)'~~~~~~~' END IF ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain ! ----------------------------------------------------------------------- z_cflxemp = 0.e0 zraur = 1.e0 / rauw z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) * zraur ) IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain ! Barotropic velocity through the unstructured open boundary ! ---------------------------------------------------------- zubtpecor = 0.e0 jgrd = 2 ! cumulate u component contribution first DO jb = 1, nblenrim(jgrd) DO jk = 1, jpkm1 ii = nbi(jb,jgrd) ij = nbj(jb,jgrd) zubtpecor = zubtpecor + flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) END DO END DO jgrd = 3 ! then add v component contribution DO jb = 1, nblenrim(jgrd) DO jk = 1, jpkm1 ii = nbi(jb,jgrd) ij = nbj(jb,jgrd) zubtpecor = zubtpecor + flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk) END DO END DO IF( lk_mpp ) CALL mpp_sum( zubtpecor ) ! sum over the global domain ! The normal velocity correction ! ------------------------------ IF (volbdy==1) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot ELSE ; zubtpecor = zubtpecor / bdysurftot END IF ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation ! ------------------------------------------------------------- ztranst = 0.e0 jgrd = 2 ! correct u component DO jb = 1, nblenrim(jgrd) DO jk = 1, jpkm1 ii = nbi(jb,jgrd) ij = nbj(jb,jgrd) ua(ii,ij,jk) = ua(ii,ij,jk) - flagu(jb) * zubtpecor * umask(ii,ij,jk) ztranst = ztranst + flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) END DO END DO jgrd = 3 ! correct v component DO jb = 1, nblenrim(jgrd) DO jk = 1, jpkm1 ii = nbi(jb,jgrd) ij = nbj(jb,jgrd) va(ii,ij,jk) = va(ii,ij,jk) -flagv(jb) * zubtpecor * vmask(ii,ij,jk) ztranst = ztranst + flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) END DO END DO IF( lk_mpp ) CALL mpp_sum( ztranst ) ! sum over the global domain ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected ! ------------------------------------------------------ IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*)'bdy_vol : time step :', kt IF(lwp) WRITE(numout,*)'~~~~~~~ ' IF(lwp) WRITE(numout,*)' cumulate flux EMP =', z_cflxemp , ' (m3/s)' IF(lwp) WRITE(numout,*)' total lateral surface of OBC =', bdysurftot, '(m2)' IF(lwp) WRITE(numout,*)' correction velocity zubtpecor =', zubtpecor , '(m/s)' IF(lwp) WRITE(numout,*)' cumulated transport ztranst =', ztranst , '(m3/s)' END IF ! END SUBROUTINE bdy_vol #else !!---------------------------------------------------------------------- !! Dummy module NO Unstruct Open Boundary Conditions !!---------------------------------------------------------------------- CONTAINS SUBROUTINE bdy_vol( kt ) ! Empty routine WRITE(*,*) 'bdy_vol: You should not have seen this print! error?', kt END SUBROUTINE bdy_vol #endif !!====================================================================== END MODULE bdyvol