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

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OFF_SRC/domain.F90 @ 4291

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

dev_merge : minor corrections

  • Property svn:keywords set to Id
File size: 19.8 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_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 , ln_crs, &
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,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
197         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
198         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
199         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
200         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
201         WRITE(numout,*) '           = 0   no file created                 '
202         WRITE(numout,*) '           = 1   mesh_mask                       '
203         WRITE(numout,*) '           = 2   mesh and mask                   '
204         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
205         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
206         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
207         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
208         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
209         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
210         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
211         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
212         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
213         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
214         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
215         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
216         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
217         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
218         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
219         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
220         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
221         WRITE(numout,*) '                                        ppa0            = ', ppa0
222         WRITE(numout,*) '                                        ppa1            = ', ppa1
223         WRITE(numout,*) '                                        ppkth           = ', ppkth
224         WRITE(numout,*) '                                        ppacr           = ', ppacr
225         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
226         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
227         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
228         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
229         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
230         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
231      ENDIF
232
233      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
234      e3zps_min = rn_e3zps_min
235      e3zps_rat = rn_e3zps_rat
236      nmsh      = nn_msh
237      nacc      = nn_acc
238      atfp      = rn_atfp
239      rdt       = rn_rdt
240      rdtmin    = rn_rdtmin
241      rdtmax    = rn_rdtmin
242      rdth      = rn_rdth
243
244      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
245      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
246905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
247
248      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
249      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
250906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
251      WRITE( numond, namcla )
252
253      IF(lwp) THEN
254         WRITE(numout,*)
255         WRITE(numout,*) '   Namelist namcla'
256         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
257      ENDIF
258
259#if defined key_netcdf4
260      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
261      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
262      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
263907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
264
265      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
266      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
267908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
268      WRITE( numond, namnc4 )
269      IF(lwp) THEN                        ! control print
270         WRITE(numout,*)
271         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
272         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
273         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
274         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
275         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
276      ENDIF
277
278      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
279      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
280      snc4set%ni   = nn_nchunks_i
281      snc4set%nj   = nn_nchunks_j
282      snc4set%nk   = nn_nchunks_k
283      snc4set%luse = ln_nc4zip
284#else
285      snc4set%luse = .FALSE.        ! No NetCDF 4 case
286#endif
287      !
288   END SUBROUTINE dom_nam
289
290   SUBROUTINE dom_zgr
291      !!----------------------------------------------------------------------
292      !!                ***  ROUTINE dom_zgr  ***
293      !!                   
294      !! ** Purpose :  set the depth of model levels and the resulting
295      !!      vertical scale factors.
296      !!
297      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0)
298      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
299      !!              - vertical coordinate (gdep., e3.) depending on the
300      !!                coordinate chosen :
301      !!                   ln_zco=T   z-coordinate 
302      !!                   ln_zps=T   z-coordinate with partial steps
303      !!                   ln_zco=T   s-coordinate
304      !!
305      !! ** Action  :   define gdep., e3., mbathy and bathy
306      !!----------------------------------------------------------------------
307      INTEGER ::   ioptio = 0   ! temporary integer
308      INTEGER ::   ios
309      !!
310      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
311      !!----------------------------------------------------------------------
312
313      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
314      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
315901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
316
317      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
318      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
319902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
320      WRITE ( numond, namzgr )
321
322      IF(lwp) THEN                     ! Control print
323         WRITE(numout,*)
324         WRITE(numout,*) 'dom_zgr : vertical coordinate'
325         WRITE(numout,*) '~~~~~~~'
326         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
327         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
328         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
329         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
330      ENDIF
331
332      ioptio = 0                       ! Check Vertical coordinate options
333      IF( ln_zco ) ioptio = ioptio + 1
334      IF( ln_zps ) ioptio = ioptio + 1
335      IF( ln_sco ) ioptio = ioptio + 1
336      IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
337
338   END SUBROUTINE dom_zgr
339
340   SUBROUTINE dom_ctl
341      !!----------------------------------------------------------------------
342      !!                     ***  ROUTINE dom_ctl  ***
343      !!
344      !! ** Purpose :   Domain control.
345      !!
346      !! ** Method  :   compute and print extrema of masked scale factors
347      !!
348      !! History :
349      !!   8.5  !  02-08  (G. Madec)    Original code
350      !!----------------------------------------------------------------------
351      !! * Local declarations
352      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
353      INTEGER, DIMENSION(2) ::   iloc      !
354      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
355      !!----------------------------------------------------------------------
356
357      ! Extrema of the scale factors
358
359      IF(lwp)WRITE(numout,*)
360      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
361      IF(lwp)WRITE(numout,*) '~~~~~~~'
362
363      IF (lk_mpp) THEN
364         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
365         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
366         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
367         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
368      ELSE
369         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
370         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
371         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
372         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
373
374         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
375         iimi1 = iloc(1) + nimpp - 1
376         ijmi1 = iloc(2) + njmpp - 1
377         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
378         iimi2 = iloc(1) + nimpp - 1
379         ijmi2 = iloc(2) + njmpp - 1
380         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
381         iima1 = iloc(1) + nimpp - 1
382         ijma1 = iloc(2) + njmpp - 1
383         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
384         iima2 = iloc(1) + nimpp - 1
385         ijma2 = iloc(2) + njmpp - 1
386      ENDIF
387
388      IF(lwp) THEN
389         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
390         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
391         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
392         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
393      ENDIF
394
395   END SUBROUTINE dom_ctl
396
397   !!======================================================================
398END MODULE domain
Note: See TracBrowser for help on using the repository browser.