Changeset 11258 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynkeg.F90

Timestamp:

2019-07-11T18:21:02+02:00 (5 years ago)

Author:

smasson

Message:

dev_r10984_HPC-13 : minor bugfix and cleaning, see #2285

File:

• NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynkeg.F90 (modified) (3 diffs)

NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynkeg.F90

@@ -74 +74 @@
       INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme 
       !
-      INTEGER  ::   ji, jj, jk, jb           ! dummy loop indices
-      INTEGER  ::   igrd, ib_bdy             ! local integers
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
       REAL(wp) ::   zu, zv                   ! local scalars
       REAL(wp), DIMENSION(jpi,jpj,jpk)        ::   zhke
       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
-      REAL(wp)  :: zweightu, zweightv
-      LOGICAL, DIMENSION(4) :: llsend1, llrecv1  ! indicate how bdy communications are to be carried out
       !!----------------------------------------------------------------------
       !
@@ -113 +110 @@
             END DO
          END DO
-         !
-         IF (ln_bdy) THEN
-            ! Maria Luneva & Fred Wobus: July-2016
-            ! compensate for lack of turbulent kinetic energy on liquid bdy points
-            DO ib_bdy = 1, nb_bdy
-               IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN
-                  igrd = 1           ! compensating null velocity on the bdy
-                  DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
-                     ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 1 to jpi
-                     jj   = idx_bdy(ib_bdy)%nbj(jb,igrd)   ! maximum extent : from 1 to jpj
-                     IF( ji == 1 .OR. jj == 1 )  CYCLE
-                     DO jk = 1, jpkm1
-                        zhke(ji,jj,jk) = 0._wp
-                        zweightu = umask(ji-1,jj  ,jk) + umask(ji,jj,jk)
-                        zweightv = vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)
-                        zu = un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)  +  un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)
-                        zv = vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  +  vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)
-                        IF( zweightu > 0._wp )   zhke(ji,jj,jk) =  zhke(ji,jj,jk) + zu / (2._wp * zweightu) 
-                        IF( zweightv > 0._wp )   zhke(ji,jj,jk) =  zhke(ji,jj,jk) + zv / (2._wp * zweightv) 
-                     END DO
-                  END DO
-               END IF
-            END DO
-            ! send jpi-1, jpj-1 and receive 1 used in the computation of the speed tendencies
-            llsend1(:) = .false.
-            llrecv1(:) = .false.
-            DO ib_bdy = 1, nb_bdy
-               llsend1(2) = llsend1(2) .OR. ANY(lsend_bdy(ib_bdy,igrd,2,:))   ! send east
-               llsend1(4) = llsend1(4) .OR. ANY(lsend_bdy(ib_bdy,igrd,4,:))   ! send north
-               llrecv1(1) = llrecv1(1) .OR. ANY(lrecv_bdy(ib_bdy,igrd,1,:))   ! receive west 
-               llrecv1(3) = llrecv1(3) .OR. ANY(lrecv_bdy(ib_bdy,igrd,3,:))   ! receive south
-            END DO
-   
-            IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
-               CALL lbc_lnk( 'bdydyn2d', zhke, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
-            END IF
-         END IF
-         !
       CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --!
          DO jk = 1, jpkm1
@@ -168 +127 @@
             END DO
          END DO
-         IF (ln_bdy) THEN
-            ! Maria Luneva & Fred Wobus: July-2016
-            ! compensate for lack of turbulent kinetic energy on liquid bdy points
-            DO ib_bdy = 1, nb_bdy
-               IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN
-                  igrd = 1           ! compensation null velocity on land at the bdy
-                  DO jb = 1, idx_bdy(ib_bdy)%nblenrim(igrd)
-                     ji   = idx_bdy(ib_bdy)%nbi(jb,igrd)   ! maximum extent : from 1 to jpi
-                     jj   = idx_bdy(ib_bdy)%nbj(jb,igrd)   ! maximum extent : from 1 to jpj
-                     IF( ji == 1 .OR. ji == jpi .OR. jj == 1 .OR. jj == jpj )  CYCLE
-                     DO jk = 1, jpkm1
-                        zhke(ji,jj,jk) = 0._wp
-                        zweightu = 8._wp * ( umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) ) &
-                             &   + 2._wp * ( umask(ji-1,jj-1,jk) + umask(ji-1,jj+1,jk) + umask(ji  ,jj-1,jk) + umask(ji  ,jj+1,jk) ) 
-                        zweightv = 8._wp * ( vmask(ji  ,jj-1,jk) + vmask(ji  ,jj-1,jk) ) &
-                             &   + 2._wp * ( vmask(ji-1,jj-1,jk) + vmask(ji+1,jj-1,jk) + vmask(ji-1,jj  ,jk) + vmask(ji+1,jj  ,jk) )
-                        zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    &
-                           &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  &
-                           &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   &
-                           &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) )
-                        zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    &
-                           &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  &
-                           &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   &
-                           &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) )
-                        IF( zweightu > 0._wp )   zhke(ji,jj,jk) =  zhke(ji,jj,jk) +  zu / ( 2._wp * zweightu )
-                        IF( zweightv > 0._wp )   zhke(ji,jj,jk) =  zhke(ji,jj,jk) +  zv / ( 2._wp * zweightv )
-                     END DO
-                  END DO
-               END IF
-            END DO
-         END IF
          CALL lbc_lnk( 'dynkeg', zhke, 'T', 1. )
          !