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

source: branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OFF_SRC/domain.F90 @ 3750

Last change on this file since 3750 was 3632, checked in by acc, 11 years ago

Branch dev_NOC_2012_r3555. #1006. Step 9: Merge in trunk changes between revision 3385 and 3452
  • Property svn:keywords set to Id
File size: 15.6 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      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
208      REWIND( numnam )             ! Namelist cross land advection
209      READ  ( numnam, namcla )
210      IF(lwp) THEN
211         WRITE(numout,*)
212         WRITE(numout,*) '   Namelist namcla'
213         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
214      ENDIF
215
216#if defined key_netcdf4
217      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
218      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
219      READ  ( numnam, namnc4 )
220      IF(lwp) THEN                        ! control print
221         WRITE(numout,*)
222         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
223         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
224         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
225         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
226         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
227      ENDIF
228
229      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
230      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
231      snc4set%ni   = nn_nchunks_i
232      snc4set%nj   = nn_nchunks_j
233      snc4set%nk   = nn_nchunks_k
234      snc4set%luse = ln_nc4zip
235#else
236      snc4set%luse = .FALSE.        ! No NetCDF 4 case
237#endif
238      !
239   END SUBROUTINE dom_nam
240
241   SUBROUTINE dom_zgr
242      !!----------------------------------------------------------------------
243      !!                ***  ROUTINE dom_zgr  ***
244      !!                   
245      !! ** Purpose :  set the depth of model levels and the resulting
246      !!      vertical scale factors.
247      !!
248      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0)
249      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
250      !!              - vertical coordinate (gdep., e3.) depending on the
251      !!                coordinate chosen :
252      !!                   ln_zco=T   z-coordinate 
253      !!                   ln_zps=T   z-coordinate with partial steps
254      !!                   ln_zco=T   s-coordinate
255      !!
256      !! ** Action  :   define gdep., e3., mbathy and bathy
257      !!----------------------------------------------------------------------
258      INTEGER ::   ioptio = 0   ! temporary integer
259      !!
260      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
261      !!----------------------------------------------------------------------
262
263      REWIND ( numnam )                ! Read Namelist namzgr : vertical coordinate'
264      READ   ( numnam, namzgr )
265
266      IF(lwp) THEN                     ! Control print
267         WRITE(numout,*)
268         WRITE(numout,*) 'dom_zgr : vertical coordinate'
269         WRITE(numout,*) '~~~~~~~'
270         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
271         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
272         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
273         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
274      ENDIF
275
276      ioptio = 0                       ! Check Vertical coordinate options
277      IF( ln_zco ) ioptio = ioptio + 1
278      IF( ln_zps ) ioptio = ioptio + 1
279      IF( ln_sco ) ioptio = ioptio + 1
280      IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
281
282   END SUBROUTINE dom_zgr
283
284   SUBROUTINE dom_ctl
285      !!----------------------------------------------------------------------
286      !!                     ***  ROUTINE dom_ctl  ***
287      !!
288      !! ** Purpose :   Domain control.
289      !!
290      !! ** Method  :   compute and print extrema of masked scale factors
291      !!
292      !! History :
293      !!   8.5  !  02-08  (G. Madec)    Original code
294      !!----------------------------------------------------------------------
295      !! * Local declarations
296      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
297      INTEGER, DIMENSION(2) ::   iloc      !
298      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
299      !!----------------------------------------------------------------------
300
301      ! Extrema of the scale factors
302
303      IF(lwp)WRITE(numout,*)
304      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
305      IF(lwp)WRITE(numout,*) '~~~~~~~'
306
307      IF (lk_mpp) THEN
308         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
309         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
310         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
311         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
312      ELSE
313         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
314         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
315         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
316         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
317
318         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
319         iimi1 = iloc(1) + nimpp - 1
320         ijmi1 = iloc(2) + njmpp - 1
321         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
322         iimi2 = iloc(1) + nimpp - 1
323         ijmi2 = iloc(2) + njmpp - 1
324         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
325         iima1 = iloc(1) + nimpp - 1
326         ijma1 = iloc(2) + njmpp - 1
327         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
328         iima2 = iloc(1) + nimpp - 1
329         ijma2 = iloc(2) + njmpp - 1
330      ENDIF
331
332      IF(lwp) THEN
333         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
334         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
335         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
336         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
337      ENDIF
338
339   END SUBROUTINE dom_ctl
340
341   !!======================================================================
342END MODULE domain
Note: See TracBrowser for help on using the repository browser.