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.
dynkeg.F90 in branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN – NEMO

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90 @ 3475

Last change on this file since 3475 was 2636, checked in by gm, 13 years ago

dynamic mem: #785 ; move ctl_stop & warn in lib_mpp to avoid a circular dependency + ctl_stop improvment

  • Property svn:keywords set to Id
File size: 7.2 KB
RevLine 
[3]1MODULE dynkeg
2   !!======================================================================
3   !!                       ***  MODULE  dynkeg  ***
4   !! Ocean dynamics:  kinetic energy gradient trend
5   !!======================================================================
[503]6   !! History :  1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code
7   !!            7.0  !  97-05  (G. Madec)  Split dynber into dynkeg and dynhpg
8   !!            9.0  !  02-07  (G. Madec)  F90: Free form and module
9   !!----------------------------------------------------------------------
[3]10   
11   !!----------------------------------------------------------------------
12   !!   dyn_keg      : update the momentum trend with the horizontal tke
13   !!----------------------------------------------------------------------
14   USE oce             ! ocean dynamics and tracers
15   USE dom_oce         ! ocean space and time domain
[216]16   USE trdmod          ! ocean dynamics trends
17   USE trdmod_oce      ! ocean variables trends
[2636]18   USE in_out_manager  ! I/O manager
19   USE lib_mpp         ! MPP library
[258]20   USE prtctl          ! Print control
[3]21
22   IMPLICIT NONE
23   PRIVATE
24
[503]25   PUBLIC   dyn_keg    ! routine called by step module
[3]26   
27   !! * Substitutions
28#  include "vectopt_loop_substitute.h90"
[503]29   !!----------------------------------------------------------------------
[2528]30   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1152]31   !! $Id$
[2625]32   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[503]33   !!----------------------------------------------------------------------
[3]34CONTAINS
35
36   SUBROUTINE dyn_keg( kt )
37      !!----------------------------------------------------------------------
38      !!                  ***  ROUTINE dyn_keg  ***
39      !!
40      !! ** Purpose :   Compute the now momentum trend due to the horizontal
41      !!      gradient of the horizontal kinetic energy and add it to the
42      !!      general momentum trend.
43      !!
[503]44      !! ** Method  :   Compute the now horizontal kinetic energy
[3]45      !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ]
46      !!      Take its horizontal gradient and add it to the general momentum
47      !!      trend (ua,va).
48      !!         ua = ua - 1/e1u di[ zhke ]
49      !!         va = va - 1/e2v dj[ zhke ]
50      !!
51      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend
[503]52      !!             - save this trends (l_trddyn=T) for post-processing
53      !!----------------------------------------------------------------------
[2633]54      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
[2625]55      USE oce     , ONLY:   ztrdu => ta       , ztrdv => sa   ! (ta,sa) used as 3D workspace   
56      USE wrk_nemo, ONLY:   zhke  => wrk_3d_1                 ! 3D workspace
[3]57      !!
[503]58      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
59      !!
60      INTEGER  ::   ji, jj, jk   ! dummy loop indices
61      REAL(wp) ::   zu, zv       ! temporary scalars
[3]62      !!----------------------------------------------------------------------
63
[2636]64      IF( wrk_in_use(3,1) ) THEN
65         CALL ctl_stop('dyn_key: requested workspace array is unavailable')   ;   RETURN
[2625]66      ENDIF
[2590]67
[3]68      IF( kt == nit000 ) THEN
69         IF(lwp) WRITE(numout,*)
70         IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend'
71         IF(lwp) WRITE(numout,*) '~~~~~~~'
72      ENDIF
[216]73
[503]74      IF( l_trddyn ) THEN           ! Save ua and va trends
75         ztrdu(:,:,:) = ua(:,:,:) 
76         ztrdv(:,:,:) = va(:,:,:) 
[216]77      ENDIF
[3]78     
79      !                                                ! ===============
80      DO jk = 1, jpkm1                                 ! Horizontal slab
81         !                                             ! ===============
[503]82         DO jj = 2, jpj         ! Horizontal kinetic energy at T-point
[3]83            DO ji = fs_2, jpi   ! vector opt.
[503]84               zu = 0.25 * (  un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
85                  &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)  )
[3]86               zv = 0.25 * (  vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
[503]87                  &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)  )
[3]88               zhke(ji,jj,jk) = zv + zu
[2625]89!!gm simplier coding  ==>>   ~ faster
90!    don't forget to suppress local zu zv scalars
91!               zhke(ji,jj,jk) = 0.25 * (   un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
92!                  &                      + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   &
93!                  &                      + vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
94!                  &                      + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   )
95!!gm end <<==
[3]96            END DO 
97         END DO 
[503]98         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends
[3]99            DO ji = fs_2, fs_jpim1   ! vector opt.
[503]100               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj)
101               va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj)
[3]102            END DO
103         END DO
[2625]104!!gm idea to be tested  ==>>   is it faster on scalar computers ?
105!         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends
106!            DO ji = fs_2, fs_jpim1   ! vector opt.
107!               ua(ji,jj,jk) = ua(ji,jj,jk) - 0.25 * ( + un(ji+1,jj  ,jk) * un(ji+1,jj  ,jk)   &
108!                  &                                   + vn(ji+1,jj-1,jk) * vn(ji+1,jj-1,jk)   &
109!                  &                                   + vn(ji+1,jj  ,jk) * vn(ji+1,jj  ,jk)   &
110!                  !
111!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
112!                  &                                   - vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
113!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e1u(ji,jj)
114!                  !
115!               va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * (   un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk)   &
116!                  &                                   + un(ji  ,jj+1,jk) * un(ji  ,jj+1,jk)   &
117!                  &                                   + vn(ji  ,jj+1,jk) * vn(ji  ,jj+1,jk)   &
118!                  !
119!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
120!                  &                                   - un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   &
121!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e2v(ji,jj)
122!            END DO
123!         END DO
124!!gm en idea            <<==
[3]125         !                                             ! ===============
126      END DO                                           !   End of slab
127      !                                                ! ===============
128
[503]129      IF( l_trddyn ) THEN      ! save the Kinetic Energy trends for diagnostic
130         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
131         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
132         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_keg, 'DYN', kt )
[216]133      ENDIF
[503]134      !
135      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' keg  - Ua: ', mask1=umask,   &
136         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
137      !
[2636]138      IF( wrk_not_released(3, 1) )   CALL ctl_stop('dyn_key: failed to release workspace array')
[2625]139      !
[3]140   END SUBROUTINE dyn_keg
141
142   !!======================================================================
143END MODULE dynkeg
Note: See TracBrowser for help on using the repository browser.