source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 12 months ago

The Dr Hook changes from my perl code.

File size: 9.2 KB
Line 
1MODULE dynadv
2   !!==============================================================================
3   !!                       ***  MODULE  dynadv  ***
4   !! Ocean active tracers:  advection scheme control
5   !!==============================================================================
6   !! History :  1.0  !  2006-11  (G. Madec)  Original code
7   !!            3.3  !  2010-10  (C. Ethe, G. Madec)  reorganisation of initialisation phase
8   !!            3.6  !  2015-05  (N. Ducousso, G. Madec)  add Hollingsworth scheme as an option
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   dyn_adv      : compute the momentum advection trend
13   !!   dyn_adv_init : control the different options of advection scheme
14   !!----------------------------------------------------------------------
15   USE dom_oce         ! ocean space and time domain
16   USE dynadv_cen2     ! centred flux form advection      (dyn_adv_cen2 routine)
17   USE dynadv_ubs      ! UBS flux form advection          (dyn_adv_ubs  routine)
18   USE dynkeg          ! kinetic energy gradient          (dyn_keg      routine)
19   USE dynzad          ! vertical advection               (dyn_zad      routine)
20   !
21   USE in_out_manager  ! I/O manager
22   USE lib_mpp         ! MPP library
23   USE timing          ! Timing
24
25   USE yomhook, ONLY: lhook, dr_hook
26   USE parkind1, ONLY: jprb, jpim
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC dyn_adv       ! routine called by step module
32   PUBLIC dyn_adv_init  ! routine called by opa  module
33 
34   !                                    !* namdyn_adv namelist *
35   LOGICAL, PUBLIC ::   ln_dynadv_vec   !: vector form flag
36   INTEGER, PUBLIC ::   nn_dynkeg       !: scheme of kinetic energy gradient: =0 C2 ; =1 Hollingsworth
37   LOGICAL, PUBLIC ::   ln_dynadv_cen2  !: flux form - 2nd order centered scheme flag
38   LOGICAL, PUBLIC ::   ln_dynadv_ubs   !: flux form - 3rd order UBS scheme flag
39   LOGICAL, PUBLIC ::   ln_dynzad_zts   !: vertical advection with sub-timestepping (requires vector form)
40   
41   INTEGER ::   nadv   ! choice of the formulation and scheme for the advection
42
43   !! * Substitutions
44#  include "domzgr_substitute.h90"
45#  include "vectopt_loop_substitute.h90"
46   !!----------------------------------------------------------------------
47   !! NEMO/OPA 3.6 , NEMO Consortium (2015)
48   !! $Id$
49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
50   !!----------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE dyn_adv( kt )
54      !!---------------------------------------------------------------------
55      !!                  ***  ROUTINE dyn_adv  ***
56      !!               
57      !! ** Purpose :   compute the ocean momentum advection trend.
58      !!
59      !! ** Method  : - Update (ua,va) with the advection term following nadv
60      !!      NB: in flux form advection (ln_dynadv_cen2 or ln_dynadv_ubs=T)
61      !!      a metric term is add to the coriolis term while in vector form
62      !!      it is the relative vorticity which is added to coriolis term
63      !!      (see dynvor module).
64      !!----------------------------------------------------------------------
65      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
66      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
67      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
68      REAL(KIND=jprb)               :: zhook_handle
69
70      CHARACTER(LEN=*), PARAMETER :: RoutineName='DYN_ADV'
71
72      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
73
74      !!----------------------------------------------------------------------
75      !
76      IF( nn_timing == 1 )  CALL timing_start('dyn_adv')
77      !
78      SELECT CASE ( nadv )                  ! compute advection trend and add it to general trend
79      CASE ( 0 )     
80                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy
81                      CALL dyn_zad     ( kt )               ! vector form : vertical advection
82      CASE ( 1 )     
83                      CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy
84                      CALL dyn_zad_zts ( kt )               ! vector form : vertical advection with sub-timestepping
85      CASE ( 2 ) 
86                      CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme
87      CASE ( 3 )   
88                      CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme
89      !
90      CASE (-1 )                                            ! esopa: test all possibility with control print
91                      CALL dyn_keg     ( kt, nn_dynkeg )
92                      CALL dyn_zad     ( kt )
93                      CALL dyn_adv_cen2( kt )
94                      CALL dyn_adv_ubs ( kt )
95      END SELECT
96      !
97      IF( nn_timing == 1 )  CALL timing_stop('dyn_adv')
98      !
99      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
100   END SUBROUTINE dyn_adv
101
102   
103   SUBROUTINE dyn_adv_init
104      !!---------------------------------------------------------------------
105      !!                  ***  ROUTINE dyn_adv_init  ***
106      !!               
107      !! ** Purpose :   Control the consistency between namelist options for
108      !!              momentum advection formulation & scheme and set nadv
109      !!----------------------------------------------------------------------
110      INTEGER ::   ioptio, ios   ! Local integer
111      !
112      NAMELIST/namdyn_adv/ ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts
113      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
114      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
115      REAL(KIND=jprb)               :: zhook_handle
116
117      CHARACTER(LEN=*), PARAMETER :: RoutineName='DYN_ADV_INIT'
118
119      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
120
121      !!----------------------------------------------------------------------
122      !
123      REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme
124      READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901)
125901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in reference namelist', lwp )
126
127      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme
128      READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 )
129902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist', lwp )
130      IF(lwm) WRITE ( numond, namdyn_adv )
131
132      IF(lwp) THEN                    ! Namelist print
133         WRITE(numout,*)
134         WRITE(numout,*) 'dyn_adv_init : choice/control of the momentum advection scheme'
135         WRITE(numout,*) '~~~~~~~~~~~'
136         WRITE(numout,*) '       Namelist namdyn_adv : chose a advection formulation & scheme for momentum'
137         WRITE(numout,*) '          Vector/flux form (T/F)                           ln_dynadv_vec  = ', ln_dynadv_vec
138         WRITE(numout,*) '          = 0 standard scheme  ; =1 Hollingsworth scheme   nn_dynkeg      = ', nn_dynkeg
139         WRITE(numout,*) '          2nd order centred advection scheme               ln_dynadv_cen2 = ', ln_dynadv_cen2
140         WRITE(numout,*) '          3rd order UBS advection scheme                   ln_dynadv_ubs  = ', ln_dynadv_ubs
141         WRITE(numout,*) '          Sub timestepping of vertical advection           ln_dynzad_zts  = ', ln_dynzad_zts
142      ENDIF
143
144      ioptio = 0                      ! Parameter control
145      IF( ln_dynadv_vec  )   ioptio = ioptio + 1
146      IF( ln_dynadv_cen2 )   ioptio = ioptio + 1
147      IF( ln_dynadv_ubs  )   ioptio = ioptio + 1
148      IF( lk_esopa       )   ioptio =          1
149
150      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' )
151      IF( ln_dynzad_zts .AND. .NOT. ln_dynadv_vec )   &
152         CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' )
153      IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW )   & 
154         CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' )
155
156      !                               ! Set nadv
157      IF( ln_dynadv_vec  )   nadv =  0 
158      IF( ln_dynzad_zts  )   nadv =  1
159      IF( ln_dynadv_cen2 )   nadv =  2
160      IF( ln_dynadv_ubs  )   nadv =  3
161      IF( lk_esopa       )   nadv = -1
162
163      IF(lwp) THEN                    ! Print the choice
164         WRITE(numout,*)
165         IF( nadv ==  0 )   WRITE(numout,*) '         vector form : keg + zad + vor is used' 
166         IF( nadv ==  1 )   WRITE(numout,*) '         vector form : keg + zad_zts + vor is used'
167         IF( nadv ==  0 .OR. nadv ==  1 ) THEN
168            IF( nn_dynkeg == nkeg_C2  )   WRITE(numout,*) 'with Centered standard keg scheme'
169            IF( nn_dynkeg == nkeg_HW  )   WRITE(numout,*) 'with Hollingsworth keg scheme'
170         ENDIF
171         IF( nadv ==  2 )   WRITE(numout,*) '         flux form   : 2nd order scheme is used'
172         IF( nadv ==  3 )   WRITE(numout,*) '         flux form   : UBS       scheme is used'
173         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection formulation'
174      ENDIF
175      !
176      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
177   END SUBROUTINE dyn_adv_init
178
179  !!======================================================================
180END MODULE dynadv
Note: See TracBrowser for help on using the repository browser.