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.
dynspg.F90 in trunk/NEMO/OPA_SRC/DYN – NEMO

source: trunk/NEMO/OPA_SRC/DYN/dynspg.F90 @ 367

Last change on this file since 367 was 367, checked in by opalod, 18 years ago

nemo_v1_update_035 : CT : OBCs adapted to the new surface pressure gradient algorithms
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 9.3 KB
Line 
1MODULE dynspg
2   !!======================================================================
3   !!                       ***  MODULE  dynspg  ***
4   !! Ocean dynamics:  surface pressure gradient control
5   !!======================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dyn_spg     : update the dynamics trend with the lateral diffusion
9   !!   dyn_spg_ctl : initialization, namelist read, and parameters control
10   !!----------------------------------------------------------------------
11   !! * Modules used
12   USE oce            ! ocean dynamics and tracers variables
13   USE dom_oce        ! ocean space and time domain variables
14   USE obc_oce        ! ocean open boundary conditions
15   USE dynspg_oce     ! surface pressure gradient variables
16   USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine)
17   USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine)
18   USE dynspg_flt     ! surface pressure gradient     (dyn_spg_flt routine)
19   USE dynspg_rl      ! surface pressure gradient     (dyn_spg_rl  routine)
20   USE dynspg_flt_jki ! surface pressure gradient  (dyn_spgflt_jki routine)
21   USE trdmod         ! ocean dynamics trends
22   USE trdmod_oce     ! ocean variables trends
23   USE prtctl         ! Print control                     (prt_ctl routine)
24   USE in_out_manager ! I/O manager
25
26   IMPLICIT NONE
27   PRIVATE
28
29   !! * Accessibility
30   PUBLIC dyn_spg         ! routine called by step module
31
32   !! * module variables
33   INTEGER ::                        &
34      nspg = 0                         ! type of surface pressure gradient scheme
35      !                                ! defined from lk_dynspg_...
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39#  include "vectopt_loop_substitute.h90"
40   !!----------------------------------------------------------------------
41   !!   OPA 9.0 , LOCEAN-IPSL (2005)
42   !! $Header$
43   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
44   !!----------------------------------------------------------------------
45
46CONTAINS
47
48   SUBROUTINE dyn_spg( kt, kindic )
49      !!----------------------------------------------------------------------
50      !!                  ***  ROUTINE dyn_spg  ***
51      !!
52      !! ** Purpose :   compute the lateral ocean dynamics physics.
53      !!
54      !! History :
55      !!   9.0  !  05-12  (C. Talandier, G. Madec)  Original code
56      !!----------------------------------------------------------------------
57      !! * Arguments
58      INTEGER, INTENT( in  ) ::   kt     ! ocean time-step index
59      INTEGER, INTENT( out ) ::   kindic ! solver flag
60
61      !! * local declarations
62      REAL(wp) ::   z2dt                      ! temporary scalar
63      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &
64         ztrdu, ztrdv                         ! 3D temporary workspace
65      !!----------------------------------------------------------------------
66
67      IF( kt == nit000 )   CALL dyn_spg_ctl      ! initialisation & control of options
68
69      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
70         ztrdu(:,:,:) = ua(:,:,:)
71         ztrdv(:,:,:) = va(:,:,:)
72      ENDIF
73
74      SELECT CASE ( nspg )                       ! compute surf. pressure gradient trend and add it to the general trend
75      CASE ( -1 )                                       ! esopa: test all possibility with control print
76         CALL dyn_spg_exp    ( kt )
77         IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, &
78               &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
79         CALL dyn_spg_ts     ( kt )
80         IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, &
81               &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
82         CALL dyn_spg_flt  ( kt, kindic )
83         IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, &
84               &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
85         CALL dyn_spg_flt_jki( kt, kindic )
86         IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg4 - Ua: ', mask1=umask, &
87               &                    tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
88      CASE ( 0 )                                       ! explicit
89         CALL dyn_spg_exp    ( kt )
90      CASE ( 1 )                                       ! time-splitting
91         CALL dyn_spg_ts     ( kt )
92      CASE ( 2 )                                       ! filtered
93         CALL dyn_spg_flt    ( kt, kindic )
94      CASE ( 3 )                                       ! rigid lid
95         CALL dyn_spg_rl     ( kt, kindic )
96      CASE ( 4 )                                       ! filtered with j-k-i loop
97         CALL dyn_spg_flt_jki( kt, kindic )
98      END SELECT
99
100      !                                          ! save the horizontal diffusive trends for further diagnostics
101      IF( l_trddyn )   THEN
102         SELECT CASE ( nspg )
103         CASE ( 0, 1, 3 )
104            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
105            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
106         CASE( 2 )
107            z2dt = 2. * rdt
108            IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
109            ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / z2dt - ztrdu(:,:,:)
110            ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:)
111         END SELECT
112         CALL trd_mod( ztrdu, ztrdv, jpdtdspg, 'DYN', kt )
113      ENDIF
114
115      !                                          ! print mean trends (used for debugging)
116      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, &
117         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
118
119   END SUBROUTINE dyn_spg
120
121
122   SUBROUTINE dyn_spg_ctl
123      !!---------------------------------------------------------------------
124      !!                  ***  ROUTINE dyn_spg_ctl  ***
125      !!               
126      !! ** Purpose :   Control the consistency between cpp options for
127      !!      surface pressure gradient schemes
128      !!
129      !! History :
130      !!   9.0  !  05-10  (V. Garnier)  Original code : spg re-organization
131      !!----------------------------------------------------------------------
132      !! * Local declarations
133      INTEGER ::   ioptio
134      !!----------------------------------------------------------------------
135
136      ! Parameter control and print
137      ! ---------------------------
138      ! Control print
139      IF(lwp) THEN
140         WRITE(numout,*)
141         WRITE(numout,*) 'dyn_spg_ctl : choice of the surface pressure gradient scheme'
142         WRITE(numout,*) '~~~~~~~~~~~'
143         WRITE(numout,*) '     Explicit free surface                  lk_dynspg_exp = ', lk_dynspg_exp
144         WRITE(numout,*) '     Free surface with time splitting       lk_dynspg_ts  = ', lk_dynspg_ts
145         WRITE(numout,*) '     Filtered free surface cst volume       lk_dynspg_flt = ', lk_dynspg_flt
146         WRITE(numout,*) '     Rigid-lid case                         lk_dynspg_rl  = ', lk_dynspg_rl
147      ENDIF
148
149      ! Control of surface pressure gradient scheme options
150      ! ---------------------------------------------------
151      ioptio = 0
152      IF(lk_dynspg_exp)   ioptio = ioptio + 1
153      IF(lk_dynspg_ts )   ioptio = ioptio + 1
154      IF(lk_dynspg_flt)   ioptio = ioptio + 1
155      IF(lk_dynspg_rl )   ioptio = ioptio + 1
156
157      IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ioptio == 0 ) THEN
158         IF(lwp) WRITE(numout,cform_err)
159         IF(lwp) WRITE(numout,*) ' Choose only one surface pressure gradient scheme with a key cpp'
160         nstop = nstop + 1
161      ENDIF
162
163      IF( lk_esopa     )   nspg = -1
164      IF( lk_dynspg_exp)   nspg =  0
165      IF( lk_dynspg_ts )   nspg =  1
166      IF( lk_dynspg_flt)   nspg =  2
167      IF( lk_dynspg_rl )   nspg =  3
168      IF( lk_dynspg_flt .AND. lk_jki )   nspg =  4
169
170     IF(lwp) THEN
171         WRITE(numout,*)
172         IF( nspg == -1 )   WRITE(numout,*) '              ESOPA test All scheme used except rigid-lid'
173         IF( nspg ==  0 )   WRITE(numout,*) '              explicit free surface'
174         IF( nspg ==  1 )   WRITE(numout,*) '              free surface with time splitting scheme'
175         IF( nspg ==  2 )   WRITE(numout,*) '              filtered free surface'
176         IF( nspg ==  3 )   WRITE(numout,*) '              rigid-lid'
177         IF( nspg ==  4 )   WRITE(numout,*) '              filtered free surface with j-k-i loop'
178      ENDIF
179
180      ! Control of timestep choice
181      ! --------------------------
182      IF( lk_dynspg_ts ) THEN
183         IF( MOD( rdt , rdtbt ) /= 0. ) THEN
184            IF(lwp) WRITE(numout,cform_err)
185            IF(lwp) WRITE(numout,*) ' The barotropic timestep must be an integer divisor of the baroclinic timestep'
186            nstop = nstop + 1
187         ENDIF
188      ENDIF
189
190#if key_obc
191      ! Conservation of ocean volume (key_dynspg_flt)
192      ! ---------------------------------------------
193      IF( lk_dynspg_flt ) ln_vol_cst = .true.
194
195      ! Application of Flather's algorithm at open boundaries
196      ! -----------------------------------------------------
197      IF( lk_dynspg_flt ) ln_obc_fla = .false.
198      IF( lk_dynspg_exp ) ln_obc_fla = .true.
199      IF( lk_dynspg_ts  ) ln_obc_fla = .true.
200#endif
201
202   END SUBROUTINE dyn_spg_ctl
203
204  !!======================================================================
205END MODULE dynspg
Note: See TracBrowser for help on using the repository browser.