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 tags/nemo_v3_2_beta/NEMO/OPA_SRC/DOM – NEMO

source: tags/nemo_v3_2_beta/NEMO/OPA_SRC/DOM/domain.F90 @ 8191

Last change on this file since 8191 was 1604, checked in by ctlod, 15 years ago

Doctor naming of OPA namelist variables, see ticket: #526
  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 14.4 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   !!----------------------------------------------------------------------
14   
15   !!----------------------------------------------------------------------
16   !!   dom_init       : initialize the space and time domain
17   !!   dom_nam        : read and contral domain namelists
18   !!   dom_ctl        : control print for the ocean domain
19   !!----------------------------------------------------------------------
20   USE oce             !
21   USE dom_oce         ! ocean space and time domain
22   USE sbc_oce         ! surface boundary condition: ocean
23   USE phycst          ! physical constants
24   USE closea          ! closed seas
25   USE in_out_manager  ! I/O manager
26   USE lib_mpp         ! distributed memory computing library
27
28   USE domhgr          ! domain: set the horizontal mesh
29   USE domzgr          ! domain: set the vertical mesh
30   USE domstp          ! domain: set the time-step
31   USE dommsk          ! domain: set the mask system
32   USE domwri          ! domain: write the meshmask file
33   USE domvvl          ! variable volume
34
35   IMPLICIT NONE
36   PRIVATE
37
38   PUBLIC   dom_init   ! called by opa.F90
39
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!-------------------------------------------------------------------------
43   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
44   !! $Id$
45   !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
46   !!-------------------------------------------------------------------------
47
48CONTAINS
49
50   SUBROUTINE dom_init
51      !!----------------------------------------------------------------------
52      !!                  ***  ROUTINE dom_init  ***
53      !!                   
54      !! ** Purpose :   Domain initialization. Call the routines that are
55      !!              required to create the arrays which define the space
56      !!              and time domain of the ocean model.
57      !!
58      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
59      !!              - dom_hgr: compute or read the horizontal grid-point position
60      !!                         and scale factors, and the coriolis factor
61      !!              - dom_zgr: define the vertical coordinate and the bathymetry
62      !!              - dom_stp: defined the model time step
63      !!              - dom_wri: create the meshmask file if nmsh=1
64      !!----------------------------------------------------------------------
65      INTEGER ::   jk                ! dummy loop argument
66      INTEGER ::   iconf = 0         ! temporary integers
67      !!----------------------------------------------------------------------
68      !
69      IF(lwp) THEN
70         WRITE(numout,*)
71         WRITE(numout,*) 'dom_init : domain initialization'
72         WRITE(numout,*) '~~~~~~~~'
73      ENDIF
74      !
75                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
76                             CALL dom_clo      ! Closed seas and lake
77                             CALL dom_hgr      ! Horizontal mesh
78                             CALL dom_zgr      ! Vertical mesh and bathymetry
79                             CALL dom_msk      ! Masks
80      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
81      !
82      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
83      hv(:,:) = 0.e0
84      DO jk = 1, jpk
85         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
86         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
87      END DO
88      !                                        ! Inverse of the local depth
89      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
90      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
91
92                             CALL dom_stp      ! time step
93      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
94      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
95      !
96   END SUBROUTINE dom_init
97
98
99   SUBROUTINE dom_nam
100      !!----------------------------------------------------------------------
101      !!                     ***  ROUTINE dom_nam  ***
102      !!                   
103      !! ** Purpose :   read domaine namelists and print the variables.
104      !!
105      !! ** input   : - namrun namelist
106      !!              - namdom namelist
107      !!              - namcla namelist
108      !!----------------------------------------------------------------------
109      USE ioipsl
110      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
111         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
112         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
113      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh   ,   &
114         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin,   &
115         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
116      NAMELIST/namcla/ nn_cla
117      !!----------------------------------------------------------------------
118
119      REWIND( numnam )              ! Namelist namrun : parameters of the run
120      READ  ( numnam, namrun )
121      !
122      IF(lwp) THEN                  ! control print
123         WRITE(numout,*)
124         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
125         WRITE(numout,*) '~~~~~~~ '
126         WRITE(numout,*) '   Namelist namrun'
127         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
128         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
129         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
130         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
131         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
132         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
133         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
134         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
135         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
136         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
137         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
138         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
139         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
140         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
141         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
142      ENDIF
143
144      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
145      cexper = cn_exp
146      nrstdt = nn_rstctl
147      nit000 = nn_it000
148      nitend = nn_itend
149      ndate0 = nn_date0
150      nleapy = nn_leapy
151      ninist = nn_istate
152      nstock = nn_stock
153      nwrite = nn_write
154
155
156      !                             ! control of output frequency
157      IF ( nstock == 0 .OR. nstock > nitend ) THEN
158         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
159         CALL ctl_warn( ctmp1 )
160         nstock = nitend
161      ENDIF
162      IF ( nwrite == 0 ) THEN
163         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
164         CALL ctl_warn( ctmp1 )
165         nwrite = nitend
166      ENDIF
167
168#if defined key_agrif
169      IF( Agrif_Root() ) THEN
170#endif
171      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
172      CASE (  1 ) 
173         CALL ioconf_calendar('gregorian')
174         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
175      CASE (  0 )
176         CALL ioconf_calendar('noleap')
177         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
178      CASE ( 30 )
179         CALL ioconf_calendar('360d')
180         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
181      END SELECT
182#if defined key_agrif
183      ENDIF
184#endif
185
186      SELECT CASE ( nleapy )       ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
187      CASE ( 1 )
188         raajj = 365.25
189         raass = raajj * rjjss
190         rmoss = raass/raamo
191      CASE ( 0 )
192         raajj = 365.
193         raass = raajj * rjjss
194         rmoss = raass/raamo
195      CASE DEFAULT
196         raajj = FLOAT( nleapy ) * raamo
197         raass =        raajj    * rjjss
198         rmoss = FLOAT( nleapy ) * rjjss
199      END SELECT
200      IF(lwp) THEN
201         WRITE(numout,*)
202         WRITE(numout,*) '   nb of days per year      raajj = ', raajj,' days'
203         WRITE(numout,*) '   nb of seconds per year   raass = ', raass, ' s'
204         WRITE(numout,*) '   nb of seconds per month  rmoss = ', rmoss, ' s'
205      ENDIF
206
207      REWIND( numnam )             ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
208      READ  ( numnam, namdom )
209
210      IF(lwp) THEN
211         WRITE(numout,*)
212         WRITE(numout,*) '   Namelist namdom : space & time domain'
213         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
214         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
215         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
216         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
217         WRITE(numout,*) '           = 0   no file created                 '
218         WRITE(numout,*) '           = 1   mesh_mask                       '
219         WRITE(numout,*) '           = 2   mesh and mask                   '
220         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
221         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
222         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
223         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
224         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
225         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
226         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
227         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
228         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
229      ENDIF
230
231      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
232      e3zps_min = rn_e3zps_min
233      e3zps_rat = rn_e3zps_rat
234      nmsh      = nn_msh
235      nacc      = nn_acc
236      atfp      = rn_atfp
237      rdt       = rn_rdt
238      rdtmin    = rn_rdtmin
239      rdtmax    = rn_rdtmin
240      rdth      = rn_rdth
241      nclosea   = nn_closea
242
243      REWIND( numnam )             ! Namelist cross land advection
244      READ  ( numnam, namcla )
245      IF(lwp) THEN
246         WRITE(numout,*)
247         WRITE(numout,*) '   Namelist namcla'
248         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
249      ENDIF
250
251      n_cla = nn_cla                ! conversion DOCTOR names into model names (this should disappear soon)
252
253      IF( nbit_cmp == 1 .AND. n_cla /= 0 )   CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
254      !
255   END SUBROUTINE dom_nam
256
257
258   SUBROUTINE dom_ctl
259      !!----------------------------------------------------------------------
260      !!                     ***  ROUTINE dom_ctl  ***
261      !!
262      !! ** Purpose :   Domain control.
263      !!
264      !! ** Method  :   compute and print extrema of masked scale factors
265      !!----------------------------------------------------------------------
266      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
267      INTEGER, DIMENSION(2) ::   iloc   !
268      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
269      !!----------------------------------------------------------------------
270      !
271      IF(lk_mpp) THEN
272         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
273         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
274         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
275         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
276      ELSE
277         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
278         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
279         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
280         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
281
282         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
283         iimi1 = iloc(1) + nimpp - 1
284         ijmi1 = iloc(2) + njmpp - 1
285         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
286         iimi2 = iloc(1) + nimpp - 1
287         ijmi2 = iloc(2) + njmpp - 1
288         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
289         iima1 = iloc(1) + nimpp - 1
290         ijma1 = iloc(2) + njmpp - 1
291         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
292         iima2 = iloc(1) + nimpp - 1
293         ijma2 = iloc(2) + njmpp - 1
294      ENDIF
295      IF(lwp) THEN
296         WRITE(numout,*)
297         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
298         WRITE(numout,*) '~~~~~~~'
299         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
300         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
301         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
302         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
303      ENDIF
304      !
305   END SUBROUTINE dom_ctl
306
307   !!======================================================================
308END MODULE domain
Note: See TracBrowser for help on using the repository browser.