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.
dynbfr.F90 in branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DYN – NEMO

source: branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90 @ 8093

Last change on this file since 8093 was 8093, checked in by gm, 7 years ago

#1880 (HPC-09) - step-6: prepare some forthcoming evolutions (ZDF modules mainly)

  • Property svn:keywords set to Id
File size: 6.3 KB
Line 
1MODULE dynbfr
2   !!==============================================================================
3   !!                 ***  MODULE  dynbfr  ***
4   !! Ocean dynamics :  bottom friction component of the momentum mixing trend
5   !!==============================================================================
6   !! History :  3.2  ! 2008-11  (A. C. Coward)  Original code
7   !!            3.4  ! 2011-09  (H. Liu) Make it consistent with semi-implicit
8   !!                            Bottom friction (ln_bfrimp = .true.)
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   dyn_bfr       : Update the momentum trend with the bottom friction contribution
13   !!----------------------------------------------------------------------
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!!gm new
18   USE zdfdrg         ! vertical physics: top/bottom drag coef.
19!!gm old
20   USE zdfbfr         ! ocean bottom friction variables
21!!gm
22   USE trd_oce        ! trends: ocean variables
23   USE trddyn         ! trend manager: dynamics
24   !
25   USE in_out_manager ! I/O manager
26   USE prtctl         ! Print control
27   USE timing         ! Timing
28   USE wrk_nemo       ! Memory Allocation
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   dyn_bfr   !  routine called by step.F90
34
35   !! * Substitutions
36#  include "vectopt_loop_substitute.h90"
37   !!----------------------------------------------------------------------
38   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
39   !! $Id$
40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43   
44   SUBROUTINE dyn_bfr( kt )
45      !!----------------------------------------------------------------------
46      !!                  ***  ROUTINE dyn_bfr  ***
47      !!
48      !! ** Purpose :   compute the bottom friction ocean dynamics physics.
49      !!
50      !! ** Action  :   (ua,va)   momentum trend increased by bottom friction trend
51      !!---------------------------------------------------------------------
52      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
53      !!
54      INTEGER  ::   ji, jj       ! dummy loop indexes
55      INTEGER  ::   ikbu, ikbv   ! local integers
56      REAL(wp) ::   zm1_2dt      ! local scalar
57      REAL(wp) ::   zCdu, zCdv   !   -      -
58      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdu, ztrdv
59      !!---------------------------------------------------------------------
60      !
61      IF( nn_timing == 1 )  CALL timing_start('dyn_bfr')
62      !
63!!gm issue: better to put the logical in step to control the call of zdf_bfr
64!!          ==> change the logical from ln_bfrimp to ln_bfr_exp !!
65      IF( .NOT.ln_bfrimp) THEN     ! only for explicit bottom friction form
66                                    ! implicit bfr is implemented in dynzdf_imp
67
68!!gm bug : time step is only rdt (not 2 rdt if euler start !)
69         zm1_2dt = - 1._wp / ( 2._wp * rdt )
70
71         IF( l_trddyn ) THEN      ! trends: store the input trends
72            ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )
73            ztrdu(:,:,:) = ua(:,:,:)
74            ztrdv(:,:,:) = va(:,:,:)
75         ENDIF
76
77
78         DO jj = 2, jpjm1
79            DO ji = 2, jpim1
80               ikbu = mbku(ji,jj)          ! deepest wet ocean u- & v-levels
81               ikbv = mbkv(ji,jj)
82               !
83               ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
84!!gm old
85               ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  bfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu)
86               va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv)
87!!gm new
88!               zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu)
89!               zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv)
90!               !
91!               ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * ub(ji,jj,ikbu)
92!               va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * vb(ji,jj,ikbv)
93!!gm
94            END DO
95         END DO
96         !
97         IF( ln_isfcav ) THEN        ! ocean cavities
98            DO jj = 2, jpjm1
99               DO ji = 2, jpim1
100                  ikbu = miku(ji,jj)          ! first wet ocean u- & v-levels
101                  ikbv = mikv(ji,jj)
102                  !
103                  ! Apply stability criteria on absolute value  : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt)
104!!gm old
105                 ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  tfrua(ji,jj) / e3u_n(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu) &
106                    &             * (1.-umask(ji,jj,1))
107                 va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  tfrva(ji,jj) / e3v_n(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv) &
108                    &             * (1.-vmask(ji,jj,1))
109!!gm new
110!                  zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu)    ! NB: Cdtop masked
111!                  zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv)
112!                  !
113!                  ua(ji,jj,ikbu) = ua(ji,jj,ikbu) + MAX(  zCdu , zm1_2dt  ) * ub(ji,jj,ikbu)
114!                  va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  zCdv , zm1_2dt  ) * vb(ji,jj,ikbv)
115!!gm
116              END DO
117           END DO
118         END IF
119        !
120        IF( l_trddyn ) THEN      ! trends: send trends to trddyn for further diagnostics
121           ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
122           ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
123           CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt )
124           DEALLOCATE( ztrdu, ztrdv )
125        ENDIF
126        !                                          ! print mean trends (used for debugging)
127        IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' bfr  - Ua: ', mask1=umask,               &
128           &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
129        !
130      ENDIF     ! end explicit bottom friction
131      !
132      IF( nn_timing == 1 )  CALL timing_stop('dyn_bfr')
133      !
134   END SUBROUTINE dyn_bfr
135
136   !!==============================================================================
137END MODULE dynbfr
Note: See TracBrowser for help on using the repository browser.