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 trunk/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

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

Last change on this file since 3720 was 3720, checked in by cbricaud, 11 years ago

correction ticket 955 & 956
  • Property svn:keywords set to Id
File size: 15.5 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   ! local 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         )   CALL cor_c1d      ! 1D configuration: Coriolis set at T-point
89      !
90      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points
91      hv(:,:) = 0._wp
92      DO jk = 1, jpk
93         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
94         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
95      END DO
96      !                                        ! Inverse of the local depth
97      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
98      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
99
100                             CALL dom_stp      ! time step
101      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
102      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
103      !
104      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
105      !
106   END SUBROUTINE dom_init
107
108
109   SUBROUTINE dom_nam
110      !!----------------------------------------------------------------------
111      !!                     ***  ROUTINE dom_nam  ***
112      !!                   
113      !! ** Purpose :   read domaine namelists and print the variables.
114      !!
115      !! ** input   : - namrun namelist
116      !!              - namdom namelist
117      !!              - namcla namelist
118      !!              - namnc4 namelist   ! "key_netcdf4" only
119      !!----------------------------------------------------------------------
120      USE ioipsl
121      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
122         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
123         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
124      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
125         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
126         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
127      NAMELIST/namcla/ nn_cla
128#if defined key_netcdf4
129      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
130#endif
131      !!----------------------------------------------------------------------
132
133      REWIND( numnam )              ! Namelist namrun : parameters of the run
134      READ  ( numnam, namrun )
135      !
136      IF(lwp) THEN                  ! control print
137         WRITE(numout,*)
138         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
139         WRITE(numout,*) '~~~~~~~ '
140         WRITE(numout,*) '   Namelist namrun'
141         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
142         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
143         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
144         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
145         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
146         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
147         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
148         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
149         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
150         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
151         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
152         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
153         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
154         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
155         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
156      ENDIF
157
158      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
159      cexper = cn_exp
160      nrstdt = nn_rstctl
161      nit000 = nn_it000
162      nitend = nn_itend
163      ndate0 = nn_date0
164      nleapy = nn_leapy
165      ninist = nn_istate
166      nstock = nn_stock
167      nwrite = nn_write
168
169
170      !                             ! control of output frequency
171      IF ( nstock == 0 .OR. nstock > nitend ) THEN
172         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
173         CALL ctl_warn( ctmp1 )
174         nstock = nitend
175      ENDIF
176      IF ( nwrite == 0 ) THEN
177         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
178         CALL ctl_warn( ctmp1 )
179         nwrite = nitend
180      ENDIF
181
182#if defined key_agrif
183      IF( Agrif_Root() ) THEN
184#endif
185      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
186      CASE (  1 ) 
187         CALL ioconf_calendar('gregorian')
188         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
189      CASE (  0 )
190         CALL ioconf_calendar('noleap')
191         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
192      CASE ( 30 )
193         CALL ioconf_calendar('360d')
194         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
195      END SELECT
196#if defined key_agrif
197      ENDIF
198#endif
199
200      REWIND( numnam )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
201      READ  ( numnam, namdom )
202
203      IF(lwp) THEN
204         WRITE(numout,*)
205         WRITE(numout,*) '   Namelist namdom : space & time domain'
206         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
207         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
208         WRITE(numout,*) '      min number of ocean level (<0)       '
209         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
210         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
211         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
212         WRITE(numout,*) '           = 0   no file created           '
213         WRITE(numout,*) '           = 1   mesh_mask                 '
214         WRITE(numout,*) '           = 2   mesh and mask             '
215         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
216         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
217         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
218         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
219         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
220         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
221         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
222         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
223         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
224      ENDIF
225
226      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
227      e3zps_min = rn_e3zps_min
228      e3zps_rat = rn_e3zps_rat
229      nmsh      = nn_msh
230      nacc      = nn_acc
231      atfp      = rn_atfp
232      rdt       = rn_rdt
233      rdtmin    = rn_rdtmin
234      rdtmax    = rn_rdtmin
235      rdth      = rn_rdth
236
237      REWIND( numnam )              ! Namelist cross land advection
238      READ  ( numnam, namcla )
239      IF(lwp) THEN
240         WRITE(numout,*)
241         WRITE(numout,*) '   Namelist namcla'
242         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
243      ENDIF
244
245#if defined key_netcdf4
246      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
247      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
248      READ  ( numnam, namnc4 )
249      IF(lwp) THEN                        ! control print
250         WRITE(numout,*)
251         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
252         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
253         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
254         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
255         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
256      ENDIF
257
258      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
259      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
260      snc4set%ni   = nn_nchunks_i
261      snc4set%nj   = nn_nchunks_j
262      snc4set%nk   = nn_nchunks_k
263      snc4set%luse = ln_nc4zip
264#else
265      snc4set%luse = .FALSE.        ! No NetCDF 4 case
266#endif
267      !
268   END SUBROUTINE dom_nam
269
270
271   SUBROUTINE dom_ctl
272      !!----------------------------------------------------------------------
273      !!                     ***  ROUTINE dom_ctl  ***
274      !!
275      !! ** Purpose :   Domain control.
276      !!
277      !! ** Method  :   compute and print extrema of masked scale factors
278      !!----------------------------------------------------------------------
279      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
280      INTEGER, DIMENSION(2) ::   iloc   !
281      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
282      !!----------------------------------------------------------------------
283      !
284      IF(lk_mpp) THEN
285         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
286         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
287         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
288         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
289      ELSE
290         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1._wp )   
291         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1._wp )   
292         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1._wp )   
293         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1._wp )   
294
295         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1._wp )
296         iimi1 = iloc(1) + nimpp - 1
297         ijmi1 = iloc(2) + njmpp - 1
298         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1._wp )
299         iimi2 = iloc(1) + nimpp - 1
300         ijmi2 = iloc(2) + njmpp - 1
301         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1._wp )
302         iima1 = iloc(1) + nimpp - 1
303         ijma1 = iloc(2) + njmpp - 1
304         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1._wp )
305         iima2 = iloc(1) + nimpp - 1
306         ijma2 = iloc(2) + njmpp - 1
307      ENDIF
308      IF(lwp) THEN
309         WRITE(numout,*)
310         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
311         WRITE(numout,*) '~~~~~~~'
312         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
313         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
314         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
315         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
316      ENDIF
317      !
318   END SUBROUTINE dom_ctl
319
320   !!======================================================================
321END MODULE domain
Note: See TracBrowser for help on using the repository browser.