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

Last change on this file since 1312 was 1312, checked in by smasson, 15 years ago

add a namelist logical to mask land points in NetCDF outputs, see ticket:322
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
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 in_out_manager  ! I/O manager
19   USE lib_mpp         ! distributed memory computing library
20
21   USE domhgr          ! domain: set the horizontal mesh
22   USE domzgr          ! domain: set the vertical mesh
23   USE domstp          ! domain: set the time-step
24   USE dommsk          ! domain: set the mask system
25   USE domwri          ! domain: write the meshmask file
26   USE closea          ! closed sea or lake              (dom_clo routine)
27   USE domvvl          ! variable volume
28
29   IMPLICIT NONE
30   PRIVATE
31
32   !! * Routine accessibility
33   PUBLIC dom_init       ! called by opa.F90
34
35   !! * Substitutions
36#  include "domzgr_substitute.h90"
37   !!----------------------------------------------------------------------
38   !!   OPA 9.0 , LOCEAN-IPSL (2005)
39   !! $Id$
40   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
41   !!----------------------------------------------------------------------
42
43CONTAINS
44
45   SUBROUTINE dom_init
46      !!----------------------------------------------------------------------
47      !!                  ***  ROUTINE dom_init  ***
48      !!                   
49      !! ** Purpose :   Domain initialization. Call the routines that are
50      !!      required to create the arrays which define the space and time
51      !!      domain of the ocean model.
52      !!
53      !! ** Method  :
54      !!      - dom_msk: compute the masks from the bathymetry file
55      !!      - dom_hgr: compute or read the horizontal grid-point position and
56      !!                scale factors, and the coriolis factor
57      !!      - dom_zgr: define the vertical coordinate system and the bathymetry
58      !!      - dom_stp: defined the model time step
59      !!      - dom_wri: create the meshmask file if nmsh=1
60      !!
61      !! History :
62      !!        !  90-10  (C. Levy - G. Madec)  Original code
63      !!        !  91-11  (G. Madec)
64      !!        !  92-01  (M. Imbard) insert time step initialization
65      !!        !  96-06  (G. Madec) generalized vertical coordinate
66      !!        !  97-02  (G. Madec) creation of domwri.F
67      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
68      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
69      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
70      !!----------------------------------------------------------------------
71      !! * Local declarations
72      INTEGER ::   jk                ! dummy loop argument
73      INTEGER ::   iconf = 0         ! temporary integers
74      !!----------------------------------------------------------------------
75
76      IF(lwp) THEN
77         WRITE(numout,*)
78         WRITE(numout,*) 'dom_init : domain initialization'
79         WRITE(numout,*) '~~~~~~~~'
80      ENDIF
81
82      CALL dom_nam                        ! read namelist ( namrun, namdom, namcla )
83
84      CALL dom_clo                        ! Closed seas and lake
85
86      CALL dom_hgr                        ! Horizontal mesh
87
88      CALL dom_zgr                        ! Vertical mesh and bathymetry
89
90      CALL dom_msk                        ! Masks
91
92      IF( lk_vvl )   CALL dom_vvl_ini     ! Vertical variable mesh
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, cn_ocerst_in, cn_ocerst_out, ln_rstart, nrstdt,   &
143         &             nit000, nitend, ndate0      , nleapy       , ninist   , nstock,   &
144         &             nwrite, ln_dimgnnn, ln_mskland
145
146      NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, nmsh   ,   &
147         &             nacc  , atfp     , rdt      , rdtmin ,   &
148         &             rdtmax, rdth     , nn_baro  , 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,*) '           multi file dimgout           ln_dimgnnn   = ', ln_dimgnnn
176         WRITE(numout,*) '           mask land points             ln_mskland   = ', ln_mskland
177      ENDIF
178
179      ! ... Control of output frequency
180      IF ( nstock == 0 .OR. nstock > nitend - nit000 + 1 ) THEN
181         WRITE(ctmp1,*) '           nstock = ', nstock, ' it is forced to ', nitend - nit000 + 1
182         CALL ctl_warn( ctmp1 )
183         nstock = nitend - nit000 + 1
184      ENDIF
185      IF ( nwrite == 0 ) THEN
186         WRITE(ctmp1,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
187         CALL ctl_warn( ctmp1 )
188         nwrite = nitend
189      ENDIF
190
191#if defined key_agrif
192      if ( Agrif_Root() ) then
193#endif
194      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
195      CASE (  1 ) 
196         CALL ioconf_calendar('gregorian')
197         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year'
198      CASE (  0 )
199         CALL ioconf_calendar('noleap')
200         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year'
201      CASE ( 30 )
202         CALL ioconf_calendar('360d')
203         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year'
204      END SELECT
205#if defined key_agrif
206      endif
207#endif
208
209      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
210      CASE ( 1 )
211         raajj = 365.25
212         raass = raajj * rjjss
213         rmoss = raass/raamo
214      CASE ( 0 )
215         raajj = 365.
216         raass = raajj * rjjss
217         rmoss = raass/raamo
218      CASE DEFAULT
219         raajj = FLOAT( nleapy ) * raamo
220         raass =        raajj    * rjjss
221         rmoss = FLOAT( nleapy ) * rjjss
222      END SELECT
223      IF(lwp) THEN
224         WRITE(numout,*)
225         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
226         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
227         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
228      ENDIF
229
230      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
231      REWIND( numnam )
232      READ  ( numnam, namdom )
233
234      IF(lwp) THEN
235         WRITE(numout,*)
236         WRITE(numout,*) '        Namelist namdom'
237         WRITE(numout,*) '           flag read/compute bathymetry   ntopo     = ', ntopo
238         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
239         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
240         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
241         WRITE(numout,*) '                = 0   no file created                 '
242         WRITE(numout,*) '                = 1   mesh_mask                       '
243         WRITE(numout,*) '                = 2   mesh and mask                   '
244         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
245         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
246         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
247         WRITE(numout,*) '           time step                      rdt       = ', rdt
248         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
249         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
250         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
251         WRITE(numout,*) '           number of barotropic time step nn_baro   = ', nn_baro
252      ENDIF
253
254      ! Default values
255      n_cla = 0
256
257      ! Namelist cross land advection
258      REWIND( numnam )
259      READ  ( numnam, namcla )
260      IF(lwp) THEN
261         WRITE(numout,*)
262         WRITE(numout,*) '        Namelist namcla'
263         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
264      ENDIF
265
266      IF( nbit_cmp == 1 .AND. n_cla /= 0 ) THEN
267         CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
268      END IF
269
270   END SUBROUTINE dom_nam
271
272
273   SUBROUTINE dom_ctl
274      !!----------------------------------------------------------------------
275      !!                     ***  ROUTINE dom_ctl  ***
276      !!
277      !! ** Purpose :   Domain control.
278      !!
279      !! ** Method  :   compute and print extrema of masked scale factors
280      !!
281      !! History :
282      !!   8.5  !  02-08  (G. Madec)    Original code
283      !!----------------------------------------------------------------------
284      !! * Local declarations
285      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
286      INTEGER, DIMENSION(2) ::   iloc      !
287      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
288      !!----------------------------------------------------------------------
289
290      ! Extrema of the scale factors
291
292      IF(lwp)WRITE(numout,*)
293      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
294      IF(lwp)WRITE(numout,*) '~~~~~~~'
295
296      IF (lk_mpp) THEN
297         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
298         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
299         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
300         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
301      ELSE
302         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
303         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
304         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
305         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
306
307         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
308         iimi1 = iloc(1) + nimpp - 1
309         ijmi1 = iloc(2) + njmpp - 1
310         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
311         iimi2 = iloc(1) + nimpp - 1
312         ijmi2 = iloc(2) + njmpp - 1
313         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
314         iima1 = iloc(1) + nimpp - 1
315         ijma1 = iloc(2) + njmpp - 1
316         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
317         iima2 = iloc(1) + nimpp - 1
318         ijma2 = iloc(2) + njmpp - 1
319      ENDIF
320
321      IF(lwp) THEN
322         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
323         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
324         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
325         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
326      ENDIF
327
328   END SUBROUTINE dom_ctl
329
330   !!======================================================================
331END MODULE domain
Note: See TracBrowser for help on using the repository browser.