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 trunk/NEMO/OPA_SRC/DOM – NEMO

source: trunk/NEMO/OPA_SRC/DOM/domstp.F90 @ 3

Last change on this file since 3 was 3, checked in by opalod, 20 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.3 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   !! * Modules used
11   USE oce             ! ocean dynamics and tracers
12   USE dom_oce         ! ocean space and time domain
13   USE in_out_manager  ! I/O manager
14
15   IMPLICIT NONE
16   PRIVATE
17
18   !! * routine accessibility
19   PUBLIC dom_stp        ! routine called by inidom.F90
20
21   !! * Substitutions
22#  include "domzgr_substitute.h90"
23   !!----------------------------------------------------------------------
24   !!   OPA 9.0 , LODYC-IPSL  (2003)
25   !!----------------------------------------------------------------------
26
27CONTAINS
28
29   SUBROUTINE dom_stp
30      !!----------------------------------------------------------------------
31      !!                    ***  ROUTINE dom_stp  ***
32      !!         
33      !! ** Purpose :   Intialize ocean time step for the run
34      !!
35      !! ** Method  : - Initialization of a coef. use in the Asselin time
36      !!      filter:  atfp1 = 1 - 2 * atfp  where atfp is the Asselin time
37      !!      filter parameter read in namelist
38      !!              - Model time step:
39      !!      nacc = 0 : synchronous time intergration.
40      !!      There is one time step only, defined by: rdt, rdttra(k)=rdt
41      !!      nacc = 1 : accelerating the convergence. There is 2 different
42      !!      time steps for dynamics and tracers:
43      !!        rdt      : dynamical part
44      !!        rdttra(k): temperature and salinity
45      !!      The tracer time step is a function of vertical level. the model
46      !!      reference time step ( i.e. for wind stress, surface heat and
47      !!      salt fluxes) is the surface tracer time step is rdttra(1).
48      !!         N.B. depth dependent acceleration of convergence is not im-
49      !!      plemented for s-coordinate.
50      !!
51      !! ** Action  : - rdttra   : vertical profile of tracer time step
52      !!              - atfp1    : = 1 - 2*atfp
53      !!
54      !! References :
55      !!      Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673.
56      !!
57      !! History :
58      !!        !  90-10  (O. Marti)  Original code
59      !!        !  96-01  (G. Madec)  terrain following coordinates
60      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
61      !!----------------------------------------------------------------------
62      !! * Local declarations
63      INTEGER ::   jk              ! dummy loop indice
64      !!----------------------------------------------------------------------
65
66      IF(lwp) THEN
67         WRITE(numout,*)
68         WRITE(numout,*) 'dom_stp : time stepping setting'
69         WRITE(numout,*) '~~~~~~~'
70      ENDIF
71
72      ! 0. Asselin Time filter
73      ! ----------------------
74     
75      atfp1 = 1. - 2. * atfp
76
77
78      SELECT CASE ( nacc )
79
80         CASE ( 0 )                ! Synchronous time stepping
81            IF(lwp) WRITE(numout,*)'               synchronous time stepping'
82            IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
83
84            rdttra(:) = rdt
85
86         CASE ( 1 )                ! Accelerating the convergence
87            IF(lwp) WRITE(numout,*) '              no tracer damping in the turbocline'
88            IF(lwp) WRITE(numout,*)'               accelerating the convergence'
89            IF(lwp) WRITE(numout,*)'               dynamics time step = ', rdt/3600., ' hours'
90#if defined key_s_coord
91            IF( rdtmin /= rdtmax ) THEN
92               IF(lwp) WRITE(numout,cform_err)
93               IF(lwp) WRITE(numout,*)' depth dependent acceleration of &
94                                      &convergence not implemented in s-coordinates'
95               nstop = nstop + 1
96            ENDIF
97#endif
98#if defined key_partial_steps
99            IF( rdtmin /= rdtmax ) THEN
100               IF(lwp) WRITE(numout,cform_err)
101               IF(lwp) WRITE(numout,*)' depth dependent acceleration of &
102                                      &convergence not implemented for partial steps case'
103               nstop = nstop + 1
104            ENDIF
105#endif
106            IF(lwp) WRITE(numout,*)'         tracers   time step :  dt (hours)  level'
107
108            DO jk = 1, jpk
109               IF( fsdept(1,1,jk) <= rdth ) rdttra(jk) = rdtmin
110               IF( fsdept(1,1,jk) >  rdth ) THEN
111                  rdttra(jk) = rdtmin + ( rdtmax - rdtmin )   &
112                                      * ( EXP( ( fsdept(1,1,jk ) - rdth ) / rdth ) - 1. )   &
113                                      / ( EXP( ( fsdept(1,1,jpk) - rdth ) / rdth ) - 1. )
114               ENDIF
115               IF(lwp) WRITE(numout,9200) rdttra(jk)/3600., jk
116            END DO 
117 9200       FORMAT(36x,f5.2,'     ',i3)
118
119         CASE DEFAULT              ! E R R O R
120
121            IF(lwp) WRITE(numout,cform_err)
122            IF(lwp) WRITE(numout,*) ' nacc value e r r o r, nacc= ',nacc
123            IF(lwp) WRITE(numout,*) ' we stop'
124            nstop = nstop + 1
125
126      END SELECT
127
128   END SUBROUTINE dom_stp
129
130   !!======================================================================
131END MODULE domstp
Note: See TracBrowser for help on using the repository browser.