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 @ 2435

Last change on this file since 2435 was 2435, checked in by cetlod, 13 years ago

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