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

source: branches/2011/dev_r2739_LOCEAN8_ZTC/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 3839

Last change on this file since 3839 was 2974, checked in by mlelod, 13 years ago

lateral tracer diffusion: coding slightly modified. see ticket/863?
  • Property svn:keywords set to Id
File size: 16.0 KB
Line 
1
2MODULE domain
3   !!==============================================================================
4   !!                       ***  MODULE domain   ***
5   !! Ocean initialization : domain initialization
6   !!==============================================================================
7   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
8   !!                 !  1992-01  (M. Imbard) insert time step initialization
9   !!                 !  1996-06  (G. Madec) generalized vertical coordinate
10   !!                 !  1997-02  (G. Madec) creation of domwri.F
11   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
12   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
13   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
14   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
15   !!----------------------------------------------------------------------
16   
17   !!----------------------------------------------------------------------
18   !!   dom_init       : initialize the space and time domain
19   !!   dom_nam        : read and contral domain namelists
20   !!   dom_ctl        : control print for the ocean domain
21   !!----------------------------------------------------------------------
22   USE oce             ! ocean variables
23   USE dom_oce         ! domain: ocean
24   USE sbc_oce         ! surface boundary condition: ocean
25   USE phycst          ! physical constants
26   USE closea          ! closed seas
27   USE in_out_manager  ! I/O manager
28   USE lib_mpp         ! distributed memory computing library
29
30   USE domhgr          ! domain: set the horizontal mesh
31   USE domzgr          ! domain: set the vertical mesh
32   USE domstp          ! domain: set the time-step
33   USE dommsk          ! domain: set the mask system
34   USE domwri          ! domain: write the meshmask file
35   USE domvvl          ! variable volume
36   USE c1d             ! 1D vertical configuration
37   USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
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(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_init ! Vertical variable mesh
85      !
86      IF( lk_c1d ) THEN                        ! 1D configuration
87         CALL cor_c1d                          ! Coriolis set at T-point
88         umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point
89         vmask(:,:,:) = tmask(:,:,:)
90      END IF
91      !
92      ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines
93      !        but could be usefull in many other routines
94      e12t  (:,:) = e1t(:,:) * e2t(:,:)
95      e12u  (:,:) = e1u(:,:) * e2u(:,:)
96      e12v  (:,:) = e1v(:,:) * e2v(:,:)
97      e12f  (:,:) = e1f(:,:) * e2f(:,:)
98      e12t_1(:,:) = 1. / e12t(:,:)
99      e12u_1(:,:) = 1. / e12u(:,:)
100      e12v_1(:,:) = 1. / e12v(:,:)
101      e12f_1(:,:) = 1. / e12f(:,:)
102      e2_1u (:,:) = e2u(:,:) / e1u(:,:)
103      e1_2v (:,:) = e1v(:,:) / e2v(:,:)
104      !
105      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
106      hv(:,:) = 0.e0
107      DO jk = 1, jpk
108         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
109         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
110      END DO
111      !                                        ! Inverse of the local depth
112      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
113      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
114
115                             CALL dom_stp      ! time step
116      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
117      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
118      !
119   END SUBROUTINE dom_init
120
121
122   SUBROUTINE dom_nam
123      !!----------------------------------------------------------------------
124      !!                     ***  ROUTINE dom_nam  ***
125      !!                   
126      !! ** Purpose :   read domaine namelists and print the variables.
127      !!
128      !! ** input   : - namrun namelist
129      !!              - namdom namelist
130      !!              - namcla namelist
131      !!              - namnc4 namelist   ! "key_netcdf4" only
132      !!----------------------------------------------------------------------
133      USE ioipsl
134      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
135         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
136         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
137      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
138         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
139         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
140      NAMELIST/namcla/ nn_cla
141#if defined key_netcdf4
142      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
143#endif
144      !!----------------------------------------------------------------------
145
146      REWIND( numnam )              ! Namelist namrun : parameters of the run
147      READ  ( numnam, namrun )
148      !
149      IF(lwp) THEN                  ! control print
150         WRITE(numout,*)
151         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
152         WRITE(numout,*) '~~~~~~~ '
153         WRITE(numout,*) '   Namelist namrun'
154         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
155         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
156         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
157         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
158         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
159         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
160         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
161         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
162         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
163         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
164         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
165         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
166         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
167         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
168         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
169      ENDIF
170
171      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
172      cexper = cn_exp
173      nrstdt = nn_rstctl
174      nit000 = nn_it000
175      nitend = nn_itend
176      ndate0 = nn_date0
177      nleapy = nn_leapy
178      ninist = nn_istate
179      nstock = nn_stock
180      nwrite = nn_write
181
182
183      !                             ! control of output frequency
184      IF ( nstock == 0 .OR. nstock > nitend ) THEN
185         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
186         CALL ctl_warn( ctmp1 )
187         nstock = nitend
188      ENDIF
189      IF ( nwrite == 0 ) THEN
190         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
191         CALL ctl_warn( ctmp1 )
192         nwrite = nitend
193      ENDIF
194
195#if defined key_agrif
196      IF( Agrif_Root() ) THEN
197#endif
198      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
199      CASE (  1 ) 
200         CALL ioconf_calendar('gregorian')
201         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
202      CASE (  0 )
203         CALL ioconf_calendar('noleap')
204         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
205      CASE ( 30 )
206         CALL ioconf_calendar('360d')
207         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
208      END SELECT
209#if defined key_agrif
210      ENDIF
211#endif
212
213      REWIND( numnam )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
214      READ  ( numnam, namdom )
215
216      IF(lwp) THEN
217         WRITE(numout,*)
218         WRITE(numout,*) '   Namelist namdom : space & time domain'
219         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
220         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
221         WRITE(numout,*) '      min number of ocean level (<0)       '
222         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
223         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
224         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
225         WRITE(numout,*) '           = 0   no file created           '
226         WRITE(numout,*) '           = 1   mesh_mask                 '
227         WRITE(numout,*) '           = 2   mesh and mask             '
228         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
229         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
230         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
231         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
232         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
233         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
234         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
235         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
236         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
237      ENDIF
238
239      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
240      e3zps_min = rn_e3zps_min
241      e3zps_rat = rn_e3zps_rat
242      nmsh      = nn_msh
243      nacc      = nn_acc
244      atfp      = rn_atfp
245      rdt       = rn_rdt
246      rdtmin    = rn_rdtmin
247      rdtmax    = rn_rdtmin
248      rdth      = rn_rdth
249      nclosea   = nn_closea
250
251      REWIND( numnam )              ! Namelist cross land advection
252      READ  ( numnam, namcla )
253      IF(lwp) THEN
254         WRITE(numout,*)
255         WRITE(numout,*) '   Namelist namcla'
256         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
257      ENDIF
258
259#if defined key_netcdf4
260      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
261      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
262      READ  ( numnam, namnc4 )
263      IF(lwp) THEN                        ! control print
264         WRITE(numout,*)
265         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
266         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
267         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
268         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
269         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
270      ENDIF
271
272      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
273      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
274      snc4set%ni   = nn_nchunks_i
275      snc4set%nj   = nn_nchunks_j
276      snc4set%nk   = nn_nchunks_k
277      snc4set%luse = ln_nc4zip
278#else
279      snc4set%luse = .FALSE.        ! No NetCDF 4 case
280#endif
281      !
282   END SUBROUTINE dom_nam
283
284
285   SUBROUTINE dom_ctl
286      !!----------------------------------------------------------------------
287      !!                     ***  ROUTINE dom_ctl  ***
288      !!
289      !! ** Purpose :   Domain control.
290      !!
291      !! ** Method  :   compute and print extrema of masked scale factors
292      !!----------------------------------------------------------------------
293      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
294      INTEGER, DIMENSION(2) ::   iloc   !
295      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
296      !!----------------------------------------------------------------------
297      !
298      IF(lk_mpp) THEN
299         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
300         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
301         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
302         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
303      ELSE
304         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
305         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
306         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
307         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
308
309         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
310         iimi1 = iloc(1) + nimpp - 1
311         ijmi1 = iloc(2) + njmpp - 1
312         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
313         iimi2 = iloc(1) + nimpp - 1
314         ijmi2 = iloc(2) + njmpp - 1
315         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
316         iima1 = iloc(1) + nimpp - 1
317         ijma1 = iloc(2) + njmpp - 1
318         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
319         iima2 = iloc(1) + nimpp - 1
320         ijma2 = iloc(2) + njmpp - 1
321      ENDIF
322      IF(lwp) THEN
323         WRITE(numout,*)
324         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
325         WRITE(numout,*) '~~~~~~~'
326         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
327         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
328         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
329         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
330      ENDIF
331      !
332   END SUBROUTINE dom_ctl
333
334   !!======================================================================
335END MODULE domain
Note: See TracBrowser for help on using the repository browser.