source: vendor/nemo/current/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 4

Last change on this file since 4 was 4, checked in by cholod, 12 years ago

Load NEMO_TMP into vendor/nemo/current.
File size: 15.7 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   USE timing          ! Timing
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: domain.F90 3294 2012-01-28 16:44:18Z rblod $
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( nn_timing == 1 )  CALL timing_start('dom_init')
74      !
75      IF(lwp) THEN
76         WRITE(numout,*)
77         WRITE(numout,*) 'dom_init : domain initialization'
78         WRITE(numout,*) '~~~~~~~~'
79      ENDIF
80      !
81                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
82                             CALL dom_clo      ! Closed seas and lake
83                             CALL dom_hgr      ! Horizontal mesh
84                             CALL dom_zgr      ! Vertical mesh and bathymetry
85                             CALL dom_msk      ! Masks
86      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
87      !
88      IF( lk_c1d ) THEN                        ! 1D configuration
89         CALL cor_c1d                          ! Coriolis set at T-point
90         umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point
91         vmask(:,:,:) = tmask(:,:,:)
92      END IF
93      !
94      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
95      hv(:,:) = 0.e0
96      DO jk = 1, jpk
97         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
98         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
99      END DO
100      !                                        ! Inverse of the local depth
101      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
102      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
103
104                             CALL dom_stp      ! time step
105      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
106      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
107      !
108      IF( nn_timing == 1 )  CALL timing_stop('dom_init')
109      !
110   END SUBROUTINE dom_init
111
112
113   SUBROUTINE dom_nam
114      !!----------------------------------------------------------------------
115      !!                     ***  ROUTINE dom_nam  ***
116      !!                   
117      !! ** Purpose :   read domaine namelists and print the variables.
118      !!
119      !! ** input   : - namrun namelist
120      !!              - namdom namelist
121      !!              - namcla namelist
122      !!              - namnc4 namelist   ! "key_netcdf4" only
123      !!----------------------------------------------------------------------
124      USE ioipsl
125      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
126         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
127         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
128      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
129         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
130         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
131      NAMELIST/namcla/ nn_cla
132#if defined key_netcdf4
133      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
134#endif
135      !!----------------------------------------------------------------------
136
137      REWIND( numnam )              ! Namelist namrun : parameters of the run
138      READ  ( numnam, namrun )
139      !
140      IF(lwp) THEN                  ! control print
141         WRITE(numout,*)
142         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
143         WRITE(numout,*) '~~~~~~~ '
144         WRITE(numout,*) '   Namelist namrun'
145         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
146         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
147         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
148         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
149         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
150         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
151         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
152         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
153         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
154         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
155         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
156         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
157         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
158         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
159         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
160      ENDIF
161
162      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
163      cexper = cn_exp
164      nrstdt = nn_rstctl
165      nit000 = nn_it000
166      nitend = nn_itend
167      ndate0 = nn_date0
168      nleapy = nn_leapy
169      ninist = nn_istate
170      nstock = nn_stock
171      nwrite = nn_write
172
173
174      !                             ! control of output frequency
175      IF ( nstock == 0 .OR. nstock > nitend ) THEN
176         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
177         CALL ctl_warn( ctmp1 )
178         nstock = nitend
179      ENDIF
180      IF ( nwrite == 0 ) THEN
181         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
182         CALL ctl_warn( ctmp1 )
183         nwrite = nitend
184      ENDIF
185
186#if defined key_agrif
187      IF( Agrif_Root() ) THEN
188#endif
189      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
190      CASE (  1 ) 
191         CALL ioconf_calendar('gregorian')
192         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
193      CASE (  0 )
194         CALL ioconf_calendar('noleap')
195         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
196      CASE ( 30 )
197         CALL ioconf_calendar('360d')
198         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
199      END SELECT
200#if defined key_agrif
201      ENDIF
202#endif
203
204      REWIND( numnam )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
205      READ  ( numnam, namdom )
206
207      IF(lwp) THEN
208         WRITE(numout,*)
209         WRITE(numout,*) '   Namelist namdom : space & time domain'
210         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
211         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
212         WRITE(numout,*) '      min number of ocean level (<0)       '
213         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
214         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
215         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
216         WRITE(numout,*) '           = 0   no file created           '
217         WRITE(numout,*) '           = 1   mesh_mask                 '
218         WRITE(numout,*) '           = 2   mesh and mask             '
219         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
220         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
221         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
222         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
223         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
224         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
225         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
226         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
227         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
228      ENDIF
229
230      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
231      e3zps_min = rn_e3zps_min
232      e3zps_rat = rn_e3zps_rat
233      nmsh      = nn_msh
234      nacc      = nn_acc
235      atfp      = rn_atfp
236      rdt       = rn_rdt
237      rdtmin    = rn_rdtmin
238      rdtmax    = rn_rdtmin
239      rdth      = rn_rdth
240      nclosea   = nn_closea
241
242      REWIND( numnam )              ! Namelist cross land advection
243      READ  ( numnam, namcla )
244      IF(lwp) THEN
245         WRITE(numout,*)
246         WRITE(numout,*) '   Namelist namcla'
247         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
248      ENDIF
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.