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

Last change on this file since 584 was 531, checked in by opalod, 18 years ago

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