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 @ 358

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

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