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/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OFF_SRC – NEMO

source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/OFF_SRC/domain.F90 @ 4147

Last change on this file since 4147 was 4147, checked in by cetlod, 10 years ago

merge in dev_LOCEAN_2013, the 1st development branch dev_r3853_CNRS9_Confsetting, from its starting point ( r3853 ) on the trunk: see ticket #1169
  • Property svn:keywords set to Id
File size: 19.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$
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      INTEGER  ::   ios                 ! Local integer output status for namelist read
91      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
92         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
93         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
94      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
95         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
96         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , &
97         &             jphgr_msh, &
98         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
99         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
100         &             ppa2, ppkth2, ppacr2
101      NAMELIST/namcla/ nn_cla
102#if defined key_netcdf4
103      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
104#endif
105      !!----------------------------------------------------------------------
106
107      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
108      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
109901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
110
111      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
112      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
113902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
114      WRITE ( numond, namrun )
115      !
116      IF(lwp) THEN                  ! control print
117         WRITE(numout,*)
118         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
119         WRITE(numout,*) '~~~~~~~ '
120         WRITE(numout,*) '   Namelist namrun' 
121         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
122         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
123         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
124         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
125         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
126         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
127         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
128         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
129         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
130         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
131         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
132         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
133         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
134         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
135         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
136      ENDIF
137      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
138      cexper = cn_exp
139      nrstdt = nn_rstctl
140      nit000 = nn_it000
141      nitend = nn_itend
142      ndate0 = nn_date0
143      nleapy = nn_leapy
144      ninist = nn_istate
145      nstock = nn_stock
146      nwrite = nn_write
147
148
149      !                             ! control of output frequency
150      IF ( nstock == 0 .OR. nstock > nitend ) THEN
151         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
152         CALL ctl_warn( ctmp1 )
153         nstock = nitend
154      ENDIF
155      IF ( nwrite == 0 ) THEN
156         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
157         CALL ctl_warn( ctmp1 )
158         nwrite = nitend
159      ENDIF
160
161      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
162      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
163      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
164
165#if defined key_agrif
166      IF( Agrif_Root() ) THEN
167#endif
168      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
169      CASE (  1 ) 
170         CALL ioconf_calendar('gregorian')
171         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
172      CASE (  0 )
173         CALL ioconf_calendar('noleap')
174         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
175      CASE ( 30 )
176         CALL ioconf_calendar('360d')
177         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
178      END SELECT
179#if defined key_agrif
180      ENDIF
181#endif
182
183      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
184      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
185903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
186
187      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
188      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
189904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
190      WRITE ( numond, namdom )
191
192      IF(lwp) THEN
193         WRITE(numout,*) 
194         WRITE(numout,*) '   Namelist namdom : space & time domain'
195         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
196         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
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         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
213         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
214         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
215         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
216         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
217         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
218         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
219         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
220         WRITE(numout,*) '                                        ppa0            = ', ppa0
221         WRITE(numout,*) '                                        ppa1            = ', ppa1
222         WRITE(numout,*) '                                        ppkth           = ', ppkth
223         WRITE(numout,*) '                                        ppacr           = ', ppacr
224         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
225         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
226         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
227         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
228         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
229         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
230      ENDIF
231
232      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
233      e3zps_min = rn_e3zps_min
234      e3zps_rat = rn_e3zps_rat
235      nmsh      = nn_msh
236      nacc      = nn_acc
237      atfp      = rn_atfp
238      rdt       = rn_rdt
239      rdtmin    = rn_rdtmin
240      rdtmax    = rn_rdtmin
241      rdth      = rn_rdth
242
243      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
244      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
245905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
246
247      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
248      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
249906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
250      WRITE( numond, namcla )
251
252      IF(lwp) THEN
253         WRITE(numout,*)
254         WRITE(numout,*) '   Namelist namcla'
255         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
256      ENDIF
257
258#if defined key_netcdf4
259      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
260      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
261      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
262907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
263
264      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
265      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
266908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
267      WRITE( numond, namnc4 )
268      IF(lwp) THEN                        ! control print
269         WRITE(numout,*)
270         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
271         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
272         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
273         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
274         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
275      ENDIF
276
277      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
278      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
279      snc4set%ni   = nn_nchunks_i
280      snc4set%nj   = nn_nchunks_j
281      snc4set%nk   = nn_nchunks_k
282      snc4set%luse = ln_nc4zip
283#else
284      snc4set%luse = .FALSE.        ! No NetCDF 4 case
285#endif
286      !
287   END SUBROUTINE dom_nam
288
289   SUBROUTINE dom_zgr
290      !!----------------------------------------------------------------------
291      !!                ***  ROUTINE dom_zgr  ***
292      !!                   
293      !! ** Purpose :  set the depth of model levels and the resulting
294      !!      vertical scale factors.
295      !!
296      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0)
297      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
298      !!              - vertical coordinate (gdep., e3.) depending on the
299      !!                coordinate chosen :
300      !!                   ln_zco=T   z-coordinate 
301      !!                   ln_zps=T   z-coordinate with partial steps
302      !!                   ln_zco=T   s-coordinate
303      !!
304      !! ** Action  :   define gdep., e3., mbathy and bathy
305      !!----------------------------------------------------------------------
306      INTEGER ::   ioptio = 0   ! temporary integer
307      INTEGER ::   ios
308      !!
309      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
310      !!----------------------------------------------------------------------
311
312      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
313      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
314901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
315
316      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
317      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
318902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
319      WRITE ( numond, namzgr )
320
321      IF(lwp) THEN                     ! Control print
322         WRITE(numout,*)
323         WRITE(numout,*) 'dom_zgr : vertical coordinate'
324         WRITE(numout,*) '~~~~~~~'
325         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
326         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
327         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
328         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
329      ENDIF
330
331      ioptio = 0                       ! Check Vertical coordinate options
332      IF( ln_zco ) ioptio = ioptio + 1
333      IF( ln_zps ) ioptio = ioptio + 1
334      IF( ln_sco ) ioptio = ioptio + 1
335      IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
336
337   END SUBROUTINE dom_zgr
338
339   SUBROUTINE dom_ctl
340      !!----------------------------------------------------------------------
341      !!                     ***  ROUTINE dom_ctl  ***
342      !!
343      !! ** Purpose :   Domain control.
344      !!
345      !! ** Method  :   compute and print extrema of masked scale factors
346      !!
347      !! History :
348      !!   8.5  !  02-08  (G. Madec)    Original code
349      !!----------------------------------------------------------------------
350      !! * Local declarations
351      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
352      INTEGER, DIMENSION(2) ::   iloc      !
353      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
354      !!----------------------------------------------------------------------
355
356      ! Extrema of the scale factors
357
358      IF(lwp)WRITE(numout,*)
359      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
360      IF(lwp)WRITE(numout,*) '~~~~~~~'
361
362      IF (lk_mpp) THEN
363         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
364         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
365         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
366         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
367      ELSE
368         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
369         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
370         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
371         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
372
373         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
374         iimi1 = iloc(1) + nimpp - 1
375         ijmi1 = iloc(2) + njmpp - 1
376         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
377         iimi2 = iloc(1) + nimpp - 1
378         ijmi2 = iloc(2) + njmpp - 1
379         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
380         iima1 = iloc(1) + nimpp - 1
381         ijma1 = iloc(2) + njmpp - 1
382         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
383         iima2 = iloc(1) + nimpp - 1
384         ijma2 = iloc(2) + njmpp - 1
385      ENDIF
386
387      IF(lwp) THEN
388         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
389         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
390         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
391         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
392      ENDIF
393
394   END SUBROUTINE dom_ctl
395
396   !!======================================================================
397END MODULE domain
Note: See TracBrowser for help on using the repository browser.