Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

Timestamp:

2010-12-27T18:33:53+01:00 (13 years ago)

Author:

rblod

Message:

Update NEMOGCM from branch nemo_v3_3_beta

File:

• trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90 (modified) (10 diffs, 1 prop)

trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90

@@ -7 +7 @@
    !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
    !!            3.2  ! 2009-09  (A.C.Coward)  Correction to include barotropic contribution
+   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
    !!----------------------------------------------------------------------
 
@@ -12 +13 @@
    !!   zdf_bfr      : update momentum Kz at the ocean bottom due to the type of bottom friction chosen
    !!   zdf_bfr_init : read in namelist and control the bottom friction parameters.
-   !!   zdf_bfr_2d   : read in namelist and control the bottom friction
-   !!                  parameters.
+   !!   zdf_bfr_2d   : read in namelist and control the bottom friction parameters.
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
@@ -26 +26 @@
    PRIVATE
 
-   PUBLIC   zdf_bfr    ! called by step.F90
+   PUBLIC   zdf_bfr         ! called by step.F90
+   PUBLIC   zdf_bfr_init    ! called by opa.F90
    
-   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bfrua , bfrva   !: Bottom friction coefficients set in zdfbfr
-
    !                                    !!* Namelist nambfr: bottom friction namelist *
    INTEGER  ::   nn_bfr    = 0           ! = 0/1/2/3 type of bottom friction 
@@ -35 +34 @@
    REAL(wp) ::   rn_bfri2  = 1.0e-3_wp   ! bottom drag coefficient (non linear case)
    REAL(wp) ::   rn_bfeb2  = 2.5e-3_wp   ! background bottom turbulent kinetic energy  [m2/s2]
-   REAL(wp) ::   rn_bfrien = 30_wp       ! local factor to enhance coefficient bfri
+   REAL(wp) ::   rn_bfrien = 30._wp      ! local factor to enhance coefficient bfri
    LOGICAL  ::   ln_bfr2d  = .false.     ! logical switch for 2D enhancement
    
@@ -41 +40 @@
 
    !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
 #  include "domzgr_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
-   !! $Id$ 
-   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
-   !!----------------------------------------------------------------------
-
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
 CONTAINS
 
@@ -68 +67 @@
       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
       !!
-      INTEGER  ::   ji, jj         ! dummy loop indices
-      INTEGER  ::   ikbu, ikbum1   ! temporary integers
-      INTEGER  ::   ikbv, ikbvm1   !    -          -
+      INTEGER  ::   ji, jj       ! dummy loop indices
+      INTEGER  ::   ikbu, ikbv   ! local integers
       REAL(wp) ::   zvu, zuv, zecu, zecv   ! temporary scalars
       !!----------------------------------------------------------------------
-
-
-      IF( kt == nit000 )   CALL zdf_bfr_init   ! initialisation
 
       IF( nn_bfr == 2 ) THEN                 ! quadratic botton friction
@@ -93 +88 @@
             DO ji = 2, jpim1
 # endif
-               ikbu   = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
-               ikbv   = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
-               ikbum1 = MAX( ikbu-1, 1 )
-               ikbvm1 = MAX( ikbv-1, 1 )
+               ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
+               ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
                !
-               zvu  = 0.25 * (  vn(ji,jj  ,ikbum1) + vn(ji+1,jj  ,ikbum1)     &
-                  &           + vn(ji,jj-1,ikbum1) + vn(ji+1,jj-1,ikbum1)  )
-               zuv  = 0.25 * (  un(ji,jj  ,ikbvm1) + un(ji-1,jj  ,ikbvm1)     &
-                  &           + un(ji,jj+1,ikbvm1) + un(ji-1,jj+1,ikbvm1)  )
+               zvu  = 0.25 * (  vn(ji,jj  ,ikbu) + vn(ji+1,jj  ,ikbu)     &
+                  &           + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu)  )
+               zuv  = 0.25 * (  un(ji,jj  ,ikbv) + un(ji-1,jj  ,ikbv)     &
+                  &           + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv)  )
                !
-               zecu = SQRT(  un(ji,jj,ikbum1) * un(ji,jj,ikbum1) + zvu*zvu + rn_bfeb2  )
-               zecv = SQRT(  vn(ji,jj,ikbvm1) * vn(ji,jj,ikbvm1) + zuv*zuv + rn_bfeb2  )
+               zecu = SQRT(  un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2  )
+               zecv = SQRT(  vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2  )
                !
-               bfrua(ji,jj) = - 0.5 * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji+1,jj  ) ) * zecu 
-               bfrva(ji,jj) = - 0.5 * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji  ,jj+1) ) * zecv
+               bfrua(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji+1,jj  ) ) * zecu 
+               bfrva(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji  ,jj+1) ) * zecv
             END DO
          END DO
@@ -131 +124 @@
       USE iom   ! I/O module for ehanced bottom friction file
       !!
-      INTEGER ::   inum                         ! logical unit for enhanced bottom friction file
-      INTEGER ::   ji, jj                       ! dummy loop indexes
-      INTEGER ::   ikbu, ikbv, ikbum1, ikbvm1   ! temporary integers
-      INTEGER ::   ictu, ictv                   !    -          -
-      REAL(wp) ::  zminbfr, zmaxbfr             ! temporary scalars
-      REAL(wp) ::  zfru, zfrv                   !    -         -
+      INTEGER ::   inum         ! logical unit for enhanced bottom friction file
+      INTEGER ::   ji, jj       ! dummy loop indexes
+      INTEGER ::   ikbu, ikbv   ! temporary integers
+      INTEGER ::   ictu, ictv   !    -          -
+      REAL(wp) ::  zminbfr, zmaxbfr   ! temporary scalars
+      REAL(wp) ::  zfru, zfrv         !    -         -
       !!
       NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2, ln_bfr2d, rn_bfrien
@@ -218 +211 @@
          DO ji = 2, jpim1
 #  endif
-             ikbu = MIN( mbathy(ji+1,jj  ), mbathy(ji,jj) )
-             ikbv = MIN( mbathy(ji  ,jj+1), mbathy(ji,jj) )
-             ikbum1 = MAX( ikbu-1, 1 )
-             ikbvm1 = MAX( ikbv-1, 1 )
-             zfru = 0.5 * fse3u(ji,jj,ikbum1) / rdt
-             zfrv = 0.5 * fse3v(ji,jj,ikbvm1) / rdt
+             ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points
+             ikbv = mbkv(ji,jj)
+             zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
+             zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
              IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN
                 IF( ln_ctl ) THEN
-                   WRITE(numout,*) 'BFR ',narea,nimpp+ji,njmpp+jj,ikbu
-                   WRITE(numout,*) 'BFR ',ABS( bfrcoef2d(ji,jj) ), zfru
+                   WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbu
+                   WRITE(numout,*) 'BFR ', ABS( bfrcoef2d(ji,jj) ), zfru
                 ENDIF
                 ictu = ictu + 1
@@ -248 +239 @@
          CALL mpp_max( zmaxbfr )
       ENDIF
-      IF( lwp .AND. ictu + ictv .GT. 0 ) THEN
+      IF( lwp .AND. ictu + ictv > 0 ) THEN
          WRITE(numout,*) ' Bottom friction stability check failed at ', ictu, ' U-points '
          WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' V-points '