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

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago

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