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

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

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