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

Last change on this file since 1057 was 888, checked in by ctlod, 16 years ago

merge dev_001_SBC branche with the trunk to include the New Surface Module package, see ticket: #113
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.1 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, ngrid  , nmsh  ,   &
148         &             nacc  , atfp     , rdt      , rdtmin , rdtmax,   &
149         &             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 read/compute coordinates  ngrid     = ', ngrid
243         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
244         WRITE(numout,*) '                = 0   no file created                 '
245         WRITE(numout,*) '                = 1   mesh_mask                       '
246         WRITE(numout,*) '                = 2   mesh and mask                   '
247         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
248         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
249         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
250         WRITE(numout,*) '           time step                      rdt       = ', rdt
251         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
252         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
253         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
254         WRITE(numout,*) '           barotropic time step           rdtbt     = ', rdtbt
255      ENDIF
256
257      ! Default values
258      n_cla = 0
259
260      ! Namelist cross land advection
261      REWIND( numnam )
262      READ  ( numnam, namcla )
263      IF(lwp) THEN
264         WRITE(numout,*)
265         WRITE(numout,*) '        Namelist namcla'
266         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
267      ENDIF
268
269      IF( nbit_cmp == 1 .AND. n_cla /= 0 ) THEN
270         CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
271      END IF
272
273   END SUBROUTINE dom_nam
274
275
276   SUBROUTINE dom_ctl
277      !!----------------------------------------------------------------------
278      !!                     ***  ROUTINE dom_ctl  ***
279      !!
280      !! ** Purpose :   Domain control.
281      !!
282      !! ** Method  :   compute and print extrema of masked scale factors
283      !!
284      !! History :
285      !!   8.5  !  02-08  (G. Madec)    Original code
286      !!----------------------------------------------------------------------
287      !! * Local declarations
288      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
289      INTEGER, DIMENSION(2) ::   iloc      !
290      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
291      !!----------------------------------------------------------------------
292
293      ! Extrema of the scale factors
294
295      IF(lwp)WRITE(numout,*)
296      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
297      IF(lwp)WRITE(numout,*) '~~~~~~~'
298
299      IF (lk_mpp) THEN
300         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
301         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
302         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
303         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
304      ELSE
305         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
306         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
307         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
308         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
309
310         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
311         iimi1 = iloc(1) + nimpp - 1
312         ijmi1 = iloc(2) + njmpp - 1
313         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
314         iimi2 = iloc(1) + nimpp - 1
315         ijmi2 = iloc(2) + njmpp - 1
316         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
317         iima1 = iloc(1) + nimpp - 1
318         ijma1 = iloc(2) + njmpp - 1
319         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
320         iima2 = iloc(1) + nimpp - 1
321         ijma2 = iloc(2) + njmpp - 1
322      ENDIF
323
324      IF(lwp) THEN
325         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
326         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
327         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
328         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
329      ENDIF
330
331   END SUBROUTINE dom_ctl
332
333   !!======================================================================
334END MODULE domain
Note: See TracBrowser for help on using the repository browser.