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 @ 709

Last change on this file since 709 was 709, checked in by smasson, 17 years ago

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