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 branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 2370

Last change on this file since 2370 was 2364, checked in by acc, 14 years ago

Added basic NetCDF4 chunking and compression support (key_netcdf4). See ticket #754
  • Property svn:keywords set to Id
File size: 14.9 KB
Line 
1MODULE domain
2   !!==============================================================================
3   !!                       ***  MODULE domain   ***
4   !! Ocean initialization : domain initialization
5   !!==============================================================================
6   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
7   !!                 !  1992-01  (M. Imbard) insert time step initialization
8   !!                 !  1996-06  (G. Madec) generalized vertical coordinate
9   !!                 !  1997-02  (G. Madec) creation of domwri.F
10   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
11   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
12   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
13   !!----------------------------------------------------------------------
14   
15   !!----------------------------------------------------------------------
16   !!   dom_init       : initialize the space and time domain
17   !!   dom_nam        : read and contral domain namelists
18   !!   dom_ctl        : control print for the ocean domain
19   !!----------------------------------------------------------------------
20   USE oce             !
21   USE dom_oce         ! ocean space and time domain
22   USE sbc_oce         ! surface boundary condition: ocean
23   USE phycst          ! physical constants
24   USE closea          ! closed seas
25   USE in_out_manager  ! I/O manager
26   USE lib_mpp         ! distributed memory computing library
27
28   USE domhgr          ! domain: set the horizontal mesh
29   USE domzgr          ! domain: set the vertical mesh
30   USE domstp          ! domain: set the time-step
31   USE dommsk          ! domain: set the mask system
32   USE domwri          ! domain: write the meshmask file
33   USE domvvl          ! variable volume
34
35   IMPLICIT NONE
36   PRIVATE
37
38   PUBLIC   dom_init   ! called by opa.F90
39
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!-------------------------------------------------------------------------
43   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
44   !! $Id$
45   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
46   !!-------------------------------------------------------------------------
47
48CONTAINS
49
50   SUBROUTINE dom_init
51      !!----------------------------------------------------------------------
52      !!                  ***  ROUTINE dom_init  ***
53      !!                   
54      !! ** Purpose :   Domain initialization. Call the routines that are
55      !!              required to create the arrays which define the space
56      !!              and time domain of the ocean model.
57      !!
58      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
59      !!              - dom_hgr: compute or read the horizontal grid-point position
60      !!                         and scale factors, and the coriolis factor
61      !!              - dom_zgr: define the vertical coordinate and the bathymetry
62      !!              - dom_stp: defined the model time step
63      !!              - dom_wri: create the meshmask file if nmsh=1
64      !!----------------------------------------------------------------------
65      INTEGER ::   jk                ! dummy loop argument
66      INTEGER ::   iconf = 0         ! temporary integers
67      !!----------------------------------------------------------------------
68      !
69      IF(lwp) THEN
70         WRITE(numout,*)
71         WRITE(numout,*) 'dom_init : domain initialization'
72         WRITE(numout,*) '~~~~~~~~'
73      ENDIF
74      !
75                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
76                             CALL dom_clo      ! Closed seas and lake
77                             CALL dom_hgr      ! Horizontal mesh
78                             CALL dom_zgr      ! Vertical mesh and bathymetry
79                             CALL dom_msk      ! Masks
80      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
81      !
82      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
83      hv(:,:) = 0.e0
84      DO jk = 1, jpk
85         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
86         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
87      END DO
88      !                                        ! Inverse of the local depth
89      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
90      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
91
92                             CALL dom_stp      ! time step
93      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
94      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
95      !
96   END SUBROUTINE dom_init
97
98
99   SUBROUTINE dom_nam
100      !!----------------------------------------------------------------------
101      !!                     ***  ROUTINE dom_nam  ***
102      !!                   
103      !! ** Purpose :   read domaine namelists and print the variables.
104      !!
105      !! ** input   : - namrun namelist
106      !!              - namdom namelist
107      !!              - namcla namelist
108      !!              - namnc4 namelist   ! "key_netcdf4" only
109      !!----------------------------------------------------------------------
110      USE ioipsl
111      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
112         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
113         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
114      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh   ,   &
115         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin,   &
116         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
117      NAMELIST/namcla/ nn_cla
118#if defined key_netcdf4
119      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
120#endif
121      !!----------------------------------------------------------------------
122
123      REWIND( numnam )              ! Namelist namrun : parameters of the run
124      READ  ( numnam, namrun )
125      !
126      IF(lwp) THEN                  ! control print
127         WRITE(numout,*)
128         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
129         WRITE(numout,*) '~~~~~~~ '
130         WRITE(numout,*) '   Namelist namrun'
131         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
132         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
133         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
134         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
135         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
136         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
137         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
138         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
139         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
140         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
141         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
142         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
143         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
144         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
145         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
146      ENDIF
147
148      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
149      cexper = cn_exp
150      nrstdt = nn_rstctl
151      nit000 = nn_it000
152      nitend = nn_itend
153      ndate0 = nn_date0
154      nleapy = nn_leapy
155      ninist = nn_istate
156      nstock = nn_stock
157      nwrite = nn_write
158
159
160      !                             ! control of output frequency
161      IF ( nstock == 0 .OR. nstock > nitend ) THEN
162         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
163         CALL ctl_warn( ctmp1 )
164         nstock = nitend
165      ENDIF
166      IF ( nwrite == 0 ) THEN
167         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
168         CALL ctl_warn( ctmp1 )
169         nwrite = nitend
170      ENDIF
171
172#if defined key_agrif
173      IF( Agrif_Root() ) THEN
174#endif
175      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
176      CASE (  1 ) 
177         CALL ioconf_calendar('gregorian')
178         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
179      CASE (  0 )
180         CALL ioconf_calendar('noleap')
181         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
182      CASE ( 30 )
183         CALL ioconf_calendar('360d')
184         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
185      END SELECT
186#if defined key_agrif
187      ENDIF
188#endif
189
190      REWIND( numnam )             ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
191      READ  ( numnam, namdom )
192
193      IF(lwp) THEN
194         WRITE(numout,*)
195         WRITE(numout,*) '   Namelist namdom : space & time domain'
196         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
197         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
198         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
199         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
200         WRITE(numout,*) '           = 0   no file created                 '
201         WRITE(numout,*) '           = 1   mesh_mask                       '
202         WRITE(numout,*) '           = 2   mesh and mask                   '
203         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
204         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
205         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
206         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
207         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
208         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
209         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
210         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
211         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
212      ENDIF
213
214      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
215      e3zps_min = rn_e3zps_min
216      e3zps_rat = rn_e3zps_rat
217      nmsh      = nn_msh
218      nacc      = nn_acc
219      atfp      = rn_atfp
220      rdt       = rn_rdt
221      rdtmin    = rn_rdtmin
222      rdtmax    = rn_rdtmin
223      rdth      = rn_rdth
224      nclosea   = nn_closea
225
226      REWIND( numnam )             ! Namelist cross land advection
227      READ  ( numnam, namcla )
228      IF(lwp) THEN
229         WRITE(numout,*)
230         WRITE(numout,*) '   Namelist namcla'
231         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
232      ENDIF
233
234      n_cla = nn_cla                ! conversion DOCTOR names into model names (this should disappear soon)
235
236      IF( lk_mpp_rep .AND. n_cla /= 0 )   CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
237      !
238
239#if defined key_netcdf4
240
241      REWIND( numnam )              ! Namelist namnc4 : netcdf4 chunking parameters
242      READ  ( numnam, namnc4 )
243      IF(lwp) THEN
244         WRITE(numout,*)
245         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
246         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
247         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
248         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
249         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
250      ENDIF
251
252      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
253      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
254      snc4set%ni   = nn_nchunks_i
255      snc4set%nj   = nn_nchunks_j
256      snc4set%nk   = nn_nchunks_k
257      snc4set%luse = ln_nc4zip
258
259#else
260
261      snc4set%luse = .FALSE.
262 
263#endif
264   END SUBROUTINE dom_nam
265
266
267   SUBROUTINE dom_ctl
268      !!----------------------------------------------------------------------
269      !!                     ***  ROUTINE dom_ctl  ***
270      !!
271      !! ** Purpose :   Domain control.
272      !!
273      !! ** Method  :   compute and print extrema of masked scale factors
274      !!----------------------------------------------------------------------
275      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
276      INTEGER, DIMENSION(2) ::   iloc   !
277      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
278      !!----------------------------------------------------------------------
279      !
280      IF(lk_mpp) THEN
281         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
282         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
283         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
284         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
285      ELSE
286         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
287         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
288         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
289         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
290
291         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
292         iimi1 = iloc(1) + nimpp - 1
293         ijmi1 = iloc(2) + njmpp - 1
294         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
295         iimi2 = iloc(1) + nimpp - 1
296         ijmi2 = iloc(2) + njmpp - 1
297         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
298         iima1 = iloc(1) + nimpp - 1
299         ijma1 = iloc(2) + njmpp - 1
300         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
301         iima2 = iloc(1) + nimpp - 1
302         ijma2 = iloc(2) + njmpp - 1
303      ENDIF
304      IF(lwp) THEN
305         WRITE(numout,*)
306         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
307         WRITE(numout,*) '~~~~~~~'
308         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
309         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
310         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
311         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
312      ENDIF
313      !
314   END SUBROUTINE dom_ctl
315
316   !!======================================================================
317END MODULE domain
Note: See TracBrowser for help on using the repository browser.