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.
dynzad.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90 @ 4438

Last change on this file since 4438 was 4427, checked in by trackstand2, 10 years ago

First files changed on last FINISS work package. Stephen's work although
commited by Andy P.
  • Property svn:keywords set to Id
File size: 7.4 KB
Line 
1MODULE dynzad
2   !!======================================================================
3   !!                       ***  MODULE  dynzad  ***
4   !! Ocean dynamics : vertical advection trend
5   !!======================================================================
6   !! History :  OPA  ! 1991-01  (G. Madec) Original code
7   !!            7.0  ! 1991-11  (G. Madec)
8   !!            7.5  ! 1996-01  (G. Madec) statement function for e3
9   !!   NEMO     0.5  ! 2002-07  (G. Madec) Free form, F90
10   !!----------------------------------------------------------------------
11   
12   !!----------------------------------------------------------------------
13   !!   dyn_zad       : vertical advection momentum trend
14   !!----------------------------------------------------------------------
15   USE oce            ! ocean dynamics and tracers
16   USE dom_oce        ! ocean space and time domain
17   USE sbc_oce        ! surface boundary condition: ocean
18   USE trdmod_oce     ! ocean variables trends
19   USE trdmod         ! ocean dynamics trends
20   USE in_out_manager ! I/O manager
21   USE lib_mpp         ! MPP library
22   USE prtctl         ! Print control
23
24   IMPLICIT NONE
25   PRIVATE
26   
27   PUBLIC   dyn_zad   ! routine called by step.F90
28
29   !! * Control permutation of array indices
30#  include "oce_ftrans.h90"
31#  include "dom_oce_ftrans.h90"
32#  include "sbc_oce_ftrans.h90"
33
34   !! * Substitutions
35#  include "domzgr_substitute.h90"
36#  include "vectopt_loop_substitute.h90"
37   !!----------------------------------------------------------------------
38   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
39   !! $Id$
40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE dyn_zad ( kt )
45      !!----------------------------------------------------------------------
46      !!                  ***  ROUTINE dynzad  ***
47      !!
48      !! ** Purpose :   Compute the now vertical momentum advection trend and
49      !!      add it to the general trend of momentum equation.
50      !!
51      !! ** Method  :   The now vertical advection of momentum is given by:
52      !!         w dz(u) = ua + 1/(e1u*e2u*e3u) mk+1[ mi(e1t*e2t*wn) dk(un) ]
53      !!         w dz(v) = va + 1/(e1v*e2v*e3v) mk+1[ mj(e1t*e2t*wn) dk(vn) ]
54      !!      Add this trend to the general trend (ua,va):
55      !!         (ua,va) = (ua,va) + w dz(u,v)
56      !!
57      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends
58      !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn')
59     !!----------------------------------------------------------------------
60      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
61      USE wrk_nemo, ONLY:   zww   => wrk_2d_1                        ! 2D workspace
62      USE oce     , ONLY:   zwuw  => ta       , zwvw  => sa          ! (ta,sa) used as 3D workspace
63      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2    ! 3D workspace
64      !! DCSE_NEMO: need additional directives for renamed module variables
65!FTRANS zwuw  :I :I :z
66!FTRANS zwvw  :I :I :z
67!FTRANS ztrdu :I :I :z
68!FTRANS ztrdv :I :I :z
69      !
70      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
71      !
72      INTEGER  ::   ji, jj, jk      ! dummy loop indices
73      REAL(wp) ::   zua, zva        ! temporary scalars
74      !!----------------------------------------------------------------------
75     
76      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN
77         CALL ctl_stop('dyn_zad: requested workspace arrays unavailable')   ;   RETURN
78      ENDIF
79
80      IF( kt == nit000 ) THEN
81         IF(lwp)WRITE(numout,*)
82         IF(lwp)WRITE(numout,*) 'dyn_zad : arakawa advection scheme'
83      ENDIF
84
85      IF( l_trddyn )   THEN         ! Save ua and va trends
86         ztrdu(:,:,:) = ua(:,:,:) 
87         ztrdv(:,:,:) = va(:,:,:) 
88      ENDIF
89
90#if defined key_z_first
91      !! DCSE_NEMO: Attention! Eliminate k-dependence from zww to re-order loops
92      DO jj = 2, jpj                   ! vertical fluxes
93         DO ji = 2, jpi
94            zww(ji,jj) = 0.25 * e1t(ji,jj) * e2t(ji,jj)
95         END DO
96      END DO
97      DO jj = 2, jpjm1                 ! vertical momentum advection at w-point
98         DO ji = 2, jpim1
99            zwuw(ji,jj, 1 ) = 0.e0     ! Surface values set to zero
100            zwvw(ji,jj, 1 ) = 0.e0
101            DO jk = 2, mbkmax(ji,jj)-1
102               zwuw(ji,jj,jk) =   ( zww(ji+1,jj  )*wn(ji+1,jj  ,jk) + zww(ji,jj)*wn(ji,jj,jk) )   &
103                  &             * ( un(ji,jj,jk-1)-un(ji,jj,jk) ) 
104               zwvw(ji,jj,jk) =   ( zww(ji  ,jj+1)*wn(ji  ,jj+1,jk) + zww(ji,jj)*wn(ji,jj,jk) )   &
105                  &             * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) )
106            END DO 
107            zwuw(ji,jj,mbkmax(ji,jj)) = 0.e0     ! Bottom values set to zero
108            zwvw(ji,jj,mbkmax(ji,jj)) = 0.e0
109         END DO   
110      END DO
111#else
112      DO jk = 2, jpkm1              ! Vertical momentum advection at level w and u- and v- vertical
113         DO jj = 2, jpj                   ! vertical fluxes
114            DO ji = fs_2, jpi             ! vector opt.
115               zww(ji,jj) = 0.25 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk)
116            END DO
117         END DO
118         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point
119            DO ji = fs_2, fs_jpim1        ! vector opt.
120               zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1)-un(ji,jj,jk) )
121               zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) )
122            END DO 
123         END DO   
124      END DO
125      DO jj = 2, jpjm1              ! Surface and bottom values set to zero
126         DO ji = fs_2, fs_jpim1           ! vector opt.
127            zwuw(ji,jj, 1 ) = 0.e0
128            zwvw(ji,jj, 1 ) = 0.e0
129            zwuw(ji,jj,jpk) = 0.e0
130            zwvw(ji,jj,jpk) = 0.e0
131         END DO 
132      END DO
133#endif
134
135#if defined key_z_first
136      DO jj = 2, jpjm1              ! Vertical momentum advection at u- and v-points
137         DO ji = 2, jpim1
138            DO jk = 1, mbkmax(ji,jj)-1
139#else
140      DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points
141         DO jj = 2, jpjm1
142            DO ji = fs_2, fs_jpim1       ! vector opt.
143#endif
144               !                         ! vertical momentum advective trends
145               zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
146               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
147               !                         ! add the trends to the general momentum trends
148               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
149               va(ji,jj,jk) = va(ji,jj,jk) + zva
150            END DO 
151         END DO 
152      END DO
153
154      IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic
155         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
156         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
157         CALL trd_mod(ztrdu, ztrdv, jpdyn_trd_zad, 'DYN', kt)
158      ENDIF
159
160      !                             ! Control print
161      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' zad  - Ua: ', mask1=umask,   &
162         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
163      !
164      IF( wrk_not_released(2, 1)   .OR.   &
165          wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zad: failed to release workspace arrays')
166      !
167   END SUBROUTINE dyn_zad
168
169   !!======================================================================
170END MODULE dynzad
Note: See TracBrowser for help on using the repository browser.