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.
domain.F90 in trunk/NEMO/OPA_SRC/DOM – NEMO

source: trunk/NEMO/OPA_SRC/DOM/domain.F90 @ 1241

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

Fix a stupid bug for time splitting and ensure restartability for dynspg_ts in addition, see tickets #280 and #292
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 13.9 KB
Line 
1MODULE domain
2   !!==============================================================================
3   !!                       ***  MODULE domain   ***
4   !! Ocean initialization : domain initialization
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dom_init       : initialize the space and time domain
9   !!   dom_nam        : read and contral domain namelists
10   !!   dom_ctl        : control print for the ocean domain
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE oce             !
14   USE dom_oce         ! ocean space and time domain
15   USE ice_oce         ! ice variables
16   USE sbc_oce         ! surface boundary condition: ocean
17   USE phycst          ! physical constants
18   USE in_out_manager  ! I/O manager
19   USE lib_mpp         ! distributed memory computing library
20
21   USE domhgr          ! domain: set the horizontal mesh
22   USE domzgr          ! domain: set the vertical mesh
23   USE domstp          ! domain: set the time-step
24   USE dommsk          ! domain: set the mask system
25   USE domwri          ! domain: write the meshmask file
26   USE closea          ! closed sea or lake              (dom_clo routine)
27   USE domvvl          ! variable volume
28
29   IMPLICIT NONE
30   PRIVATE
31
32   !! * Routine accessibility
33   PUBLIC dom_init       ! called by opa.F90
34
35   !! * Substitutions
36#  include "domzgr_substitute.h90"
37   !!----------------------------------------------------------------------
38   !!   OPA 9.0 , LOCEAN-IPSL (2005)
39   !! $Id$
40   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
41   !!----------------------------------------------------------------------
42
43CONTAINS
44
45   SUBROUTINE dom_init
46      !!----------------------------------------------------------------------
47      !!                  ***  ROUTINE dom_init  ***
48      !!                   
49      !! ** Purpose :   Domain initialization. Call the routines that are
50      !!      required to create the arrays which define the space and time
51      !!      domain of the ocean model.
52      !!
53      !! ** Method  :
54      !!      - dom_msk: compute the masks from the bathymetry file
55      !!      - dom_hgr: compute or read the horizontal grid-point position and
56      !!                scale factors, and the coriolis factor
57      !!      - dom_zgr: define the vertical coordinate system and the bathymetry
58      !!      - dom_stp: defined the model time step
59      !!      - dom_wri: create the meshmask file if nmsh=1
60      !!
61      !! History :
62      !!        !  90-10  (C. Levy - G. Madec)  Original code
63      !!        !  91-11  (G. Madec)
64      !!        !  92-01  (M. Imbard) insert time step initialization
65      !!        !  96-06  (G. Madec) generalized vertical coordinate
66      !!        !  97-02  (G. Madec) creation of domwri.F
67      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
68      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
69      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
70      !!----------------------------------------------------------------------
71      !! * Local declarations
72      INTEGER ::   jk                ! dummy loop argument
73      INTEGER ::   iconf = 0         ! temporary integers
74      !!----------------------------------------------------------------------
75
76      IF(lwp) THEN
77         WRITE(numout,*)
78         WRITE(numout,*) 'dom_init : domain initialization'
79         WRITE(numout,*) '~~~~~~~~'
80      ENDIF
81
82      CALL dom_nam                        ! read namelist ( namrun, namdom, namcla )
83
84      CALL dom_clo                        ! Closed seas and lake
85
86      CALL dom_hgr                        ! Horizontal mesh
87
88      CALL dom_zgr                        ! Vertical mesh and bathymetry
89
90      CALL dom_msk                        ! Masks
91
92      IF( lk_vvl )   CALL dom_vvl_ini     ! Vertical variable mesh
93
94      ! Local depth or Inverse of the local depth of the water column at u- and v-points
95      ! ------------------------------
96      ! Ocean depth at U- and V-points
97      hu(:,:) = 0.
98      hv(:,:) = 0.
99
100      DO jk = 1, jpk
101         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
102         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
103      END DO
104      ! Inverse of the local depth
105      hur(:,:) = fse3u(:,:,1)             ! Lower bound : thickness of the first model level
106      hvr(:,:) = fse3v(:,:,1)
107
108      DO jk = 2, jpk                      ! Sum of the vertical scale factors
109         hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
110         hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
111      END DO
112
113      ! Compute and mask the inverse of the local depth
114      hur(:,:) = 1. / hur(:,:) * umask(:,:,1)
115      hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1)
116
117
118      CALL dom_stp                        ! Time step
119
120      IF( nmsh /= 0 )   CALL dom_wri      ! Create a domain file
121
122      IF( .NOT.ln_rstart )   CALL dom_ctl    ! Domain control
123
124   END SUBROUTINE dom_init
125
126
127   SUBROUTINE dom_nam
128      !!----------------------------------------------------------------------
129      !!                     ***  ROUTINE dom_nam  ***
130      !!                   
131      !! ** Purpose :   read domaine namelists and print the variables.
132      !!
133      !! ** input   : - namrun namelist
134      !!              - namdom namelist
135      !!              - namcla namelist
136      !!
137      !! History :
138      !!   9.0  !  03-08  (G. Madec)  Original code
139      !!----------------------------------------------------------------------
140      !! * Modules used
141      USE ioipsl
142      NAMELIST/namrun/ no    , cexper, cn_ocerst_in, cn_ocerst_out, ln_rstart, nrstdt,   &
143         &             nit000, nitend, ndate0      , nleapy       , ninist   , nstock,   &
144         &             nwrite, ln_dimgnnn
145
146      NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, nmsh   ,   &
147         &             nacc  , atfp     , rdt      , rdtmin ,   &
148         &             rdtmax, rdth     , nn_baro  , nclosea
149      NAMELIST/namcla/ n_cla
150      !!----------------------------------------------------------------------
151
152      IF(lwp) THEN
153         WRITE(numout,*)
154         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
155         WRITE(numout,*) '~~~~~~~ '
156      ENDIF
157
158      ! Namelist namrun : parameters of the run
159      REWIND( numnam )
160      READ  ( numnam, namrun )
161
162      IF(lwp) THEN
163         WRITE(numout,*) '        Namelist namrun'
164         WRITE(numout,*) '           job number                      no        = ', no
165         WRITE(numout,*) '           experiment name for output      cexper    = ', cexper
166         WRITE(numout,*) '           restart logical                 ln_rstart = ', ln_rstart
167         WRITE(numout,*) '           control of time step            nrstdt    = ', nrstdt
168         WRITE(numout,*) '           number of the first time step   nit000    = ', nit000
169         WRITE(numout,*) '           number of the last time step    nitend    = ', nitend
170         WRITE(numout,*) '           initial calendar date aammjj    ndate0    = ', ndate0
171         WRITE(numout,*) '           leap year calendar (0/1)        nleapy    = ', nleapy
172         WRITE(numout,*) '           initial state output            ninist    = ', ninist
173         WRITE(numout,*) '           frequency of restart file       nstock    = ', nstock
174         WRITE(numout,*) '           frequency of output file        nwrite    = ', nwrite
175         WRITE(numout,*) '           multi file dimgout           ln_dimgnnn   = ', ln_dimgnnn
176      ENDIF
177
178      ! ... Control of output frequency
179      IF ( nstock == 0 .OR. nstock > nitend - nit000 + 1 ) THEN
180         WRITE(ctmp1,*) '           nstock = ', nstock, ' it is forced to ', nitend - nit000 + 1
181         CALL ctl_warn( ctmp1 )
182         nstock = nitend - nit000 + 1
183      ENDIF
184      IF ( nwrite == 0 ) THEN
185         WRITE(ctmp1,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
186         CALL ctl_warn( ctmp1 )
187         nwrite = nitend
188      ENDIF
189
190#if defined key_agrif
191      if ( Agrif_Root() ) then
192#endif
193      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
194      CASE (  1 ) 
195         CALL ioconf_calendar('gregorian')
196         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year'
197      CASE (  0 )
198         CALL ioconf_calendar('noleap')
199         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year'
200      CASE ( 30 )
201         CALL ioconf_calendar('360d')
202         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year'
203      END SELECT
204#if defined key_agrif
205      endif
206#endif
207
208      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
209      CASE ( 1 )
210         raajj = 365.25
211         raass = raajj * rjjss
212         rmoss = raass/raamo
213      CASE ( 0 )
214         raajj = 365.
215         raass = raajj * rjjss
216         rmoss = raass/raamo
217      CASE DEFAULT
218         raajj = FLOAT( nleapy ) * raamo
219         raass =        raajj    * rjjss
220         rmoss = FLOAT( nleapy ) * rjjss
221      END SELECT
222      IF(lwp) THEN
223         WRITE(numout,*)
224         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
225         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
226         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
227      ENDIF
228
229      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
230      REWIND( numnam )
231      READ  ( numnam, namdom )
232
233      IF(lwp) THEN
234         WRITE(numout,*)
235         WRITE(numout,*) '        Namelist namdom'
236         WRITE(numout,*) '           flag read/compute bathymetry   ntopo     = ', ntopo
237         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
238         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
239         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
240         WRITE(numout,*) '                = 0   no file created                 '
241         WRITE(numout,*) '                = 1   mesh_mask                       '
242         WRITE(numout,*) '                = 2   mesh and mask                   '
243         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
244         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
245         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
246         WRITE(numout,*) '           time step                      rdt       = ', rdt
247         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
248         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
249         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
250         WRITE(numout,*) '           number of barotropic time step nn_baro   = ', nn_baro
251      ENDIF
252
253      ! Default values
254      n_cla = 0
255
256      ! Namelist cross land advection
257      REWIND( numnam )
258      READ  ( numnam, namcla )
259      IF(lwp) THEN
260         WRITE(numout,*)
261         WRITE(numout,*) '        Namelist namcla'
262         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
263      ENDIF
264
265      IF( nbit_cmp == 1 .AND. n_cla /= 0 ) THEN
266         CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
267      END IF
268
269   END SUBROUTINE dom_nam
270
271
272   SUBROUTINE dom_ctl
273      !!----------------------------------------------------------------------
274      !!                     ***  ROUTINE dom_ctl  ***
275      !!
276      !! ** Purpose :   Domain control.
277      !!
278      !! ** Method  :   compute and print extrema of masked scale factors
279      !!
280      !! History :
281      !!   8.5  !  02-08  (G. Madec)    Original code
282      !!----------------------------------------------------------------------
283      !! * Local declarations
284      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
285      INTEGER, DIMENSION(2) ::   iloc      !
286      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
287      !!----------------------------------------------------------------------
288
289      ! Extrema of the scale factors
290
291      IF(lwp)WRITE(numout,*)
292      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
293      IF(lwp)WRITE(numout,*) '~~~~~~~'
294
295      IF (lk_mpp) THEN
296         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
297         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
298         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
299         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
300      ELSE
301         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
302         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
303         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
304         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
305
306         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
307         iimi1 = iloc(1) + nimpp - 1
308         ijmi1 = iloc(2) + njmpp - 1
309         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
310         iimi2 = iloc(1) + nimpp - 1
311         ijmi2 = iloc(2) + njmpp - 1
312         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
313         iima1 = iloc(1) + nimpp - 1
314         ijma1 = iloc(2) + njmpp - 1
315         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
316         iima2 = iloc(1) + nimpp - 1
317         ijma2 = iloc(2) + njmpp - 1
318      ENDIF
319
320      IF(lwp) THEN
321         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
322         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
323         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
324         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
325      ENDIF
326
327   END SUBROUTINE dom_ctl
328
329   !!======================================================================
330END MODULE domain
Note: See TracBrowser for help on using the repository browser.