Changeset 1662 for trunk/NEMO/OPA_SRC/ZDF/zdftke.F90

Timestamp:

2009-10-14T18:51:06+02:00 (15 years ago)

Author:

rblod

Message:

Correction of major bug on bottom friction, see ticket #233

File:

• trunk/NEMO/OPA_SRC/ZDF/zdftke.F90 (modified) (3 diffs)

trunk/NEMO/OPA_SRC/ZDF/zdftke.F90

@@ -48 +48 @@
    USE in_out_manager ! I/O manager
    USE iom            ! I/O manager library
+   USE zdfbfr          ! bottom friction
 
    IMPLICIT NONE
@@ -182 +183 @@
       REAL(wp) ::   zus   , zwlc  , zind      !    -         -
       REAL(wp) ::   zzd_up, zzd_lw            !    -         -
+      INTEGER  ::   ikbu, ikbv, ikbum1, ikbvm1      ! temporary scalar
+      INTEGER  ::   ikbt, ikbumm1, ikbvmm1          ! temporary scalar
+      REAL(wp) ::   zebot                           ! temporary scalars
       INTEGER , DIMENSION(jpi,jpj)     ::   imlc    ! 2D workspace
       REAL(wp), DIMENSION(jpi,jpj)     ::   zhlc    !  -      -
@@ -209 +213 @@
       !                     !  Bottom boundary condition on tke
       !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-!!gm to be added soon
+      !                     en(bot)   = 0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin)
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            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 = MIN( mbathy(ji,jj), mbathy(ji-1,jj) )
+            ikbv = MIN( mbathy(ji,jj), mbathy(ji,jj-1) )
+            ikbumm1 = MAX( ikbu-1, 1 )
+            ikbvmm1 = MAX( ikbv-1, 1 )
+            ikbt = MAX( mbathy(ji,jj), 1 )
+            ztx2 = bfrua(ji-1,jj) * fse3u(ji-1,jj  ,ikbumm1) + &
+                   bfrua(ji  ,jj) * fse3u(ji  ,jj  ,ikbum1 )
+            zty2 = bfrva(ji,jj  ) * fse3v(ji  ,jj  ,ikbvm1) + &
+                   bfrva(ji,jj-1) * fse3v(ji  ,jj-1,ikbvmm1 )
+            zebot = 0.25_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 )
+            en (ji,jj,ikbt) = MAX( zebot, rn_emin ) * tmask(ji,jj,1)
+         END DO
+      END DO
       !
       !