source: vendor/nemo/v3.4_r_3220_dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OFF_SRC/domain.F90 @ 86

Last change on this file since 86 was 1, checked in by cholod, 13 years ago

importing initial nemo vendor drop (v3.4_r_3220)
File size: 15.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 lib_mpp         ! distributed memory computing library
18
19   USE domstp          ! domain: set the time-step
20   USE domrea          ! domain: write the meshmask file
21   USE dommsk          ! domain : mask
22
23   IMPLICIT NONE
24   PRIVATE
25
26   !! * Routine accessibility
27   PUBLIC dom_init       ! called by opa.F90
28
29   !! * Substitutions
30#  include "domzgr_substitute.h90"
31   !!----------------------------------------------------------------------
32   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
33   !! $Id: domain.F90 2574 2011-02-02 14:10:08Z cetlod $
34   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
35   !!----------------------------------------------------------------------
36
37CONTAINS
38
39   SUBROUTINE dom_init
40      !!----------------------------------------------------------------------
41      !!                  ***  ROUTINE dom_init  ***
42      !!                   
43      !! ** Purpose :   Domain initialization. Call the routines that are
44      !!      required to create the arrays which define the space and time
45      !!      domain of the ocean model.
46      !!
47      !! ** Method  :
48      !!      - dom_stp: defined the model time step
49      !!      - dom_rea: read the meshmask file if nmsh=1
50      !!
51      !! History :
52      !!        !  90-10  (C. Levy - G. Madec)  Original code
53      !!        !  91-11  (G. Madec)
54      !!        !  92-01  (M. Imbard) insert time step initialization
55      !!        !  96-06  (G. Madec) generalized vertical coordinate
56      !!        !  97-02  (G. Madec) creation of domwri.F
57      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
58      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
59      !!----------------------------------------------------------------------
60      !! * Local declarations
61      INTEGER ::   iconf = 0         ! temporary integers
62      !!----------------------------------------------------------------------
63
64      IF(lwp) THEN
65         WRITE(numout,*)
66         WRITE(numout,*) 'dom_init : domain initialization'
67         WRITE(numout,*) '~~~~~~~~'
68      ENDIF
69
70      CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
71      CALL dom_zgr      ! Vertical mesh and bathymetry option
72      CALL dom_rea      ! Create a domain file
73      CALL dom_stp      ! Time step
74      CALL dom_msk      ! Masks
75      CALL dom_ctl      ! Domain control
76
77   END SUBROUTINE dom_init
78
79   SUBROUTINE dom_nam
80      !!----------------------------------------------------------------------
81      !!                     ***  ROUTINE dom_nam  ***
82      !!                   
83      !! ** Purpose :   read domaine namelists and print the variables.
84      !!
85      !! ** input   : - namrun namelist
86      !!              - namdom namelist
87      !!              - namcla namelist
88      !!----------------------------------------------------------------------
89      USE ioipsl
90      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
91         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
92         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
93      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,     &
94         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,              &
95         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
96      NAMELIST/namcla/ nn_cla
97#if defined key_netcdf4
98      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
99#endif
100      !!----------------------------------------------------------------------
101
102      REWIND( numnam )              ! Namelist namrun : parameters of the run
103      READ  ( numnam, namrun )
104      !
105      IF(lwp) THEN                  ! control print
106         WRITE(numout,*)
107         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
108         WRITE(numout,*) '~~~~~~~ '
109         WRITE(numout,*) '   Namelist namrun' 
110         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
111         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
112         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
113         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
114         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
115         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
116         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
117         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
118         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
119         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
120         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
121         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
122         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
123         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
124         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
125      ENDIF
126      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
127      cexper = cn_exp
128      nrstdt = nn_rstctl
129      nit000 = nn_it000
130      nitend = nn_itend
131      ndate0 = nn_date0
132      nleapy = nn_leapy
133      ninist = nn_istate
134      nstock = nn_stock
135      nwrite = nn_write
136
137
138      !                             ! control of output frequency
139      IF ( nstock == 0 .OR. nstock > nitend ) THEN
140         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
141         CALL ctl_warn( ctmp1 )
142         nstock = nitend
143      ENDIF
144      IF ( nwrite == 0 ) THEN
145         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
146         CALL ctl_warn( ctmp1 )
147         nwrite = nitend
148      ENDIF
149
150      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
151      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
152      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
153
154#if defined key_agrif
155      IF( Agrif_Root() ) THEN
156#endif
157      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
158      CASE (  1 ) 
159         CALL ioconf_calendar('gregorian')
160         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
161      CASE (  0 )
162         CALL ioconf_calendar('noleap')
163         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
164      CASE ( 30 )
165         CALL ioconf_calendar('360d')
166         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
167      END SELECT
168#if defined key_agrif
169      ENDIF
170#endif
171
172      REWIND( numnam )             ! Domain
173      READ  ( numnam, namdom )
174
175      IF(lwp) THEN
176         WRITE(numout,*) 
177         WRITE(numout,*) '   Namelist namdom : space & time domain'
178         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
179         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
180         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
181         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
182         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
183         WRITE(numout,*) '           = 0   no file created                 '
184         WRITE(numout,*) '           = 1   mesh_mask                       '
185         WRITE(numout,*) '           = 2   mesh and mask                   '
186         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
187         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
188         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
189         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
190         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
191         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
192         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
193         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
194         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
195      ENDIF
196
197      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
198      e3zps_min = rn_e3zps_min
199      e3zps_rat = rn_e3zps_rat
200      nmsh      = nn_msh
201      nacc      = nn_acc
202      atfp      = rn_atfp
203      rdt       = rn_rdt
204      rdtmin    = rn_rdtmin
205      rdtmax    = rn_rdtmin
206      rdth      = rn_rdth
207      nclosea   = nn_closea
208
209      REWIND( numnam )             ! Namelist cross land advection
210      READ  ( numnam, namcla )
211      IF(lwp) THEN
212         WRITE(numout,*)
213         WRITE(numout,*) '   Namelist namcla'
214         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
215      ENDIF
216
217#if defined key_netcdf4
218      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
219      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
220      READ  ( numnam, namnc4 )
221      IF(lwp) THEN                        ! control print
222         WRITE(numout,*)
223         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
224         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
225         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
226         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
227         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
228      ENDIF
229
230      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
231      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
232      snc4set%ni   = nn_nchunks_i
233      snc4set%nj   = nn_nchunks_j
234      snc4set%nk   = nn_nchunks_k
235      snc4set%luse = ln_nc4zip
236#else
237      snc4set%luse = .FALSE.        ! No NetCDF 4 case
238#endif
239      !
240   END SUBROUTINE dom_nam
241
242   SUBROUTINE dom_zgr
243      !!----------------------------------------------------------------------
244      !!                ***  ROUTINE dom_zgr  ***
245      !!                   
246      !! ** Purpose :  set the depth of model levels and the resulting
247      !!      vertical scale factors.
248      !!
249      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0)
250      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
251      !!              - vertical coordinate (gdep., e3.) depending on the
252      !!                coordinate chosen :
253      !!                   ln_zco=T   z-coordinate 
254      !!                   ln_zps=T   z-coordinate with partial steps
255      !!                   ln_zco=T   s-coordinate
256      !!
257      !! ** Action  :   define gdep., e3., mbathy and bathy
258      !!----------------------------------------------------------------------
259      INTEGER ::   ioptio = 0   ! temporary integer
260      !!
261      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
262      !!----------------------------------------------------------------------
263
264      REWIND ( numnam )                ! Read Namelist namzgr : vertical coordinate'
265      READ   ( numnam, namzgr )
266
267      IF(lwp) THEN                     ! Control print
268         WRITE(numout,*)
269         WRITE(numout,*) 'dom_zgr : vertical coordinate'
270         WRITE(numout,*) '~~~~~~~'
271         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
272         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
273         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
274         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
275      ENDIF
276
277      ioptio = 0                       ! Check Vertical coordinate options
278      IF( ln_zco ) ioptio = ioptio + 1
279      IF( ln_zps ) ioptio = ioptio + 1
280      IF( ln_sco ) ioptio = ioptio + 1
281      IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
282
283   END SUBROUTINE dom_zgr
284
285   SUBROUTINE dom_ctl
286      !!----------------------------------------------------------------------
287      !!                     ***  ROUTINE dom_ctl  ***
288      !!
289      !! ** Purpose :   Domain control.
290      !!
291      !! ** Method  :   compute and print extrema of masked scale factors
292      !!
293      !! History :
294      !!   8.5  !  02-08  (G. Madec)    Original code
295      !!----------------------------------------------------------------------
296      !! * Local declarations
297      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
298      INTEGER, DIMENSION(2) ::   iloc      !
299      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
300      !!----------------------------------------------------------------------
301
302      ! Extrema of the scale factors
303
304      IF(lwp)WRITE(numout,*)
305      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
306      IF(lwp)WRITE(numout,*) '~~~~~~~'
307
308      IF (lk_mpp) THEN
309         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
310         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
311         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
312         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
313      ELSE
314         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
315         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
316         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
317         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
318
319         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
320         iimi1 = iloc(1) + nimpp - 1
321         ijmi1 = iloc(2) + njmpp - 1
322         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
323         iimi2 = iloc(1) + nimpp - 1
324         ijmi2 = iloc(2) + njmpp - 1
325         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
326         iima1 = iloc(1) + nimpp - 1
327         ijma1 = iloc(2) + njmpp - 1
328         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
329         iima2 = iloc(1) + nimpp - 1
330         ijma2 = iloc(2) + njmpp - 1
331      ENDIF
332
333      IF(lwp) THEN
334         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
335         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
336         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
337         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
338      ENDIF
339
340   END SUBROUTINE dom_ctl
341
342   !!======================================================================
343END MODULE domain
Note: See TracBrowser for help on using the repository browser.