source: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 3421

Last change on this file since 3421 was 3421, checked in by charris, 9 years ago

#936 Changes as suggested by Gurvan et al (testing details in the ticket). Note that for ORCA1 results will change with either nn_closea=0 or 1 because the Caspian Sea is now coded as a closed sea.

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