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

source: branches/2011/dev_r2769_LOCEAN_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 2775

Last change on this file since 2775 was 2528, checked in by rblod, 13 years ago

Update NEMOGCM from branch nemo_v3_3_beta
  • 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
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    , rn_hmin,   &
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,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
207         WRITE(numout,*) '      min number of ocean level (<0)       '
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#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.e0 )   
291         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
292         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
293         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
294
295         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
296         iimi1 = iloc(1) + nimpp - 1
297         ijmi1 = iloc(2) + njmpp - 1
298         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
299         iimi2 = iloc(1) + nimpp - 1
300         ijmi2 = iloc(2) + njmpp - 1
301         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
302         iima1 = iloc(1) + nimpp - 1
303         ijma1 = iloc(2) + njmpp - 1
304         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
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.