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.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynadv_cen2.F90 @ 10946

Last change on this file since 10946 was 10946, checked in by acc, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert STO, TRD and USR modules and all knock on effects of these conversions. Note change to USR module may have implications for the TEST CASES (not tested yet). Standard SETTE tested only

  • Property svn:keywords set to Id
File size: 7.6 KB
Line 
1MODULE dynadv_cen2
2   !!======================================================================
3   !!                       ***  MODULE  dynadv  ***
4   !! Ocean dynamics: Update the momentum trend with the flux form advection
5   !!                 using a 2nd order centred scheme
6   !!======================================================================
7   !! History :  2.0  ! 2006-08  (G. Madec, S. Theetten)  Original code
8   !!            3.2  ! 2009-07  (R. Benshila)  Suppression of rigid-lid option
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   dyn_adv_cen2  : flux form momentum advection (ln_dynadv_cen2=T) using a 2nd order centred scheme 
13   !!----------------------------------------------------------------------
14   USE oce            ! ocean dynamics and tracers
15   USE dom_oce        ! ocean space and time domain
16   USE trd_oce        ! trends: ocean variables
17   USE trddyn         ! trend manager: dynamics
18   !
19   USE in_out_manager ! I/O manager
20   USE lib_mpp        ! MPP library
21   USE prtctl         ! Print control
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   dyn_adv_cen2   ! routine called by step.F90
27
28   !! * Substitutions
29#  include "vectopt_loop_substitute.h90"
30   !!----------------------------------------------------------------------
31   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
32   !! $Id$
33   !! Software governed by the CeCILL license (see ./LICENSE)
34   !!----------------------------------------------------------------------
35CONTAINS
36
37   SUBROUTINE dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs )
38      !!----------------------------------------------------------------------
39      !!                  ***  ROUTINE dyn_adv_cen2  ***
40      !!
41      !! ** Purpose :   Compute the now momentum advection trend in flux form
42      !!              and the general trend of the momentum equation.
43      !!
44      !! ** Method  :   Trend evaluated using now fields (centered in time)
45      !!
46      !! ** Action  :   (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the now vorticity term trend
47      !!----------------------------------------------------------------------
48      INTEGER                             , INTENT( in )  ::  kt           ! ocean time-step index
49      INTEGER                             , INTENT( in )  ::  Kmm, Krhs    ! ocean time level indices
50      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv     ! ocean velocities and RHS of momentum equation
51      !
52      INTEGER  ::   ji, jj, jk   ! dummy loop indices
53      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfu_t, zfu_f, zfu_uw, zfu
54      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zfv_t, zfv_f, zfv_vw, zfv, zfw
55      !!----------------------------------------------------------------------
56      !
57      IF( kt == nit000 .AND. lwp ) THEN
58         WRITE(numout,*)
59         WRITE(numout,*) 'dyn_adv_cen2 : 2nd order flux form momentum advection'
60         WRITE(numout,*) '~~~~~~~~~~~~'
61      ENDIF
62      !
63      IF( l_trddyn ) THEN           ! trends: store the input trends
64         zfu_uw(:,:,:) = puu(:,:,:,Krhs)
65         zfv_vw(:,:,:) = pvv(:,:,:,Krhs)
66      ENDIF
67      !
68      !                             !==  Horizontal advection  ==!
69      !
70      DO jk = 1, jpkm1                    ! horizontal transport
71         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm)
72         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm)
73         DO jj = 1, jpjm1                 ! horizontal momentum fluxes (at T- and F-point)
74            DO ji = 1, fs_jpim1   ! vector opt.
75               zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) )
76               zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) )
77               zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) )
78               zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) )
79            END DO
80         END DO
81         DO jj = 2, jpjm1                 ! divergence of horizontal momentum fluxes
82            DO ji = fs_2, fs_jpim1   ! vector opt.
83               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    &
84                  &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
85               pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    &
86                  &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
87            END DO
88         END DO
89      END DO
90      !
91      IF( l_trddyn ) THEN           ! trends: send trend to trddyn for diagnostic
92         zfu_uw(:,:,:) = puu(:,:,:,Krhs) - zfu_uw(:,:,:)
93         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) - zfv_vw(:,:,:)
94         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt, Kmm )
95         zfu_t(:,:,:) = puu(:,:,:,Krhs)
96         zfv_t(:,:,:) = pvv(:,:,:,Krhs)
97      ENDIF
98      !
99      !                             !==  Vertical advection  ==!
100      !
101      DO jj = 2, jpjm1                    ! surface/bottom advective fluxes set to zero
102         DO ji = fs_2, fs_jpim1
103            zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(ji,jj,jpk) = 0._wp
104            zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(ji,jj, 1 ) = 0._wp
105         END DO
106      END DO
107      IF( ln_linssh ) THEN                ! linear free surface: advection through the surface
108         DO jj = 2, jpjm1
109            DO ji = fs_2, fs_jpim1
110               zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm)
111               zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm)
112            END DO
113         END DO
114      ENDIF
115      DO jk = 2, jpkm1                    ! interior advective fluxes
116         DO jj = 2, jpj                       ! 1/4 * Vertical transport
117            DO ji = 2, jpi
118               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk)
119            END DO
120         END DO
121         DO jj = 2, jpjm1
122            DO ji = fs_2, fs_jpim1   ! vector opt.
123               zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) )
124               zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) )
125            END DO
126         END DO
127      END DO
128      DO jk = 1, jpkm1                    ! divergence of vertical momentum flux divergence
129         DO jj = 2, jpjm1 
130            DO ji = fs_2, fs_jpim1   ! vector opt.
131               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm)
132               pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm)
133            END DO
134         END DO
135      END DO
136      !
137      IF( l_trddyn ) THEN                 ! trends: send trend to trddyn for diagnostic
138         zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:)
139         zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:)
140         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm )
141      ENDIF
142      !                                   ! Control print
143      IF(ln_ctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cen2 adv - Ua: ', mask1=umask,   &
144         &                       tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' )
145      !
146   END SUBROUTINE dyn_adv_cen2
147
148   !!==============================================================================
149END MODULE dynadv_cen2
Note: See TracBrowser for help on using the repository browser.