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

source: trunk/NEMO/OFF_SRC/DOM/domain.F90 @ 1119

Last change on this file since 1119 was 1119, checked in by cetlod, 16 years ago

style of all top namelist has been modified ; update modules to take it into account, see ticket:196

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 17.1 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 daymod          ! calendar
18   USE lib_mpp         ! distributed memory computing library
19
20   USE domstp          ! domain: set the time-step
21   USE domrea          ! domain: write the meshmask file
22   USE dommsk          ! domain : mask
23
24   IMPLICIT NONE
25   PRIVATE
26
27   !! * Routine accessibility
28   PUBLIC dom_init       ! called by opa.F90
29
30   !! * Module variables
31      REAL(wp) ::          & !!: Namelist nam_zgr_sco
32      sbot_min =  300.  ,  &  !: minimum depth of s-bottom surface (>0) (m)
33      sbot_max = 5250.  ,  &  !: maximum depth of s-bottom surface (= ocean depth) (>0) (m)
34      theta    =    6.0 ,  &  !: surface control parameter (0<=theta<=20)
35      thetb    =    0.75,  &  !: bottom control parameter  (0<=thetb<= 1)
36      r_max    =    0.15      !: maximum cut-off r-value allowed (0<r_max<1)
37
38
39   !! * Substitutions
40#  include "domzgr_substitute.h90"
41   !!----------------------------------------------------------------------
42   !!   OPA 9.0 , LOCEAN-IPSL  (2005)
43   !!   $Header$
44   !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
45   !!----------------------------------------------------------------------
46
47CONTAINS
48
49   SUBROUTINE dom_init
50      !!----------------------------------------------------------------------
51      !!                  ***  ROUTINE dom_init  ***
52      !!                   
53      !! ** Purpose :   Domain initialization. Call the routines that are
54      !!      required to create the arrays which define the space and time
55      !!      domain of the ocean model.
56      !!
57      !! ** Method  :
58      !!      - dom_stp: defined the model time step
59      !!      - dom_rea: read the meshmask file if nmsh=1
60      !!
61      !! History :
62      !!        !  90-10  (C. Levy - G. Madec)  Original code
63      !!        !  91-11  (G. Madec)
64      !!        !  92-01  (M. Imbard) insert time step initialization
65      !!        !  96-06  (G. Madec) generalized vertical coordinate
66      !!        !  97-02  (G. Madec) creation of domwri.F
67      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
68      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
69      !!----------------------------------------------------------------------
70      !! * Local declarations
71      INTEGER ::   iconf = 0         ! temporary integers
72      !!----------------------------------------------------------------------
73
74      IF(lwp) THEN
75         WRITE(numout,*)
76         WRITE(numout,*) 'dom_init : domain initialization'
77         WRITE(numout,*) '~~~~~~~~'
78      ENDIF
79
80      CALL dom_nam                        ! read namelist ( namrun, namdom, namcla )
81
82      CALL dom_stp                        ! Time step
83
84      CALL dom_rea      ! Create a domain file
85
86      CALL dom_msk      ! Masks
87
88      CALL dom_ctl    ! Domain control
89
90   END SUBROUTINE dom_init
91
92
93   SUBROUTINE dom_nam
94      !!----------------------------------------------------------------------
95      !!                     ***  ROUTINE dom_nam  ***
96      !!                   
97      !! ** Purpose :   read domaine namelists and print the variables.
98      !!
99      !! ** input   : - namrun namelist
100      !!              - namdom namelist
101      !!              - namcla namelist
102      !!
103      !! History :
104      !!   9.0  !  03-08  (G. Madec)  Original code
105      !!----------------------------------------------------------------------
106      !! * Modules used
107      USE ioipsl
108      INTEGER ::   ioptio = 0      ! temporary integer
109
110      NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,         &
111         &             nitend, ndate0   , nleapy    , ninist , nstock,         &
112         &             nwrite 
113
114      NAMELIST/namctl/ ln_ctl , nprint, nictls, nictle,   &
115         &             njctls, njctle   , nbench   , isplt  , jsplt
116
117      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
118
119      NAMELIST/namdom/ e3zps_min, e3zps_rat, nmsh  ,   &
120         &             nacc  , atfp     , rdt      , rdtmin , rdtmax,   &
121         &             rdth 
122
123      NAMELIST/namcla/ n_cla
124      !!----------------------------------------------------------------------
125
126      IF(lwp) THEN
127         WRITE(numout,*)
128         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
129         WRITE(numout,*) '~~~~~~~ '
130      ENDIF
131
132      ! Namelist namrun : parameters of the run
133      REWIND( numnam )
134      READ  ( numnam, namrun )
135
136      IF(lwp) THEN
137         WRITE(numout,*) '        Namelist namrun'
138         WRITE(numout,*) '           job number                      no        = ', no
139         WRITE(numout,*) '           experiment name for output      cexper    = ', cexper
140         WRITE(numout,*) '           restart logical                 ln_rstart = ', ln_rstart
141         WRITE(numout,*) '           control of time step            nrstdt    = ', nrstdt
142         WRITE(numout,*) '           number of the first time step   nit000    = ', nit000
143         WRITE(numout,*) '           number of the last time step    nitend    = ', nitend
144         WRITE(numout,*) '           initial calendar date aammjj    ndate0    = ', ndate0
145         WRITE(numout,*) '           leap year calendar (0/1)        nleapy    = ', nleapy
146         WRITE(numout,*) '           initial state output            ninist    = ', ninist
147         WRITE(numout,*) '           frequency of restart file       nstock    = ', nstock
148         WRITE(numout,*) '           frequency of output file        nwrite    = ', nwrite
149      ENDIF
150
151      ndastp = ndate0                ! Assign initial date to current date
152
153     ! Namelist namctl : print control
154      REWIND( numnam )
155      READ  ( numnam, namctl )
156
157      IF(lwp) THEN
158         WRITE(numout,*) '        Namelist namctl'
159         WRITE(numout,*) '           run control (for debugging)     ln_ctl    = ', ln_ctl
160         WRITE(numout,*) '           level of print                  nprint    = ', nprint
161         WRITE(numout,*) '           Start i indice for SUM control  nictls    = ', nictls
162         WRITE(numout,*) '           End i indice for SUM control    nictle    = ', nictle
163         WRITE(numout,*) '           Start j indice for SUM control  njctls    = ', njctls
164         WRITE(numout,*) '           End j indice for SUM control    njctle    = ', njctle
165         WRITE(numout,*) '           number of proc. following i     isplt     = ', isplt
166         WRITE(numout,*) '           number of proc. following j     jsplt     = ', jsplt
167         WRITE(numout,*) '           benchmark parameter (0/1)       nbench    = ', nbench
168      ENDIF
169
170      ndastp = ndate0                ! Assign initial date to current date
171! ... Control the sub-domain area indices for the print control
172      IF(ln_ctl)   THEN
173         IF( lk_mpp ) THEN
174            ! the domain is forced to the real splitted domain in MPI
175            isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
176         ELSE
177            IF( isplt == 1 .AND. jsplt == 1  ) THEN
178               IF(lwp) WRITE(numout,cform_war)
179               IF(lwp) WRITE(numout,*)'          - isplt & jsplt are equal to 1'
180               IF(lwp) WRITE(numout,*)'          - the print control will be done over the whole domain'
181               IF(lwp) WRITE(numout,*)
182            ENDIF
183
184            ! compute the total number of processors ijsplt
185            ijsplt = isplt*jsplt
186         ENDIF
187
188         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
189         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
190
191         ! Control the indices used for the SUM control
192         IF( nictls+nictle+njctls+njctle == 0 )   THEN
193            ! the print control is done over the default area
194            lsp_area = .FALSE.
195         ELSE
196            ! the print control is done over a specific  area
197            lsp_area = .TRUE.
198            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
199               IF(lwp) WRITE(numout,cform_war)
200               IF(lwp) WRITE(numout,*)'          - nictls must be 1<=nictls>=jpiglo, it is forced to 1'
201               IF(lwp) WRITE(numout,*)
202               nwarn = nwarn + 1
203               nictls = 1
204            ENDIF
205
206            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
207               IF(lwp) WRITE(numout,cform_war)
208               IF(lwp) WRITE(numout,*)'          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo'
209               IF(lwp) WRITE(numout,*)
210               nwarn = nwarn + 1
211               nictle = jpjglo
212            ENDIF
213
214            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
215               IF(lwp) WRITE(numout,cform_war)
216               IF(lwp) WRITE(numout,*)'          - njctls must be 1<=njctls>=jpjglo, it is forced to 1'
217               IF(lwp) WRITE(numout,*)
218               nwarn = nwarn + 1
219               njctls = 1
220            ENDIF
221
222            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
223               IF(lwp) WRITE(numout,cform_war)
224               IF(lwp) WRITE(numout,*)'          - njctle must be 1<=njctle>= jpjglo, it is forced to jpjglo'
225               IF(lwp) WRITE(numout,*)
226               nwarn = nwarn + 1
227               njctle = jpjglo
228            ENDIF
229
230         ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 )
231       ENDIF            ! IF(ln_ctl)
232
233! ... Control of output frequency
234      IF ( nstock == 0 ) THEN
235          IF(lwp)WRITE(numout,cform_war)
236          IF(lwp)WRITE(numout,*) '           nstock = ', nstock, ' it is forced to ', nitend
237          nstock = nitend
238          nwarn = nwarn + 1
239      ENDIF
240      IF ( nwrite == 0 ) THEN
241          IF(lwp)WRITE(numout,cform_war)
242          IF(lwp)WRITE(numout,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
243          nwrite = nitend
244          nwarn = nwarn + 1
245      ENDIF
246
247      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
248      CASE (  1 ) 
249         CALL ioconf_calendar('gregorian')
250         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year'
251      CASE (  0 )
252         CALL ioconf_calendar('noleap')
253         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year'
254      CASE ( 30 )
255         CALL ioconf_calendar('360d')
256         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year'
257      END SELECT
258
259      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
260      CASE ( 1 )
261         raajj = 365.25
262         raass = raajj * rjjss
263         rmoss = raass/raamo
264      CASE ( 0 )
265         raajj = 365.
266         raass = raajj * rjjss
267         rmoss = raass/raamo
268      CASE DEFAULT
269         raajj = FLOAT( nleapy ) * raamo
270         raass =        raajj    * rjjss
271         rmoss = FLOAT( nleapy ) * rjjss
272      END SELECT
273      IF(lwp) THEN
274         WRITE(numout,*)
275         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
276         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
277         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
278      ENDIF
279
280      ! Read Namelist namzgr : vertical coordinate'
281      ! ---------------------
282      REWIND ( numnam )
283      READ   ( numnam, namzgr )
284
285      ! Parameter control and print
286      ! ---------------------------
287      ! Control print
288      IF(lwp) THEN
289         WRITE(numout,*)
290         WRITE(numout,*) 'Namelist namzgr : vertical coordinate'
291         WRITE(numout,*) '~~~~~~~'
292         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
293         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
294         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
295         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
296      ENDIF
297
298      ! Check Vertical coordinate options
299      ioptio = 0
300      IF( ln_zco ) ioptio = ioptio + 1
301      IF( ln_zps ) ioptio = ioptio + 1
302      IF( ln_sco ) ioptio = ioptio + 1
303      IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' )
304
305      IF( ln_zco ) THEN
306          IF(lwp) WRITE(numout,*) '          z-coordinate with reduced incore memory requirement'
307          IF( ln_zps .OR. ln_sco ) CALL ctl_stop( ' reduced memory with zps or sco option is impossible' )
308      ENDIF
309
310
311      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
312      REWIND( numnam )
313      READ  ( numnam, namdom )
314
315      IF(lwp) THEN
316         WRITE(numout,*)
317         WRITE(numout,*) '        Namelist namdom'
318         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
319         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
320         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
321         WRITE(numout,*) '                = 0   no file created                 '
322         WRITE(numout,*) '                = 1   mesh_mask                       '
323         WRITE(numout,*) '                = 2   mesh and mask                   '
324         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
325         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
326         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
327         WRITE(numout,*) '           time step                      rdt       = ', rdt
328         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
329         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
330         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
331      ENDIF
332
333
334
335      ! Default values
336      n_cla = 0
337
338      ! Namelist cross land advection
339      REWIND( numnam )
340      READ  ( numnam, namcla )
341      IF(lwp) THEN
342         WRITE(numout,*)
343         WRITE(numout,*) '        Namelist namcla'
344         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
345      ENDIF
346
347   END SUBROUTINE dom_nam
348
349
350   SUBROUTINE dom_ctl
351      !!----------------------------------------------------------------------
352      !!                     ***  ROUTINE dom_ctl  ***
353      !!
354      !! ** Purpose :   Domain control.
355      !!
356      !! ** Method  :   compute and print extrema of masked scale factors
357      !!
358      !! History :
359      !!   8.5  !  02-08  (G. Madec)    Original code
360      !!----------------------------------------------------------------------
361      !! * Local declarations
362      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
363      INTEGER, DIMENSION(2) ::   iloc      !
364      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
365      !!----------------------------------------------------------------------
366
367      ! Extrema of the scale factors
368
369      IF(lwp)WRITE(numout,*)
370      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
371      IF(lwp)WRITE(numout,*) '~~~~~~~'
372
373      IF (lk_mpp) THEN
374         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
375         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
376         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
377         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
378      ELSE
379         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
380         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
381         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
382         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
383
384         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
385         iimi1 = iloc(1) + nimpp - 1
386         ijmi1 = iloc(2) + njmpp - 1
387         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
388         iimi2 = iloc(1) + nimpp - 1
389         ijmi2 = iloc(2) + njmpp - 1
390         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
391         iima1 = iloc(1) + nimpp - 1
392         ijma1 = iloc(2) + njmpp - 1
393         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
394         iima2 = iloc(1) + nimpp - 1
395         ijma2 = iloc(2) + njmpp - 1
396      ENDIF
397
398      IF(lwp) THEN
399         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
400         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
401         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
402         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
403      ENDIF
404
405   END SUBROUTINE dom_ctl
406
407   !!======================================================================
408END MODULE domain
Note: See TracBrowser for help on using the repository browser.