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

Last change on this file since 1528 was 1528, checked in by rblod, 15 years ago

Suppress rigid-lid option, see ticket #486
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 8.0 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 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   PUBLIC dyn_spg         ! routine called by step module
30
31   !! * module variables
32   INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_...
33
34   !! * Substitutions
35#  include "domzgr_substitute.h90"
36#  include "vectopt_loop_substitute.h90"
37   !!----------------------------------------------------------------------
38   !!   OPA 9.0 , LOCEAN-IPSL (2005)
39   !! $Id$
40   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42
43CONTAINS
44
45   SUBROUTINE dyn_spg( kt, kindic )
46      !!----------------------------------------------------------------------
47      !!                  ***  ROUTINE dyn_spg  ***
48      !!
49      !! ** Purpose :   compute the lateral ocean dynamics physics.
50      !!----------------------------------------------------------------------
51      INTEGER, INTENT( in  ) ::   kt     ! ocean time-step index
52      INTEGER, INTENT( out ) ::   kindic ! solver flag
53      !!
54      REAL(wp) ::   z2dt                      ! temporary scalar
55      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrdu, ztrdv   ! 3D workspace
56      !!----------------------------------------------------------------------
57
58      IF( kt == nit000 )   CALL dyn_spg_ctl      ! initialisation & control of options
59
60      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends
61         ztrdu(:,:,:) = ua(:,:,:)
62         ztrdv(:,:,:) = va(:,:,:)
63      ENDIF
64
65      SELECT CASE ( nspg )                       ! compute surf. pressure gradient trend and add it to the general trend
66      !                                                     
67      CASE (  0 )   ;   CALL dyn_spg_exp    ( kt )              ! explicit
68      CASE (  1 )   ;   CALL dyn_spg_ts     ( kt )              ! time-splitting
69      CASE (  2 )   ;   CALL dyn_spg_flt    ( kt, kindic )      ! filtered
70      !                                                   
71      CASE ( -1 )                                       ! esopa: test all possibility with control print
72                       CALL dyn_spg_exp    ( kt )
73                       CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, &
74            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
75                       CALL dyn_spg_ts     ( kt )
76                       CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, &
77            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
78                       CALL dyn_spg_flt  ( kt, kindic )
79                       CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, &
80            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
81      END SELECT
82      !                   
83      IF( l_trddyn )   THEN                      ! save the horizontal diffusive trends for further diagnostics
84         SELECT CASE ( nspg )
85         CASE ( 0, 1 )
86            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
87            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
88         CASE( 2 )
89            z2dt = 2. * rdt
90            IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
91            ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / z2dt - ztrdu(:,:,:)
92            ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:)
93         END SELECT
94         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_spg, 'DYN', kt )
95      ENDIF
96      !                                          ! print mean trends (used for debugging)
97      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, &
98         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
99      !
100   END SUBROUTINE dyn_spg
101
102
103   SUBROUTINE dyn_spg_ctl
104      !!---------------------------------------------------------------------
105      !!                  ***  ROUTINE dyn_spg_ctl  ***
106      !!               
107      !! ** Purpose :   Control the consistency between cpp options for
108      !!      surface pressure gradient schemes
109      !!----------------------------------------------------------------------
110      !! * Local declarations
111      INTEGER ::   ioptio
112      !!----------------------------------------------------------------------
113
114      ! Parameter control and print
115      ! ---------------------------
116      ! Control print
117      IF(lwp) THEN
118         WRITE(numout,*)
119         WRITE(numout,*) 'dyn_spg_ctl : choice of the surface pressure gradient scheme'
120         WRITE(numout,*) '~~~~~~~~~~~'
121         WRITE(numout,*) '     Explicit free surface                  lk_dynspg_exp = ', lk_dynspg_exp
122         WRITE(numout,*) '     Free surface with time splitting       lk_dynspg_ts  = ', lk_dynspg_ts
123         WRITE(numout,*) '     Filtered free surface cst volume       lk_dynspg_flt = ', lk_dynspg_flt
124      ENDIF
125
126      ! Control of surface pressure gradient scheme options
127      ! ---------------------------------------------------
128      ioptio = 0
129      IF(lk_dynspg_exp)   ioptio = ioptio + 1
130      IF(lk_dynspg_ts )   ioptio = ioptio + 1
131      IF(lk_dynspg_flt)   ioptio = ioptio + 1
132
133      IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ioptio == 0 )   &
134           &   CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' )
135
136      IF( lk_esopa     )   nspg = -1
137      IF( lk_dynspg_exp)   nspg =  0
138      IF( lk_dynspg_ts )   nspg =  1
139      IF( lk_dynspg_flt)   nspg =  2
140
141      IF( lk_esopa     )   nspg = -1
142
143     IF(lwp) THEN
144         WRITE(numout,*)
145         IF( nspg == -1 )   WRITE(numout,*) '     ESOPA test All scheme used'
146         IF( nspg ==  0 )   WRITE(numout,*) '     explicit free surface'
147         IF( nspg ==  1 )   WRITE(numout,*) '     free surface with time splitting scheme'
148         IF( nspg ==  2 )   WRITE(numout,*) '     filtered free surface'
149      ENDIF
150
151      ! Control of timestep choice
152      ! --------------------------
153      IF( lk_dynspg_ts .OR. lk_dynspg_exp ) THEN
154         IF( n_cla == 1 )   &
155           &   CALL ctl_stop( ' Crossland advection not implemented for this free surface formulation ' )
156      ENDIF
157
158#if defined key_obc
159      ! Conservation of ocean volume (key_dynspg_flt)
160      ! ---------------------------------------------
161      IF( lk_dynspg_flt ) ln_vol_cst = .true.
162
163      ! Application of Flather's algorithm at open boundaries
164      ! -----------------------------------------------------
165      IF( lk_dynspg_flt ) ln_obc_fla = .false.
166      IF( lk_dynspg_exp ) ln_obc_fla = .true.
167      IF( lk_dynspg_ts  ) ln_obc_fla = .true.
168#endif
169
170   END SUBROUTINE dyn_spg_ctl
171
172  !!======================================================================
173END MODULE dynspg
Note: See TracBrowser for help on using the repository browser.