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.
dynadv_cen2_tam.F90 in branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/DYN – NEMO

source: branches/2012/dev_r3604_LEGI8_TAM/NEMOGCM/NEMO/OPATAM_SRC/DYN/dynadv_cen2_tam.F90 @ 3611

Last change on this file since 3611 was 3611, checked in by pabouttier, 11 years ago

Add TAM code and ORCA2_TAM configuration - see Ticket #1007
  • Property svn:executable set to *
File size: 8.9 KB
Line 
1MODULE dynadv_cen2_tam
2#if defined key_tam
3   !!======================================================================
4   !!                       ***  MODULE  dynadv_cen2_tam  ***
5   !! Ocean dynamics: Update the momentum trend with the flux form advection
6   !!                 using a 2nd order centred scheme
7   !!======================================================================
8   !! History of the direct module:
9   !!            2.0  ! 2006-08  (G. Madec, S. Theetten)  Original code
10   !!            3.2  ! 2009-07  (R. Benshila)  Suppression of rigid-lid option
11   !! History ot the T&A module
12   !!            3.2  ! 2011-01  (A. Vidard) Original version
13   !!            3.4  ! 2012-07  (P.-A. bouttier) Phasing with 3.4
14   !!----------------------------------------------------------------------
15   !!----------------------------------------------------------------------
16   !!   dyn_adv_cen2       : flux form momentum advection (ln_dynadv_cen2=T)
17   !!                        trends using a 2nd order centred scheme
18   !!----------------------------------------------------------------------
19   USE oce
20   USE dom_oce
21   USE oce_tam
22   USE in_out_manager
23   USE wrk_nemo        ! Memory Allocation
24   USE timing          ! Timing
25
26   IMPLICIT NONE
27   PRIVATE
28
29   !! * Routine accessibility
30   PUBLIC dyn_adv_cen2_tan                 ! routine called by step_tam.F90
31
32   !! * Substitutions
33#  include "domzgr_substitute.h90"
34#  include "vectopt_loop_substitute.h90"
35   !!----------------------------------------------------------------------
36   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
37   !! $Id$
38   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
39   !!----------------------------------------------------------------------
40CONTAINS
41   SUBROUTINE dyn_adv_cen2_tan( kt )
42      !!----------------------------------------------------------------------
43      !!                  ***  ROUTINE dyn_adv_cen2_tan  ***
44      !!
45      !! ** Purpose :   Compute the now momentum advection trend in flux form
46      !!      and the general trend of the momentum equation.
47      !!
48      !! ** Method  :   Trend evaluated using now fields (centered in time)
49      !!
50      !! ** Action : - Update (ua,va) with the now vorticity term trend
51      !!----------------------------------------------------------------------
52      !!
53      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
54      !!
55      INTEGER  ::   ji, jj, jk   ! dummy loop indices
56      REAL(wp) ::   zbu, zbv     ! temporary scalars
57      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zfu_ttl, zfu_ftl, zfu_uwtl   ! 3D workspace
58      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zfv_ttl, zfv_ftl, zfv_vwtl   !  -      -
59      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zfw, zfu, zfv          !  -      -
60      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zfwtl, zfutl, zfvtl          !  -      -
61      !!----------------------------------------------------------------------
62      !
63      IF ( nn_timing == 1 )  CALL timing_start('dyn_adv_cen2_tan')
64      !
65      CALL wrk_alloc( jpi, jpj, jpk, zfu_ttl, zfv_ttl, zfu_ftl, zfv_ftl, zfu_uwtl, zfv_vwtl, zfutl, zfvtl, zfwtl )
66      !
67      IF ( kt == nit000 ) THEN
68         IF(lwp) WRITE(numout,*)
69         IF(lwp) WRITE(numout,*) 'dyn_adv_cen2_tan : 2nd order flux form momentum advection'
70         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
71      ENDIF
72      !                                      ! ====================== !
73      !                                      !  Horizontal advection  !
74      DO jk = 1, jpkm1                       ! ====================== !
75         !                                         ! horizontal volume fluxes
76         zfu(:,:,jk)   = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
77         zfv(:,:,jk)   = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
78         zfutl(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un_tl(:,:,jk)
79         zfvtl(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,jk) * vn_tl(:,:,jk)
80         !
81         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point
82            DO ji = 1, fs_jpim1   ! vector opt.
83               zfu_ttl(ji+1,jj  ,jk) = ( zfutl(ji,jj,jk) + zfutl(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji+1,jj  ,jk) ) &
84                  &                  + ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk) ) * ( un_tl(ji,jj,jk) + un_tl(ji+1,jj  ,jk) )
85               zfv_ftl(ji  ,jj  ,jk) = ( zfvtl(ji,jj,jk) + zfvtl(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) ) &
86                  &                  + ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) ) * ( un_tl(ji,jj,jk) + un_tl(ji  ,jj+1,jk) )
87               zfu_ftl(ji  ,jj  ,jk) = ( zfutl(ji,jj,jk) + zfutl(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) ) &
88                  &                  + ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) ) * ( vn_tl(ji,jj,jk) + vn_tl(ji+1,jj  ,jk) )
89               zfv_ttl(ji  ,jj+1,jk) = ( zfvtl(ji,jj,jk) + zfvtl(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) ) &
90                  &                  + ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk) ) * ( vn_tl(ji,jj,jk) + vn_tl(ji  ,jj+1,jk) )
91            END DO
92         END DO
93         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes
94            DO ji = fs_2, fs_jpim1   ! vector opt.
95               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
96               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
97               !
98               ua_tl(ji,jj,jk) = ua_tl(ji,jj,jk) - (  zfu_ttl(ji+1,jj  ,jk) - zfu_ttl(ji  ,jj  ,jk)    &
99                  &                           + zfv_ftl(ji  ,jj  ,jk) - zfv_ftl(ji  ,jj-1,jk)  ) / zbu
100               va_tl(ji,jj,jk) = va_tl(ji,jj,jk) - (  zfu_ftl(ji  ,jj  ,jk) - zfu_ftl(ji-1,jj  ,jk)    &
101                  &                           + zfv_ttl(ji  ,jj+1,jk) - zfv_ttl(ji  ,jj  ,jk)  ) / zbv
102            END DO
103         END DO
104      END DO
105      !
106      !                                      ! ==================== !
107      !                                      !  Vertical advection  !
108      DO jk = 1, jpkm1                       ! ==================== !
109         !                                         ! Vertical volume fluxes 
110         zfw(:,:,jk)   = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk)
111         zfwtl(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn_tl(:,:,jk)
112         !
113         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes
114            zfu_uwtl(:,:,jpk) = 0.e0                      ! Bottom  value : flux set to zero
115            zfv_vwtl(:,:,jpk) = 0.e0
116            !                                           ! Surface value :
117            IF( lk_vvl ) THEN                                ! variable volume : flux set to zero
118               zfu_uwtl(:,:, 1 ) = 0.e0
119               zfv_vwtl(:,:, 1 ) = 0.e0
120            ELSE                                             ! constant volume : advection through the surface
121               DO jj = 2, jpjm1
122                  DO ji = fs_2, fs_jpim1
123                     zfu_uwtl(ji,jj, 1 ) = 2.e0 * ( zfwtl(ji,jj,1) + zfwtl(ji+1,jj  ,1) ) * un(   ji,jj,1) &
124                        &                + 2.e0 * ( zfw(  ji,jj,1) + zfw(  ji+1,jj  ,1) ) * un_tl(ji,jj,1)
125                     zfv_vwtl(ji,jj, 1 ) = 2.e0 * ( zfwtl(ji,jj,1) + zfwtl(ji  ,jj+1,1) ) * vn(   ji,jj,1) &
126                        &                + 2.e0 * ( zfw(  ji,jj,1) + zfw(  ji  ,jj+1,1) ) * vn_tl(ji,jj,1)
127                  END DO
128               END DO
129            ENDIF
130         ELSE                                      ! interior fluxes
131            DO jj = 2, jpjm1
132               DO ji = fs_2, fs_jpim1   ! vector opt.
133                  zfu_uwtl(ji,jj,jk) = ( zfwtl(ji,jj,jk)+ zfwtl(ji+1,jj  ,jk) ) * ( un(   ji,jj,jk) + un(   ji,jj,jk-1) ) &
134                     &               + ( zfw(  ji,jj,jk)+ zfw(  ji+1,jj  ,jk) ) * ( un_tl(ji,jj,jk) + un_tl(ji,jj,jk-1) )
135                  zfv_vwtl(ji,jj,jk) = ( zfwtl(ji,jj,jk)+ zfwtl(ji  ,jj+1,jk) ) * ( vn(   ji,jj,jk) + vn(   ji,jj,jk-1) ) &
136                     &               + ( zfw(  ji,jj,jk)+ zfw(  ji  ,jj+1,jk) ) * ( vn_tl(ji,jj,jk) + vn_tl(ji,jj,jk-1) )
137               END DO
138            END DO
139         ENDIF
140      END DO
141      DO jk = 1, jpkm1                             ! divergence of vertical momentum flux divergence
142         DO jj = 2, jpjm1
143            DO ji = fs_2, fs_jpim1   ! vector opt.
144               ua_tl(ji,jj,jk) =  ua_tl(ji,jj,jk) - ( zfu_uwtl(ji,jj,jk) - zfu_uwtl(ji,jj,jk+1) )    &
145                  &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
146               va_tl(ji,jj,jk) =  va_tl(ji,jj,jk) - ( zfv_vwtl(ji,jj,jk) - zfv_vwtl(ji,jj,jk+1) )    &
147                  &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
148            END DO
149         END DO
150      END DO
151      !
152      CALL wrk_dealloc( jpi, jpj, jpk, zfu_ttl, zfv_ttl, zfu_ftl, zfv_ftl, zfu_uwtl, zfv_vwtl, zfutl, zfvtl, zfwtl )
153      !
154      IF( nn_timing == 1 )  CALL timing_stop('dyn_adv_cen2_tan')
155      !
156   END SUBROUTINE dyn_adv_cen2_tan
157#endif
158   !!==============================================================================
159END MODULE dynadv_cen2_tam
Note: See TracBrowser for help on using the repository browser.