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.
domstp.F90 in branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90 @ 6060

Last change on this file since 6060 was 6060, checked in by timgraham, 8 years ago

Merged dev_r5836_noc2_VVL_BY_DEFAULT into branch

  • Property svn:keywords set to Id
File size: 4.8 KB
Line 
1MODULE domstp
2   !!==============================================================================
3   !!                       ***  MODULE domstp   ***
4   !! Ocean initialization : time domain
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dom_stp        : ocean time domain initialization
9   !!----------------------------------------------------------------------
10   !! History :  OPA  ! 1990-10  (O. Marti)  Original code
11   !!                 ! 1996-01  (G. Madec)  terrain following coordinates
12   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
13   !!----------------------------------------------------------------------
14   USE oce            ! ocean dynamics and tracers
15   USE dom_oce        ! ocean space and time domain
16   USE in_out_manager ! I/O manager
17   USE lib_mpp        ! MPP library
18
19   IMPLICIT NONE
20   PRIVATE
21
22   PUBLIC   dom_stp   ! routine called by inidom.F90
23
24   !!----------------------------------------------------------------------
25   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
26   !! $Id$
27   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
28   !!----------------------------------------------------------------------
29CONTAINS
30
31   SUBROUTINE dom_stp
32      !!----------------------------------------------------------------------
33      !!                    ***  ROUTINE dom_stp  ***
34      !!         
35      !! ** Purpose :   Intialize ocean time step for the run
36      !!
37      !! ** Method  : - Initialization of a coef. use in the Asselin time
38      !!      filter:  atfp1 = 1 - 2 * atfp  where atfp is the Asselin time
39      !!      filter parameter read in namelist
40      !!              - Model time step:
41      !!      nacc = 0 : synchronous time intergration.
42      !!      There is one time step only, defined by: rdt, rdttra(k)=rdt
43      !!      nacc = 1 : accelerating the convergence. There is 2 different
44      !!      time steps for dynamics and tracers:
45      !!        rdt      : dynamical part
46      !!        rdttra(k): temperature and salinity
47      !!      The tracer time step is a function of vertical level. the model
48      !!      reference time step ( i.e. for wind stress, surface heat and
49      !!      salt fluxes) is the surface tracer time step is rdttra(1).
50      !!         N.B. depth dependent acceleration of convergence is not im-
51      !!      plemented for s-coordinate.
52      !!
53      !! ** Action  : - rdttra   : vertical profile of tracer time step
54      !!              - atfp1    : = 1 - 2*atfp
55      !!
56      !! References :   Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673.
57      !!----------------------------------------------------------------------
58      INTEGER ::   jk              ! dummy loop indice
59      !!----------------------------------------------------------------------
60
61      IF(lwp) THEN
62         WRITE(numout,*)
63         WRITE(numout,*) 'dom_stp : time stepping setting'
64         WRITE(numout,*) '~~~~~~~'
65      ENDIF
66
67      ! 0. Asselin Time filter
68      ! ----------------------
69     
70      atfp1 = 1. - 2. * atfp
71
72      SELECT CASE ( nacc )
73
74         CASE ( 0 )                ! Synchronous time stepping
75            IF(lwp) WRITE(numout,*)'               synchronous time stepping'
76            IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
77
78            rdttra(:) = rdt
79
80         CASE ( 1 )                ! Accelerating the convergence
81            IF(lwp) WRITE(numout,*) '              no tracer damping in the turbocline'
82            IF(lwp) WRITE(numout,*)'               accelerating the convergence'
83            IF(lwp) WRITE(numout,*)'               dynamics time step = ', rdt/3600., ' hours'
84            IF( ln_sco .AND. rdtmin /= rdtmax .AND. .NOT.ln_linssh )   &
85                 & CALL ctl_stop ( ' depth dependent acceleration of convergence not implemented in s-coordinates &
86                 &                   nor in variable volume' )
87            IF(lwp) WRITE(numout,*)'         tracers   time step :  dt (hours)  level'
88
89            DO jk = 1, jpk
90               IF( gdept_1d(jk) <= rdth ) rdttra(jk) = rdtmin
91               IF( gdept_1d(jk) >  rdth ) THEN
92                  rdttra(jk) = rdtmin + ( rdtmax - rdtmin )   &
93                                      * ( EXP( ( gdept_1d(jk ) - rdth ) / rdth ) - 1. )   &
94                                      / ( EXP( ( gdept_1d(jpk) - rdth ) / rdth ) - 1. )
95               ENDIF
96               IF(lwp) WRITE(numout,"(36x,f5.2,5x,i3)") rdttra(jk)/3600., jk
97            END DO 
98
99         CASE DEFAULT              ! E R R O R
100
101            WRITE(ctmp1,*) ' nacc value e r r o r, nacc= ',nacc
102            CALL ctl_stop( ctmp1 )
103
104      END SELECT
105
106   END SUBROUTINE dom_stp
107
108   !!======================================================================
109END MODULE domstp
Note: See TracBrowser for help on using the repository browser.