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

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 2382

Last change on this file since 2382 was 2382, checked in by gm, 13 years ago

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