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.
zdfbfr.F90 in trunk/NEMO/OPA_SRC/ZDF – NEMO

source: trunk/NEMO/OPA_SRC/ZDF/zdfbfr.F90 @ 1146

Last change on this file since 1146 was 1146, checked in by rblod, 16 years ago

Add svn Id (first try), see ticket #210
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 8.6 KB
Line 
1MODULE zdfbfr
2   !!======================================================================
3   !!                       ***  MODULE  zdfbfr  ***
4   !! Ocean physics: Bottom friction
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !!   zdf_bfr      : update momentum Kz at the ocean bottom due to the
9   !!                  type of bottom friction chosen
10   !!   zdf_bfr_init : read in namelist and control the bottom friction
11   !!                  parameters.
12   !!----------------------------------------------------------------------
13   !! * Modules used
14   USE oce             ! ocean dynamics and tracers variables
15   USE dom_oce         ! ocean space and time domain variables
16   USE zdf_oce         ! ocean vertical physics variables
17   USE in_out_manager  ! I/O manager
18   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
19   USE prtctl          ! Print control
20
21   IMPLICIT NONE
22   PRIVATE
23
24   !! * Routine accessibility
25   PUBLIC zdf_bfr    ! called by step.F90
26
27   !! * Module variables
28   INTEGER ::             & !!! ** bottom friction namelist (nambfr) **
29      nbotfr = 0             ! = 0/1/2/3 type of bottom friction
30   REAL(wp) ::            & !!! ** bottom friction namelist (nambfr) **
31      bfri1 = 4.0e-4_wp,  &  ! bottom drag coefficient (linear case)
32      bfri2 = 1.0e-3_wp,  &  ! bottom drag coefficient (non linear case)
33      bfeb2 = 2.5e-3_wp      ! background bottom turbulent kinetic energy  (m2/s2)
34
35   !! * Substitutions
36#  include "domzgr_substitute.h90"
37   !!----------------------------------------------------------------------
38   !!   OPA 9.0 , LOCEAN-IPSL (2005)
39   !! $Header$
40   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
41   !!----------------------------------------------------------------------
42
43CONTAINS
44
45   SUBROUTINE zdf_bfr( kt )
46      !!----------------------------------------------------------------------
47      !!                   ***  ROUTINE zdf_bfr  ***
48      !!                 
49      !! ** Purpose :   Applied the bottom friction through a specification of
50      !!      Kz at the ocean bottom.
51      !!
52      !! ** Method  :   Update the value of avmu and avmv at the ocean bottom
53      !!       level following the chosen friction type (no-slip, free-slip,
54      !!       linear, or quadratic)
55      !!
56      !! History :
57      !!   8.0  !  97-06  (G. Madec, A.-M. Treguier)  Original code
58      !!   8.5  !  02-06  (G. Madec)  F90: Free form and module
59      !!----------------------------------------------------------------------
60      !! * Arguments
61      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
62
63      !! * Local declarations
64      INTEGER ::   &
65         ji, jj,                   &  ! dummy loop indexes
66         ikbu, ikbv,               &  ! temporary integers
67         ikbum1, ikbvm1               !
68      REAL(wp) ::   &
69         zvu, zuv, zecu, zecv         ! temporary scalars
70      !!----------------------------------------------------------------------
71
72
73      IF( kt == nit000 )   CALL zdf_bfr_init
74
75
76      ! Compute avmu, avmv at the ocean bottom
77      ! --------------------------------------
78
79      SELECT CASE (nbotfr)
80
81      CASE( 0 )                 ! no-slip boundary condition
82# if defined key_vectopt_loop
83         jj = 1
84         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
85# else
86         DO jj = 2, jpjm1
87            DO ji = 2, jpim1
88# endif
89               ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
90               ikbv   = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
91               ikbum1 = MAX( ikbu-1, 1 )
92               ikbvm1 = MAX( ikbv-1, 1 )
93               avmu(ji,jj,ikbu) = 2. * avmu(ji,jj,ikbum1)
94               avmv(ji,jj,ikbv) = 2. * avmv(ji,jj,ikbvm1)
95# if ! defined key_vectopt_loop
96            END DO
97# endif
98         END DO
99
100      CASE( 1 )                 ! linear botton friction
101# if defined key_vectopt_loop
102         jj = 1
103         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
104# else
105         DO jj = 2, jpjm1
106            DO ji = 2, jpim1
107# endif
108               ikbu = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )
109               ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )
110               avmu(ji,jj,ikbu) = bfri1 * fse3uw(ji,jj,ikbu)
111               avmv(ji,jj,ikbv) = bfri1 * fse3vw(ji,jj,ikbv)
112# if ! defined key_vectopt_loop
113            END DO
114# endif
115         END DO
116
117      CASE( 2 )                 ! quadratic botton friction
118# if defined key_vectopt_loop
119         jj = 1
120!CDIR NOVERRCHK
121         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
122# else
123!CDIR NOVERRCHK
124         DO jj = 2, jpjm1
125!CDIR NOVERRCHK
126            DO ji = 2, jpim1
127# endif
128               ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
129               ikbv   = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
130               ikbum1 = MAX( ikbu-1, 1 )
131               ikbvm1 = MAX( ikbv-1, 1 )
132               
133               zvu  = 0.25 * (  vn(ji,jj  ,ikbum1) + vn(ji+1,jj  ,ikbum1)     &
134                              + vn(ji,jj-1,ikbum1) + vn(ji+1,jj-1,ikbum1)  )
135               
136               zuv  = 0.25 * (  un(ji,jj  ,ikbvm1) + un(ji-1,jj  ,ikbvm1)     &
137                              + un(ji,jj+1,ikbvm1) + un(ji-1,jj+1,ikbvm1)  )
138               
139               zecu = SQRT(  un(ji,jj,ikbum1) * un(ji,jj,ikbum1) + zvu*zvu + bfeb2  )
140               zecv = SQRT(  vn(ji,jj,ikbvm1) * vn(ji,jj,ikbvm1) + zuv*zuv + bfeb2  )
141               
142               avmu(ji,jj,ikbu) = bfri2 * zecu * fse3uw(ji,jj,ikbu)
143               avmv(ji,jj,ikbv) = bfri2 * zecv * fse3vw(ji,jj,ikbv)
144# if ! defined key_vectopt_loop
145            END DO
146# endif
147         END DO
148
149      CASE( 3 )                 ! free-slip boundary condition
150# if defined key_vectopt_loop
151         jj = 1
152         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
153# else
154         DO jj = 2, jpjm1
155            DO ji = 2, jpim1
156# endif
157               ikbu = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
158               ikbv = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
159               avmu(ji,jj,ikbu) = 0.e0
160               avmv(ji,jj,ikbv) = 0.e0
161# if ! defined key_vectopt_loop
162            END DO
163# endif
164         END DO
165
166      END SELECT
167
168      ! Lateral boundary condition on (avmu,avmv)   (unchanged sign)
169      ! ------------------------------===========
170      CALL lbc_lnk( avmu, 'U', 1. )
171      CALL lbc_lnk( avmv, 'V', 1. )
172
173      IF(ln_ctl)  THEN
174         CALL prt_ctl(tab3d_1=avmu, clinfo1=' bfr  - u: ', mask1=umask, &
175            &         tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask,ovlap=1, kdim=jpk)
176      ENDIF
177
178   END SUBROUTINE zdf_bfr
179
180
181   SUBROUTINE zdf_bfr_init
182      !!----------------------------------------------------------------------
183      !!                  ***  ROUTINE zdf_bfr_init  ***
184      !!                   
185      !! ** Purpose :   Initialization of the bottom friction
186      !!
187      !! ** Method  :   Read the nammbf namelist and check their consistency
188      !!      called at the first timestep (nit000)
189      !!
190      !! History :
191      !!   9.0  !  02-06  (G. Madec)  Original code
192      !!----------------------------------------------------------------------
193      !! * Local declarations
194      NAMELIST/nambfr/ nbotfr, bfri1, bfri2, bfeb2
195      !!----------------------------------------------------------------------
196
197      ! Read Namelist nambfr : bottom momentum boundary condition
198      ! --------------------
199      REWIND ( numnam )
200      READ   ( numnam, nambfr )
201
202
203      ! Parameter control and print
204      ! ---------------------------
205      IF(lwp) WRITE(numout,*)
206      IF(lwp) WRITE(numout,*) 'zdf_bfr : momentum bottom friction'
207      IF(lwp) WRITE(numout,*) '~~~~~~~'
208      IF(lwp) WRITE(numout,*) '          Namelist nambfr : set bottom friction parameters'
209
210      SELECT CASE (nbotfr)
211
212      CASE( 0 )
213         IF(lwp) WRITE(numout,*) '            no-slip '
214
215      CASE( 1 )
216         IF(lwp) WRITE(numout,*) '            linear botton friction'
217         IF(lwp) WRITE(numout,*) '            friction coef.   bfri1  = ', bfri1
218
219      CASE( 2 )
220         IF(lwp) WRITE(numout,*) '            quadratic botton friction'
221         IF(lwp) WRITE(numout,*) '            friction coef.   bfri2  = ', bfri2
222         IF(lwp) WRITE(numout,*) '            background tke   bfeb2  = ', bfeb2
223
224      CASE( 3 )
225         IF(lwp) WRITE(numout,*) '            free-slip '
226
227      CASE DEFAULT
228         WRITE(ctmp1,*) '         bad flag value for nbotfr = ', nbotfr
229         CALL ctl_stop( ctmp1 )
230
231      END SELECT
232
233   END SUBROUTINE zdf_bfr_init
234
235   !!======================================================================
236END MODULE zdfbfr
Note: See TracBrowser for help on using the repository browser.