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

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

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