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.
trddyn.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.

File size: 11.1 KB
Line 
1MODULE trddyn
2   !!======================================================================
3   !!                       ***  MODULE  trddyn  ***
4   !! Ocean diagnostics:  ocean dynamic trends
5   !!=====================================================================
6   !! History :  3.5  !  2012-02  (G. Madec) creation from trdmod: split DYN and TRA trends
7   !!                                        and manage  3D trends output for U, V, and KE
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   trd_dyn       : manage the type of momentum trend diagnostics (3D I/O, domain averaged, KE)
12   !!   trd_dyn_iom   : output 3D momentum and/or tracer trends using IOM
13   !!   trd_dyn_init  : initialization step
14   !!----------------------------------------------------------------------
15   USE oce            ! ocean dynamics and tracers variables
16   USE dom_oce        ! ocean space and time domain variables
17   USE zdf_oce        ! ocean vertical physics variables
18   USE trd_oce        ! trends: ocean variables
19   USE zdfbfr         ! bottom friction
20   USE sbc_oce        ! surface boundary condition: ocean
21   USE phycst         ! physical constants
22   USE trdken         ! trends: Kinetic ENergy
23   USE trdglo         ! trends: global domain averaged
24   USE trdvor         ! trends: vertical averaged vorticity
25   USE trdmxl         ! trends: mixed layer averaged
26   USE in_out_manager ! I/O manager
27   USE lbclnk         ! lateral boundary condition
28   USE iom            ! I/O manager library
29   USE lib_mpp        ! MPP library
30   USE wrk_nemo       ! Memory allocation
31
32   USE yomhook, ONLY: lhook, dr_hook
33   USE parkind1, ONLY: jprb, jpim
34
35   IMPLICIT NONE
36   PRIVATE
37
38   PUBLIC trd_dyn        ! called by all dynXX modules
39
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42#  include "vectopt_loop_substitute.h90"
43   !!----------------------------------------------------------------------
44   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
45   !! $Id$
46   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
47   !!----------------------------------------------------------------------
48CONTAINS
49
50   SUBROUTINE trd_dyn( putrd, pvtrd, ktrd, kt )
51      !!---------------------------------------------------------------------
52      !!                  ***  ROUTINE trd_mod  ***
53      !!
54      !! ** Purpose :   Dispatch momentum trend computation, e.g. 3D output,
55      !!              integral constraints, barotropic vorticity, kinetic enrgy,
56      !!              and/or mixed layer budget.
57      !!----------------------------------------------------------------------
58      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends
59      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
60      INTEGER                   , INTENT(in   ) ::   kt             ! time step
61      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
62      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
63      REAL(KIND=jprb)               :: zhook_handle
64
65      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_DYN'
66
67      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
68
69      !!----------------------------------------------------------------------
70      !
71      putrd(:,:,:) = putrd(:,:,:) * umask(:,:,:)                       ! mask the trends
72      pvtrd(:,:,:) = pvtrd(:,:,:) * vmask(:,:,:)
73      !
74
75!!gm NB : here a lbc_lnk should probably be added
76
77      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
78      !   3D output of momentum and/or tracers trends using IOM interface
79      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
80      IF( ln_dyn_trd )   CALL trd_dyn_iom( putrd, pvtrd, ktrd, kt )
81         
82      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
83      !  Integral Constraints Properties for momentum and/or tracers trends
84      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
85      IF( ln_glo_trd )   CALL trd_glo( putrd, pvtrd, ktrd, 'DYN', kt )
86
87      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
88      !  Kinetic Energy trends
89      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
90      IF( ln_KE_trd  )   CALL trd_ken( putrd, pvtrd, ktrd, kt )
91
92      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
93      !  Vorticity trends
94      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
95      IF( ln_vor_trd )   CALL trd_vor( putrd, pvtrd, ktrd, kt )
96
97      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
98      !  Mixed layer trends for active tracers
99      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
100!!gm      IF( ln_dyn_mxl )   CALL trd_mxl_dyn   
101      !
102      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
103   END SUBROUTINE trd_dyn
104
105
106   SUBROUTINE trd_dyn_iom( putrd, pvtrd, ktrd, kt )
107      !!---------------------------------------------------------------------
108      !!                  ***  ROUTINE trd_dyn_iom  ***
109      !!
110      !! ** Purpose :   output 3D trends using IOM
111      !!----------------------------------------------------------------------
112      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   putrd, pvtrd   ! U and V trends
113      INTEGER                   , INTENT(in   ) ::   ktrd           ! trend index
114      INTEGER                   , INTENT(in   ) ::   kt             ! time step
115      !
116      INTEGER ::   ji, jj, jk   ! dummy loop indices
117      INTEGER ::   ikbu, ikbv   ! local integers
118      REAL(wp), POINTER, DIMENSION(:,:)   ::   z2dx, z2dy   ! 2D workspace
119      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z3dx, z3dy   ! 3D workspace
120      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
121      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
122      REAL(KIND=jprb)               :: zhook_handle
123
124      CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_DYN_IOM'
125
126      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
127
128      !!----------------------------------------------------------------------
129      !
130      SELECT CASE( ktrd )
131      CASE( jpdyn_hpg )   ;   CALL iom_put( "utrd_hpg", putrd )    ! hydrostatic pressure gradient
132                              CALL iom_put( "vtrd_hpg", pvtrd )
133      CASE( jpdyn_spg )   ;   CALL iom_put( "utrd_spg", putrd )    ! surface pressure gradient
134                              CALL iom_put( "vtrd_spg", pvtrd )
135      CASE( jpdyn_spgexp );   CALL iom_put( "utrd_spgexp", putrd ) ! surface pressure gradient (explicit)
136                              CALL iom_put( "vtrd_spgexp", pvtrd )
137      CASE( jpdyn_spgflt );   CALL iom_put( "utrd_spgflt", putrd ) ! surface pressure gradient (filtered)
138                              CALL iom_put( "vtrd_spgflt", pvtrd )
139      CASE( jpdyn_pvo )   ;   CALL iom_put( "utrd_pvo", putrd )    ! planetary vorticity
140                              CALL iom_put( "vtrd_pvo", pvtrd )
141      CASE( jpdyn_rvo )   ;   CALL iom_put( "utrd_rvo", putrd )    ! relative  vorticity     (or metric term)
142                              CALL iom_put( "vtrd_rvo", pvtrd )
143      CASE( jpdyn_keg )   ;   CALL iom_put( "utrd_keg", putrd )    ! Kinetic Energy gradient (or had)
144                              CALL iom_put( "vtrd_keg", pvtrd )
145                              CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy )
146                              z3dx(:,:,:) = 0._wp                  ! U.dxU & V.dyV (approximation)
147                              z3dy(:,:,:) = 0._wp
148                              DO jk = 1, jpkm1                 ! no mask as un,vn are masked
149                                 DO jj = 2, jpjm1
150                                    DO ji = 2, jpim1
151                                       z3dx(ji,jj,jk) = un(ji,jj,jk) * ( un(ji+1,jj,jk) - un(ji-1,jj,jk) ) / ( 2._wp * e1u(ji,jj) )
152                                       z3dy(ji,jj,jk) = vn(ji,jj,jk) * ( vn(ji,jj+1,jk) - vn(ji,jj-1,jk) ) / ( 2._wp * e2v(ji,jj) )
153                                    END DO
154                                 END DO
155                              END DO
156                              CALL lbc_lnk( z3dx, 'U', -1. )
157                              CALL lbc_lnk( z3dy, 'V', -1. )
158                              CALL iom_put( "utrd_udx", z3dx  )
159                              CALL iom_put( "vtrd_vdy", z3dy  )
160                              CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )
161      CASE( jpdyn_zad )   ;   CALL iom_put( "utrd_zad", putrd )    ! vertical   advection
162                              CALL iom_put( "vtrd_zad", pvtrd )
163      CASE( jpdyn_ldf )   ;   CALL iom_put( "utrd_ldf", putrd )    ! lateral diffusion
164                              CALL iom_put( "vtrd_ldf", pvtrd )
165      CASE( jpdyn_zdf )   ;   CALL iom_put( "utrd_zdf", putrd )    ! vertical diffusion
166                              CALL iom_put( "vtrd_zdf", pvtrd )
167                              !                                    ! wind stress trends
168                              CALL wrk_alloc( jpi, jpj, z2dx, z2dy )
169                              z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( fse3u(:,:,1) * rau0 )
170                              z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( fse3v(:,:,1) * rau0 )
171                              CALL iom_put( "utrd_tau", z2dx )
172                              CALL iom_put( "vtrd_tau", z2dy )
173                              CALL wrk_dealloc( jpi, jpj, z2dx, z2dy )
174      CASE( jpdyn_bfr )       ! called if ln_bfrimp=T
175                              CALL iom_put( "utrd_bfr", putrd )    ! bottom friction (explicit case)
176                              CALL iom_put( "vtrd_bfr", pvtrd )
177      CASE( jpdyn_atf )   ;   CALL iom_put( "utrd_atf", putrd )        ! asselin filter trends
178                              CALL iom_put( "vtrd_atf", pvtrd )
179      CASE( jpdyn_bfri )  ;   IF( ln_bfrimp ) THEN                     ! bottom friction (implicit case)
180                                 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy )
181                                 z3dx(:,:,:) = 0._wp   ;   z3dy(:,:,:) = 0._wp  ! after velocity known (now filed at this stage)
182                                 DO jk = 1, jpkm1
183                                    DO jj = 2, jpjm1
184                                       DO ji = 2, jpim1
185                                          ikbu = mbku(ji,jj)          ! deepest ocean u- & v-levels
186                                          ikbv = mbkv(ji,jj)
187                                          z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) / fse3u(ji,jj,ikbu)
188                                          z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) / fse3v(ji,jj,ikbv)
189                                       END DO
190                                    END DO
191                                 END DO
192                                 CALL lbc_lnk( z3dx, 'U', -1. ) ; CALL lbc_lnk( z3dy, 'V', -1. )
193                                 CALL iom_put( "utrd_bfri", z3dx )
194                                 CALL iom_put( "vtrd_bfri", z3dy )
195                                 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )
196                              ENDIF
197      END SELECT
198      !
199      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
200   END SUBROUTINE trd_dyn_iom
201
202   !!======================================================================
203END MODULE trddyn
Note: See TracBrowser for help on using the repository browser.