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

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

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