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

Last change on this file since 1102 was 1102, checked in by rblod, 16 years ago

Suppress nrid not used any more, see ticket #193
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.0 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, ln_dimgnnn
146
147      NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, nmsh   ,   &
148         &             nacc  , atfp     , rdt      , rdtmin ,   &
149         &             rdtmax, rdth     , rdtbt    , 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,*) '           multi file dimgout           ln_dimgnnn   = ', ln_dimgnnn
177      ENDIF
178
179      ndastp = ndate0                ! Assign initial date to current date
180
181      ! ... Control of output frequency
182      IF ( nstock == 0 .OR. nstock > nitend - nit000 + 1 ) THEN
183         WRITE(ctmp1,*) '           nstock = ', nstock, ' it is forced to ', nitend - nit000 + 1
184         CALL ctl_warn( ctmp1 )
185         nstock = nitend - nit000 + 1
186      ENDIF
187      IF ( nwrite == 0 ) THEN
188         WRITE(ctmp1,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
189         CALL ctl_warn( ctmp1 )
190         nwrite = nitend
191      ENDIF
192
193#if defined key_agrif
194      if ( Agrif_Root() ) then
195#endif
196      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
197      CASE (  1 ) 
198         CALL ioconf_calendar('gregorian')
199         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year'
200      CASE (  0 )
201         CALL ioconf_calendar('noleap')
202         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year'
203      CASE ( 30 )
204         CALL ioconf_calendar('360d')
205         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year'
206      END SELECT
207#if defined key_agrif
208      endif
209#endif
210
211      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
212      CASE ( 1 )
213         raajj = 365.25
214         raass = raajj * rjjss
215         rmoss = raass/raamo
216      CASE ( 0 )
217         raajj = 365.
218         raass = raajj * rjjss
219         rmoss = raass/raamo
220      CASE DEFAULT
221         raajj = FLOAT( nleapy ) * raamo
222         raass =        raajj    * rjjss
223         rmoss = FLOAT( nleapy ) * rjjss
224      END SELECT
225      IF(lwp) THEN
226         WRITE(numout,*)
227         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
228         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
229         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
230      ENDIF
231
232      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
233      REWIND( numnam )
234      READ  ( numnam, namdom )
235
236      IF(lwp) THEN
237         WRITE(numout,*)
238         WRITE(numout,*) '        Namelist namdom'
239         WRITE(numout,*) '           flag read/compute bathymetry   ntopo     = ', ntopo
240         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
241         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
242         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
243         WRITE(numout,*) '                = 0   no file created                 '
244         WRITE(numout,*) '                = 1   mesh_mask                       '
245         WRITE(numout,*) '                = 2   mesh and mask                   '
246         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
247         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
248         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
249         WRITE(numout,*) '           time step                      rdt       = ', rdt
250         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
251         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
252         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
253         WRITE(numout,*) '           barotropic time step           rdtbt     = ', rdtbt
254      ENDIF
255
256      ! Default values
257      n_cla = 0
258
259      ! Namelist cross land advection
260      REWIND( numnam )
261      READ  ( numnam, namcla )
262      IF(lwp) THEN
263         WRITE(numout,*)
264         WRITE(numout,*) '        Namelist namcla'
265         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
266      ENDIF
267
268      IF( nbit_cmp == 1 .AND. n_cla /= 0 ) THEN
269         CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
270      END IF
271
272   END SUBROUTINE dom_nam
273
274
275   SUBROUTINE dom_ctl
276      !!----------------------------------------------------------------------
277      !!                     ***  ROUTINE dom_ctl  ***
278      !!
279      !! ** Purpose :   Domain control.
280      !!
281      !! ** Method  :   compute and print extrema of masked scale factors
282      !!
283      !! History :
284      !!   8.5  !  02-08  (G. Madec)    Original code
285      !!----------------------------------------------------------------------
286      !! * Local declarations
287      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
288      INTEGER, DIMENSION(2) ::   iloc      !
289      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
290      !!----------------------------------------------------------------------
291
292      ! Extrema of the scale factors
293
294      IF(lwp)WRITE(numout,*)
295      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
296      IF(lwp)WRITE(numout,*) '~~~~~~~'
297
298      IF (lk_mpp) THEN
299         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
300         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
301         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
302         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
303      ELSE
304         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
305         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
306         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
307         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
308
309         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
310         iimi1 = iloc(1) + nimpp - 1
311         ijmi1 = iloc(2) + njmpp - 1
312         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
313         iimi2 = iloc(1) + nimpp - 1
314         ijmi2 = iloc(2) + njmpp - 1
315         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
316         iima1 = iloc(1) + nimpp - 1
317         ijma1 = iloc(2) + njmpp - 1
318         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
319         iima2 = iloc(1) + nimpp - 1
320         ijma2 = iloc(2) + njmpp - 1
321      ENDIF
322
323      IF(lwp) THEN
324         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
325         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
326         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
327         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
328      ENDIF
329
330   END SUBROUTINE dom_ctl
331
332   !!======================================================================
333END MODULE domain
Note: See TracBrowser for help on using the repository browser.