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/UKMO/dev_r5107_iceshelf_fw_input_coupled_model/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/UKMO/dev_r5107_iceshelf_fw_input_coupled_model/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90 @ 5511

Last change on this file since 5511 was 5511, checked in by davestorkey, 9 years ago

UKMO/dev_r5107_iceshelf_fw_input_coupled_model branch: clear SVN keywords

File size: 4.9 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   !! * Substitutions
25#  include "domzgr_substitute.h90"
26   !!----------------------------------------------------------------------
27   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
28   !! $Id$
29   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
30   !!----------------------------------------------------------------------
31CONTAINS
32
33   SUBROUTINE dom_stp
34      !!----------------------------------------------------------------------
35      !!                    ***  ROUTINE dom_stp  ***
36      !!         
37      !! ** Purpose :   Intialize ocean time step for the run
38      !!
39      !! ** Method  : - Initialization of a coef. use in the Asselin time
40      !!      filter:  atfp1 = 1 - 2 * atfp  where atfp is the Asselin time
41      !!      filter parameter read in namelist
42      !!              - Model time step:
43      !!      nacc = 0 : synchronous time intergration.
44      !!      There is one time step only, defined by: rdt, rdttra(k)=rdt
45      !!      nacc = 1 : accelerating the convergence. There is 2 different
46      !!      time steps for dynamics and tracers:
47      !!        rdt      : dynamical part
48      !!        rdttra(k): temperature and salinity
49      !!      The tracer time step is a function of vertical level. the model
50      !!      reference time step ( i.e. for wind stress, surface heat and
51      !!      salt fluxes) is the surface tracer time step is rdttra(1).
52      !!         N.B. depth dependent acceleration of convergence is not im-
53      !!      plemented for s-coordinate.
54      !!
55      !! ** Action  : - rdttra   : vertical profile of tracer time step
56      !!              - atfp1    : = 1 - 2*atfp
57      !!
58      !! References :   Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673.
59      !!----------------------------------------------------------------------
60      INTEGER ::   jk              ! dummy loop indice
61      !!----------------------------------------------------------------------
62
63      IF(lwp) THEN
64         WRITE(numout,*)
65         WRITE(numout,*) 'dom_stp : time stepping setting'
66         WRITE(numout,*) '~~~~~~~'
67      ENDIF
68
69      ! 0. Asselin Time filter
70      ! ----------------------
71     
72      atfp1 = 1. - 2. * atfp
73
74      SELECT CASE ( nacc )
75
76         CASE ( 0 )                ! Synchronous time stepping
77            IF(lwp) WRITE(numout,*)'               synchronous time stepping'
78            IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
79
80            rdttra(:) = rdt
81
82         CASE ( 1 )                ! Accelerating the convergence
83            IF(lwp) WRITE(numout,*) '              no tracer damping in the turbocline'
84            IF(lwp) WRITE(numout,*)'               accelerating the convergence'
85            IF(lwp) WRITE(numout,*)'               dynamics time step = ', rdt/3600., ' hours'
86            IF( ln_sco .AND. rdtmin /= rdtmax .AND. lk_vvl )   &
87                 & CALL ctl_stop ( ' depth dependent acceleration of convergence not implemented in s-coordinates &
88                 &                   nor in variable volume' )
89            IF(lwp) WRITE(numout,*)'         tracers   time step :  dt (hours)  level'
90
91            DO jk = 1, jpk
92               IF( gdept_1d(jk) <= rdth ) rdttra(jk) = rdtmin
93               IF( gdept_1d(jk) >  rdth ) THEN
94                  rdttra(jk) = rdtmin + ( rdtmax - rdtmin )   &
95                                      * ( EXP( ( gdept_1d(jk ) - rdth ) / rdth ) - 1. )   &
96                                      / ( EXP( ( gdept_1d(jpk) - rdth ) / rdth ) - 1. )
97               ENDIF
98               IF(lwp) WRITE(numout,"(36x,f5.2,5x,i3)") rdttra(jk)/3600., jk
99            END DO 
100
101         CASE DEFAULT              ! E R R O R
102
103            WRITE(ctmp1,*) ' nacc value e r r o r, nacc= ',nacc
104            CALL ctl_stop( ctmp1 )
105
106      END SELECT
107
108   END SUBROUTINE dom_stp
109
110   !!======================================================================
111END MODULE domstp
Note: See TracBrowser for help on using the repository browser.