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/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC – NEMO

source: branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/domain.F90 @ 2053

Last change on this file since 2053 was 2053, checked in by cetlod, 14 years ago

improve the offline part to take into account the merge of TRA-TRC, see ticket:702

File size: 16.7 KB
Line 
1MODULE domain
2   !!==============================================================================
3   !!                       ***  MODULE domain   ***
4   !! Ocean initialization : domain initialization
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dom_init       : initialize the space and time domain
9   !!   dom_nam        : read and contral domain namelists
10   !!   dom_ctl        : control print for the ocean domain
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE oce             !
14   USE dom_oce         ! ocean space and time domain
15   USE phycst          ! physical constants
16   USE in_out_manager  ! I/O manager
17   USE lib_mpp         ! distributed memory computing library
18
19   USE domstp          ! domain: set the time-step
20   USE domrea          ! domain: write the meshmask file
21   USE dommsk          ! domain : mask
22
23   IMPLICIT NONE
24   PRIVATE
25
26   !! * Routine accessibility
27   PUBLIC dom_init       ! called by opa.F90
28
29   !                                    !!! ** Namelist namzgr_sco **
30   REAL(wp) ::   rn_sbot_min =  300.     ! minimum depth of s-bottom surface (>0) (m)
31   REAL(wp) ::   rn_sbot_max = 5250.     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
32   REAL(wp) ::   rn_theta    =    6.0    ! surface control parameter (0<=rn_theta<=20)
33   REAL(wp) ::   rn_thetb    =    0.75   ! bottom control parameter  (0<=rn_thetb<= 1)
34   REAL(wp) ::   rn_rmax     =    0.15   ! maximum cut-off r-value allowed (0<rn_rmax<1)
35   LOGICAL  ::   ln_s_sigma  = .false.   ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T)
36   REAL(wp) ::   rn_bb       =    0.8    ! stretching parameter for song and haidvogel stretching
37   !                                     ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
38   REAL(wp) ::   rn_hc       = 150.      ! Critical depth for s-sigma coordinates
39
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!----------------------------------------------------------------------
43   !!   OPA 9.0 , LOCEAN-IPSL  (2005)
44   !!   $Id: domain.F90 1748 2009-11-23 10:51:20Z cetlod $
45   !!   This software is governed by the CeCILL licence see 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 and time
56      !!      domain of the ocean model.
57      !!
58      !! ** Method  :
59      !!      - dom_stp: defined the model time step
60      !!      - dom_rea: read the meshmask file if nmsh=1
61      !!
62      !! History :
63      !!        !  90-10  (C. Levy - G. Madec)  Original code
64      !!        !  91-11  (G. Madec)
65      !!        !  92-01  (M. Imbard) insert time step initialization
66      !!        !  96-06  (G. Madec) generalized vertical coordinate
67      !!        !  97-02  (G. Madec) creation of domwri.F
68      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
69      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
70      !!----------------------------------------------------------------------
71      !! * Local declarations
72      INTEGER ::   iconf = 0         ! temporary integers
73      !!----------------------------------------------------------------------
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_zgr      ! Vertical mesh and bathymetry option
83      CALL dom_rea      ! Create a domain file
84      CALL dom_stp      ! Time step
85      CALL dom_msk      ! Masks
86      CALL dom_ctl      ! Domain control
87
88   END SUBROUTINE dom_init
89
90   SUBROUTINE dom_nam
91      !!----------------------------------------------------------------------
92      !!                     ***  ROUTINE dom_nam  ***
93      !!                   
94      !! ** Purpose :   read domaine namelists and print the variables.
95      !!
96      !! ** input   : - namrun namelist
97      !!              - namdom namelist
98      !!              - namcla namelist
99      !!----------------------------------------------------------------------
100      USE ioipsl
101      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
102         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
103         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
104      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh   ,   &
105         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin,   &
106         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
107      NAMELIST/namcla/ nn_cla
108      !!----------------------------------------------------------------------
109
110      REWIND( numnam )              ! Namelist namrun : parameters of the run
111      READ  ( numnam, namrun )
112      !
113      IF(lwp) THEN                  ! control print
114         WRITE(numout,*)
115         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
116         WRITE(numout,*) '~~~~~~~ '
117         WRITE(numout,*) '   Namelist namrun' 
118         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
119         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
120         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
121         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
122         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
123         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
124         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
125         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
126         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
127         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
128         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
129         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
130         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
131         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
132         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
133      ENDIF
134      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
135      cexper = cn_exp
136      nrstdt = nn_rstctl
137      nit000 = nn_it000
138      nitend = nn_itend
139      ndate0 = nn_date0
140      nleapy = nn_leapy
141      ninist = nn_istate
142      nstock = nn_stock
143      nwrite = nn_write
144
145
146      !                             ! control of output frequency
147      IF ( nstock == 0 .OR. nstock > nitend ) THEN
148         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
149         CALL ctl_warn( ctmp1 )
150         nstock = nitend
151      ENDIF
152      IF ( nwrite == 0 ) THEN
153         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
154         CALL ctl_warn( ctmp1 )
155         nwrite = nitend
156      ENDIF
157
158      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
159      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
160      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
161
162#if defined key_agrif
163      IF( Agrif_Root() ) THEN
164#endif
165      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
166      CASE (  1 ) 
167         CALL ioconf_calendar('gregorian')
168         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
169      CASE (  0 )
170         CALL ioconf_calendar('noleap')
171         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
172      CASE ( 30 )
173         CALL ioconf_calendar('360d')
174         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
175      END SELECT
176#if defined key_agrif
177      ENDIF
178#endif
179
180      REWIND( numnam )             ! Domain
181      READ  ( numnam, namdom )
182
183      IF(lwp) THEN
184         WRITE(numout,*) 
185         WRITE(numout,*) '   Namelist namdom : space & time domain'
186         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
187         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
188         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
189         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
190         WRITE(numout,*) '           = 0   no file created                 '
191         WRITE(numout,*) '           = 1   mesh_mask                       '
192         WRITE(numout,*) '           = 2   mesh and mask                   '
193         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
194         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
195         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
196         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
197         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
198         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
199         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
200         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
201         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
202      ENDIF
203
204      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
205      e3zps_min = rn_e3zps_min
206      e3zps_rat = rn_e3zps_rat
207      nmsh      = nn_msh
208      nacc      = nn_acc
209      atfp      = rn_atfp
210      rdt       = rn_rdt
211      rdtmin    = rn_rdtmin
212      rdtmax    = rn_rdtmin
213      rdth      = rn_rdth
214      nclosea   = nn_closea
215
216      REWIND( numnam )             ! Namelist cross land advection
217      READ  ( numnam, namcla )
218      IF(lwp) THEN
219         WRITE(numout,*)
220         WRITE(numout,*) '   Namelist namcla'
221         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
222      ENDIF
223
224      n_cla = nn_cla                ! conversion DOCTOR names into model names (this should disappear soon)
225
226      IF( lk_mpp_rep .AND. n_cla /= 0 )   CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
227      !
228   END SUBROUTINE dom_nam
229
230   SUBROUTINE dom_zgr
231      !!----------------------------------------------------------------------
232      !!                ***  ROUTINE dom_zgr  ***
233      !!                   
234      !! ** Purpose :  set the depth of model levels and the resulting
235      !!      vertical scale factors.
236      !!
237      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0)
238      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
239      !!              - vertical coordinate (gdep., e3.) depending on the
240      !!                coordinate chosen :
241      !!                   ln_zco=T   z-coordinate   (forced if lk_zco)
242      !!                   ln_zps=T   z-coordinate with partial steps
243      !!                   ln_zco=T   s-coordinate
244      !!
245      !! ** Action  :   define gdep., e3., mbathy and bathy
246      !!----------------------------------------------------------------------
247      INTEGER ::   ioptio = 0   ! temporary integer
248      !!
249      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
250      !!----------------------------------------------------------------------
251
252      REWIND ( numnam )                ! Read Namelist namzgr : vertical coordinate'
253      READ   ( numnam, namzgr )
254
255      IF(lwp) THEN                     ! Control print
256         WRITE(numout,*)
257         WRITE(numout,*) 'dom_zgr : vertical coordinate'
258         WRITE(numout,*) '~~~~~~~'
259         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
260         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
261         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
262         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
263      ENDIF
264
265      ioptio = 0                       ! Check Vertical coordinate options
266      IF( ln_zco ) ioptio = ioptio + 1
267      IF( ln_zps ) ioptio = ioptio + 1
268      IF( ln_sco ) ioptio = ioptio + 1
269      IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
270      IF( lk_zco ) THEN
271          IF(lwp) WRITE(numout,*) '          z-coordinate with reduced incore memory requirement'
272          IF( ln_zps .OR. ln_sco )   CALL ctl_stop( ' reduced memory with zps or sco option is impossible' )
273      ENDIF
274
275      IF( nprint == 1 .AND. lwp )   THEN
276         WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
277         WRITE(numout,*) ' MIN val depth t ', MINVAL( fsdept(:,:,:) ),   &
278            &                   ' w ',   MINVAL( fsdepw(:,:,:) ), '3w ', MINVAL( fsde3w(:,:,:) )
279         WRITE(numout,*) ' MIN val e3    t ', MINVAL( fse3t(:,:,:) ), ' f ', MINVAL( fse3f(:,:,:) ),  &
280            &                   ' u ',   MINVAL( fse3u(:,:,:) ), ' u ', MINVAL( fse3v(:,:,:) ),  &
281            &                   ' w ',   MINVAL( fse3w(:,:,:) )
282
283         WRITE(numout,*) ' MAX val depth t ', MAXVAL( fsdept(:,:,:) ),   &
284            &                   ' w ',   MAXVAL( fsdepw(:,:,:) ), '3w ', MAXVAL( fsde3w(:,:,:) )
285         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( fse3t(:,:,:) ), ' f ', MAXVAL( fse3f(:,:,:) ),  &
286            &                   ' u ',   MAXVAL( fse3u(:,:,:) ), ' u ', MAXVAL( fse3v(:,:,:) ),  &
287            &                   ' w ',   MAXVAL( fse3w(:,:,:) )
288      ENDIF
289
290   END SUBROUTINE dom_zgr
291
292   SUBROUTINE dom_ctl
293      !!----------------------------------------------------------------------
294      !!                     ***  ROUTINE dom_ctl  ***
295      !!
296      !! ** Purpose :   Domain control.
297      !!
298      !! ** Method  :   compute and print extrema of masked scale factors
299      !!
300      !! History :
301      !!   8.5  !  02-08  (G. Madec)    Original code
302      !!----------------------------------------------------------------------
303      !! * Local declarations
304      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
305      INTEGER, DIMENSION(2) ::   iloc      !
306      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
307      !!----------------------------------------------------------------------
308
309      ! Extrema of the scale factors
310
311      IF(lwp)WRITE(numout,*)
312      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
313      IF(lwp)WRITE(numout,*) '~~~~~~~'
314
315      IF (lk_mpp) THEN
316         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
317         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
318         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
319         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
320      ELSE
321         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
322         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
323         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
324         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
325
326         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
327         iimi1 = iloc(1) + nimpp - 1
328         ijmi1 = iloc(2) + njmpp - 1
329         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
330         iimi2 = iloc(1) + nimpp - 1
331         ijmi2 = iloc(2) + njmpp - 1
332         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
333         iima1 = iloc(1) + nimpp - 1
334         ijma1 = iloc(2) + njmpp - 1
335         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
336         iima2 = iloc(1) + nimpp - 1
337         ijma2 = iloc(2) + njmpp - 1
338      ENDIF
339
340      IF(lwp) THEN
341         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
342         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
343         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
344         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
345      ENDIF
346
347   END SUBROUTINE dom_ctl
348
349   !!======================================================================
350END MODULE domain
Note: See TracBrowser for help on using the repository browser.