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 on 2009WP/2009Stream3/VVL – Attachment – NEMO

2009WP/2009Stream3/VVL: dynspg.F90

File dynspg.F90, 8.8 KB (added by gm, 15 years ago)
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)  add dyn_spg_ctl
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 trdmod         ! ocean dynamics trends
23   USE trdmod_oce     ! ocean variables trends
24   USE prtctl         ! Print control                     (prt_ctl routine)
25   USE in_out_manager ! I/O manager
26
27   IMPLICIT NONE
28   PRIVATE
29
30   PUBLIC   dyn_spg   ! routine called by step module
31
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   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
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      CASE (  3 )   ;   CALL dyn_spg_rl     ( kt, kindic )      ! rigid lid
71      !                                                   
72      CASE ( -1 )                                       ! esopa: test all possibility with control print
73                       CALL dyn_spg_exp    ( kt )
74                       CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, &
75            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
76                       CALL dyn_spg_ts     ( kt )
77                       CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, &
78            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
79                       CALL dyn_spg_flt  ( kt, kindic )
80                       CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, &
81            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
82      END SELECT
83      !                   
84      IF( l_trddyn )   THEN                      ! save the horizontal diffusive trends for further diagnostics
85         SELECT CASE ( nspg )
86         CASE( 0, 1, 3 )
87            IF( nspg == 0 .AND. lk_vvl ) THEN
88               DO jj = 2, jpjm1
89                  DO ji = fs_2, fs_jpim1   ! vector opt.
90                     ztrdu(ji,jj,1) = - grav * (1.e0 + rdn(:,:,1) ) * ( sshn(ji+1,jj) - sshn(ji,jj) ) / ( e1u(ji,jj) * rau0 )
91                     ztrdv(ji,jj,1) = - grav * (1.e0 + rdn(:,:,1) ) * ( sshn(ji,jj+1) - sshn(ji,jj) ) / ( e2v(ji,jj) * rau0 )
92                  END DO
93               END DO
94               ztrdu(:,:,jk) = ztrdu(ji,jj,1) * umask(:,:,jk)
95               ztrdv(:,:,jk) = ztrdv(ji,jj,1) * vmask(:,:,jk)
96            ELSE
97               ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
98               ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
99            ENDIF
100         CASE( 2 )
101            z2dt = 2. * rdt
102            IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
103            ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / z2dt - ztrdu(:,:,:)
104            ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:)
105         END SELECT
106         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_spg, 'DYN', kt )
107      ENDIF
108      !                                          ! print mean trends (used for debugging)
109      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, &
110         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
111      !
112   END SUBROUTINE dyn_spg
113
114
115   SUBROUTINE dyn_spg_ctl
116      !!---------------------------------------------------------------------
117      !!                  ***  ROUTINE dyn_spg_ctl  ***
118      !!               
119      !! ** Purpose :   Control the consistency between cpp options for
120      !!              surface pressure gradient schemes
121      !!----------------------------------------------------------------------
122      INTEGER ::   ioptio
123      !!----------------------------------------------------------------------
124      !
125      IF(lwp) THEN      !* Control print
126         WRITE(numout,*)
127         WRITE(numout,*) 'dyn_spg_ctl : choice of the surface pressure gradient scheme'
128         WRITE(numout,*) '~~~~~~~~~~~'
129         WRITE(numout,*) '     Explicit free surface                  lk_dynspg_exp = ', lk_dynspg_exp
130         WRITE(numout,*) '     Free surface with time splitting       lk_dynspg_ts  = ', lk_dynspg_ts
131         WRITE(numout,*) '     Filtered free surface cst volume       lk_dynspg_flt = ', lk_dynspg_flt
132         WRITE(numout,*) '     Rigid-lid case                         lk_dynspg_rl  = ', lk_dynspg_rl
133      ENDIF
134
135      !                 !* Control of surface pressure gradient scheme options
136      ioptio = 0
137      IF(lk_dynspg_exp)   ioptio = ioptio + 1
138      IF(lk_dynspg_ts )   ioptio = ioptio + 1
139      IF(lk_dynspg_flt)   ioptio = ioptio + 1
140      IF(lk_dynspg_rl )   ioptio = ioptio + 1
141      !
142      IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ioptio == 0 )   CALL ctl_stop( ' Choose ONE of the key_dynspg_...' )
143      !
144      IF( lk_esopa     )   nspg = -1
145      IF( lk_dynspg_exp)   nspg =  0
146      IF( lk_dynspg_ts )   nspg =  1
147      IF( lk_dynspg_flt)   nspg =  2
148      IF( lk_dynspg_rl )   nspg =  3
149      !
150      IF( lk_esopa     )   nspg = -1
151      !
152      IF(lwp) THEN
153         WRITE(numout,*)
154         IF( nspg == -1 )   WRITE(numout,*) '     ESOPA test All scheme used except rigid-lid'
155         IF( nspg ==  0 )   WRITE(numout,*) '     explicit free surface'
156         IF( nspg ==  1 )   WRITE(numout,*) '     free surface with time splitting scheme'
157         IF( nspg ==  2 )   WRITE(numout,*) '     filtered free surface'
158         IF( nspg ==  3 )   WRITE(numout,*) '     rigid-lid'
159      ENDIF
160
161      !                 !* Control of timestep choice
162      IF( lk_dynspg_ts .OR. lk_dynspg_exp ) THEN
163         IF( n_cla == 1 )   CALL ctl_stop( ' Crossland advection not implemented for this free surface formulation ' )
164      ENDIF
165
166#if defined key_obc
167      !                 !* OBC boundary condition
168      IF( lk_dynspg_flt )   ln_vol_cst = .true.      ! Conservation of ocean volume (key_dynspg_flt)
169      !
170      IF( lk_dynspg_flt )   ln_obc_fla = .false.      ! Application of Flather's algorithm at open boundaries
171      IF( lk_dynspg_exp )   ln_obc_fla = .true.
172      IF( lk_dynspg_ts  )   ln_obc_fla = .true.
173#endif
174      !
175   END SUBROUTINE dyn_spg_ctl
176
177  !!======================================================================
178END MODULE dynspg