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

Last change on this file since 699 was 699, checked in by smasson, 17 years ago

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