New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
bdyvol.F90 in NEMO/trunk/src/OCE/BDY – NEMO

source: NEMO/trunk/src/OCE/BDY/bdyvol.F90 @ 10425

Last change on this file since 10425 was 10425, checked in by smasson, 5 years ago

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

  • Property svn:keywords set to Id
File size: 7.9 KB
RevLine 
[911]1MODULE bdyvol
[1125]2   !!======================================================================
[911]3   !!                       ***  MODULE  bdyvol  ***
4   !! Ocean dynamic :  Volume constraint when unstructured boundary
[3294]5   !!                  and filtered free surface are used
[1125]6   !!======================================================================
7   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
8   !!             -   !  2006-01  (J. Chanut) Bug correction
9   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
[3294]10   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
[1125]11   !!----------------------------------------------------------------------
[6140]12   USE oce            ! ocean dynamics and tracers
13   USE bdy_oce        ! ocean open boundary conditions
14   USE sbc_oce        ! ocean surface boundary conditions
15   USE dom_oce        ! ocean space and time domain
16   USE phycst         ! physical constants
17   USE sbcisf         ! ice shelf
[5836]18   !
[6140]19   USE in_out_manager ! I/O manager
20   USE lib_mpp        ! for mppsum
21   USE lib_fortran    ! Fortran routines library
[911]22
23   IMPLICIT NONE
24   PRIVATE
25
[6140]26   PUBLIC   bdy_vol    ! called by ???
[911]27
[1125]28   !!----------------------------------------------------------------------
[9598]29   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[1146]30   !! $Id$
[10068]31   !! Software governed by the CeCILL license (see ./LICENSE)
[1125]32   !!----------------------------------------------------------------------
[911]33CONTAINS
34
[1125]35   SUBROUTINE bdy_vol( kt )
36      !!----------------------------------------------------------------------
[911]37      !!                      ***  ROUTINE bdyvol  ***
38      !!
[5930]39      !! ** Purpose :   This routine controls the volume of the system.
[6140]40      !!      A correction velocity is calculated to correct the total transport
41      !!      through the unstructured OBC.
[911]42      !!      The total depth used is constant (H0) to be consistent with the
[6140]43      !!      linear free surface coded in OPA 8.2    <<<=== !!gm  ???? true ????
[911]44      !!
[1125]45      !! ** Method  :   The correction velocity (zubtpecor here) is defined calculating
[911]46      !!      the total transport through all open boundaries (trans_bdy) minus
[1125]47      !!      the cumulate E-P flux (z_cflxemp) divided by the total lateral
[911]48      !!      surface (bdysurftot) of the unstructured boundary.
[1125]49      !!         zubtpecor = [trans_bdy - z_cflxemp ]*(1./bdysurftot)
50      !!      with z_cflxemp => sum of (Evaporation minus Precipitation)
[911]51      !!                       over all the domain in m3/s at each time step.
[1125]52      !!      z_cflxemp < 0 when precipitation dominate
53      !!      z_cflxemp > 0 when evaporation dominate
[911]54      !!
55      !!      There are 2 options (user's desiderata):
56      !!         1/ The volume changes according to E-P, this is the default
57      !!            option. In this case the cumulate E-P flux are setting to
[1125]58      !!            zero (z_cflxemp=0) to calculate the correction velocity. So
[911]59      !!            it will only balance the flux through open boundaries.
[2528]60      !!            (set nn_volctl to 0 in tne namelist for this option)
[911]61      !!         2/ The volume is constant even with E-P flux. In this case
62      !!            the correction velocity must balance both the flux
63      !!            through open boundaries and the ones through the free
64      !!            surface.
[2528]65      !!            (set nn_volctl to 1 in tne namelist for this option)
[1125]66      !!----------------------------------------------------------------------
[6140]67      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
68      !
[1125]69      INTEGER  ::   ji, jj, jk, jb, jgrd
[3294]70      INTEGER  ::   ib_bdy, ii, ij
[2528]71      REAL(wp) ::   zubtpecor, z_cflxemp, ztranst
[3294]72      TYPE(OBC_INDEX), POINTER :: idx
[911]73      !!-----------------------------------------------------------------------------
[5836]74      !
[2528]75      IF( ln_vol ) THEN
[5836]76      !
[911]77      IF( kt == nit000 ) THEN
[1125]78         IF(lwp) WRITE(numout,*)
[911]79         IF(lwp) WRITE(numout,*)'bdy_vol : Correction of velocities along unstructured OBC'
80         IF(lwp) WRITE(numout,*)'~~~~~~~'
81      END IF 
82
[1125]83      ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
84      ! -----------------------------------------------------------------------
[5836]85!!gm replace these lines :
[6140]86      z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0
[10425]87      CALL mpp_sum( 'bdyvol', z_cflxemp )     ! sum over the global domain
[5836]88!!gm   by :
[10425]89!!gm      z_cflxemp = glob_sum(  'bdyvol', ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0
[5836]90!!gm
[911]91
[2528]92      ! Transport through the unstructured open boundary
93      ! ------------------------------------------------
[5836]94      zubtpecor = 0._wp
[3294]95      DO ib_bdy = 1, nb_bdy
96         idx => idx_bdy(ib_bdy)
[5836]97         !
[3294]98         jgrd = 2                               ! cumulate u component contribution first
99         DO jb = 1, idx%nblenrim(jgrd)
100            DO jk = 1, jpkm1
101               ii = idx%nbi(jb,jgrd)
102               ij = idx%nbj(jb,jgrd)
[6140]103               zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * e3u_n(ii,ij,jk)
[3294]104            END DO
[1125]105         END DO
[3294]106         jgrd = 3                               ! then add v component contribution
107         DO jb = 1, idx%nblenrim(jgrd)
108            DO jk = 1, jpkm1
109               ii = idx%nbi(jb,jgrd)
110               ij = idx%nbj(jb,jgrd)
[6140]111               zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * e3v_n(ii,ij,jk) 
[3294]112            END DO
[1125]113         END DO
[5836]114         !
[911]115      END DO
[10425]116      CALL mpp_sum( 'bdyvol', zubtpecor )   ! sum over the global domain
[911]117
[1125]118      ! The normal velocity correction
119      ! ------------------------------
[6140]120      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp ) / bdysurftot 
121      ELSE                      ;   zubtpecor =   zubtpecor               / bdysurftot
[911]122      END IF
123
[1125]124      ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation
125      ! -------------------------------------------------------------
[5836]126      ztranst = 0._wp
[3294]127      DO ib_bdy = 1, nb_bdy
128         idx => idx_bdy(ib_bdy)
[5836]129         !
[3294]130         jgrd = 2                               ! correct u component
131         DO jb = 1, idx%nblenrim(jgrd)
132            DO jk = 1, jpkm1
133               ii = idx%nbi(jb,jgrd)
134               ij = idx%nbj(jb,jgrd)
[4292]135               ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk)
[6140]136               ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * e3u_n(ii,ij,jk)
[3294]137            END DO
[1125]138         END DO
[3294]139         jgrd = 3                              ! correct v component
140         DO jb = 1, idx%nblenrim(jgrd)
141            DO jk = 1, jpkm1
142               ii = idx%nbi(jb,jgrd)
143               ij = idx%nbj(jb,jgrd)
[4292]144               va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk)
[6140]145               ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * e3v_n(ii,ij,jk)
[3294]146            END DO
[1125]147         END DO
[5836]148         !
[911]149      END DO
[10425]150      CALL mpp_sum( 'bdyvol', ztranst )   ! sum over the global domain
[911]151 
[1125]152      ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected
153      ! ------------------------------------------------------
[6140]154      IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN
[1125]155         IF(lwp) WRITE(numout,*)
156         IF(lwp) WRITE(numout,*)'bdy_vol : time step :', kt
157         IF(lwp) WRITE(numout,*)'~~~~~~~ '
158         IF(lwp) WRITE(numout,*)'          cumulate flux EMP             =', z_cflxemp  , ' (m3/s)'
159         IF(lwp) WRITE(numout,*)'          total lateral surface of OBC  =', bdysurftot, '(m2)'
160         IF(lwp) WRITE(numout,*)'          correction velocity zubtpecor =', zubtpecor , '(m/s)'
161         IF(lwp) WRITE(numout,*)'          cumulated transport ztranst   =', ztranst   , '(m3/s)'
[911]162      END IF 
[1125]163      !
[2528]164      END IF ! ln_vol
[5836]165      !
[911]166   END SUBROUTINE bdy_vol
167
[1125]168   !!======================================================================
[911]169END MODULE bdyvol
Note: See TracBrowser for help on using the repository browser.