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 branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90 @ 3186

Last change on this file since 3186 was 3182, checked in by davestorkey, 13 years ago

Change dynamic allocation and add timing to BDY module.

  • Property svn:keywords set to Id
File size: 8.4 KB
Line 
1MODULE bdyvol
2   !!======================================================================
3   !!                       ***  MODULE  bdyvol  ***
4   !! Ocean dynamic :  Volume constraint when unstructured boundary
5   !!                  and Free surface are used
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
10   !!----------------------------------------------------------------------
11#if   defined key_bdy   &&   defined key_dynspg_flt
12   !!----------------------------------------------------------------------
13   !!   'key_bdy'            AND      unstructured open boundary conditions
14   !!   'key_dynspg_flt'                              filtered free surface
15   !!----------------------------------------------------------------------
16   USE timing          ! Timing
17   USE oce             ! ocean dynamics and tracers
18   USE dom_oce         ! ocean space and time domain
19   USE phycst          ! physical constants
20   USE bdy_oce         ! ocean open boundary conditions
21   USE lib_mpp         ! for mppsum
22   USE in_out_manager  ! I/O manager
23   USE sbc_oce         ! ocean surface boundary conditions
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC bdy_vol        ! routine called by dynspg_flt.h90
29
30   !! * Substitutions
31#  include "domzgr_substitute.h90"
32   !!----------------------------------------------------------------------
33   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
34   !! $Id$
35   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
36   !!----------------------------------------------------------------------
37CONTAINS
38
39   SUBROUTINE bdy_vol( kt )
40      !!----------------------------------------------------------------------
41      !!                      ***  ROUTINE bdyvol  ***
42      !!
43      !! ** Purpose :   This routine is called in dynspg_flt to control
44      !!      the volume of the system. A correction velocity is calculated
45      !!      to correct the total transport through the unstructured OBC.
46      !!      The total depth used is constant (H0) to be consistent with the
47      !!      linear free surface coded in OPA 8.2
48      !!
49      !! ** Method  :   The correction velocity (zubtpecor here) is defined calculating
50      !!      the total transport through all open boundaries (trans_bdy) minus
51      !!      the cumulate E-P flux (z_cflxemp) divided by the total lateral
52      !!      surface (bdysurftot) of the unstructured boundary.
53      !!         zubtpecor = [trans_bdy - z_cflxemp ]*(1./bdysurftot)
54      !!      with z_cflxemp => sum of (Evaporation minus Precipitation)
55      !!                       over all the domain in m3/s at each time step.
56      !!      z_cflxemp < 0 when precipitation dominate
57      !!      z_cflxemp > 0 when evaporation dominate
58      !!
59      !!      There are 2 options (user's desiderata):
60      !!         1/ The volume changes according to E-P, this is the default
61      !!            option. In this case the cumulate E-P flux are setting to
62      !!            zero (z_cflxemp=0) to calculate the correction velocity. So
63      !!            it will only balance the flux through open boundaries.
64      !!            (set nn_volctl to 0 in tne namelist for this option)
65      !!         2/ The volume is constant even with E-P flux. In this case
66      !!            the correction velocity must balance both the flux
67      !!            through open boundaries and the ones through the free
68      !!            surface.
69      !!            (set nn_volctl to 1 in tne namelist for this option)
70      !!----------------------------------------------------------------------
71      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
72      !!
73      INTEGER  ::   ji, jj, jk, jb, jgrd
74      INTEGER  ::   ib_bdy, ii, ij
75      REAL(wp) ::   zubtpecor, z_cflxemp, ztranst
76      TYPE(OBC_INDEX), POINTER :: idx
77      !!-----------------------------------------------------------------------------
78
79      IF( nn_timing == 1 ) CALL timing_start('bdy_vol')
80
81      IF( ln_vol ) THEN
82
83      IF( kt == nit000 ) THEN
84         IF(lwp) WRITE(numout,*)
85         IF(lwp) WRITE(numout,*)'bdy_vol : Correction of velocities along unstructured OBC'
86         IF(lwp) WRITE(numout,*)'~~~~~~~'
87      END IF 
88
89      ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain
90      ! -----------------------------------------------------------------------
91      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
92      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
93
94      ! Transport through the unstructured open boundary
95      ! ------------------------------------------------
96      zubtpecor = 0.e0
97      DO ib_bdy = 1, nb_bdy
98         idx => idx_bdy(ib_bdy)
99
100         jgrd = 2                               ! cumulate u component contribution first
101         DO jb = 1, idx%nblenrim(jgrd)
102            DO jk = 1, jpkm1
103               ii = idx%nbi(jb,jgrd)
104               ij = idx%nbj(jb,jgrd)
105               zubtpecor = zubtpecor + idx%flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk)
106            END DO
107         END DO
108         jgrd = 3                               ! then add v component contribution
109         DO jb = 1, idx%nblenrim(jgrd)
110            DO jk = 1, jpkm1
111               ii = idx%nbi(jb,jgrd)
112               ij = idx%nbj(jb,jgrd)
113               zubtpecor = zubtpecor + idx%flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
114            END DO
115         END DO
116
117      END DO
118      IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain
119
120      ! The normal velocity correction
121      ! ------------------------------
122      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 
123      ELSE                   ;   zubtpecor =   zubtpecor             / bdysurftot
124      END IF
125
126      ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation
127      ! -------------------------------------------------------------
128      ztranst = 0.e0
129      DO ib_bdy = 1, nb_bdy
130         idx => idx_bdy(ib_bdy)
131
132         jgrd = 2                               ! correct u component
133         DO jb = 1, idx%nblenrim(jgrd)
134            DO jk = 1, jpkm1
135               ii = idx%nbi(jb,jgrd)
136               ij = idx%nbj(jb,jgrd)
137               ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb) * zubtpecor * umask(ii,ij,jk)
138               ztranst = ztranst + idx%flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk)
139            END DO
140         END DO
141         jgrd = 3                              ! correct v component
142         DO jb = 1, idx%nblenrim(jgrd)
143            DO jk = 1, jpkm1
144               ii = idx%nbi(jb,jgrd)
145               ij = idx%nbj(jb,jgrd)
146               va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb) * zubtpecor * vmask(ii,ij,jk)
147               ztranst = ztranst + idx%flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk)
148            END DO
149         END DO
150
151      END DO
152      IF( lk_mpp )   CALL mpp_sum( ztranst )   ! sum over the global domain
153 
154      ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected
155      ! ------------------------------------------------------
156      IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
157         IF(lwp) WRITE(numout,*)
158         IF(lwp) WRITE(numout,*)'bdy_vol : time step :', kt
159         IF(lwp) WRITE(numout,*)'~~~~~~~ '
160         IF(lwp) WRITE(numout,*)'          cumulate flux EMP             =', z_cflxemp  , ' (m3/s)'
161         IF(lwp) WRITE(numout,*)'          total lateral surface of OBC  =', bdysurftot, '(m2)'
162         IF(lwp) WRITE(numout,*)'          correction velocity zubtpecor =', zubtpecor , '(m/s)'
163         IF(lwp) WRITE(numout,*)'          cumulated transport ztranst   =', ztranst   , '(m3/s)'
164      END IF 
165      !
166      IF( nn_timing == 1 ) CALL timing_stop('bdy_vol')
167      !
168      END IF ! ln_vol
169
170   END SUBROUTINE bdy_vol
171
172#else
173   !!----------------------------------------------------------------------
174   !!   Dummy module                   NO Unstruct Open Boundary Conditions
175   !!----------------------------------------------------------------------
176CONTAINS
177   SUBROUTINE bdy_vol( kt )        ! Empty routine
178      WRITE(*,*) 'bdy_vol: You should not have seen this print! error?', kt
179   END SUBROUTINE bdy_vol
180#endif
181
182   !!======================================================================
183END MODULE bdyvol
Note: See TracBrowser for help on using the repository browser.