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

Last change on this file since 1312 was 1312, checked in by smasson, 15 years ago

add a namelist logical to mask land points in NetCDF outputs, see ticket:322

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 17.2 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   !!   $Id$
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, ln_mskland 
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         WRITE(numout,*) '           mask land points             ln_mskland   = ', ln_mskland
150      ENDIF
151
152      ndastp = ndate0                ! Assign initial date to current date
153
154     ! Namelist namctl : print control
155      REWIND( numnam )
156      READ  ( numnam, namctl )
157
158      IF(lwp) THEN
159         WRITE(numout,*) '        Namelist namctl'
160         WRITE(numout,*) '           run control (for debugging)     ln_ctl    = ', ln_ctl
161         WRITE(numout,*) '           level of print                  nprint    = ', nprint
162         WRITE(numout,*) '           Start i indice for SUM control  nictls    = ', nictls
163         WRITE(numout,*) '           End i indice for SUM control    nictle    = ', nictle
164         WRITE(numout,*) '           Start j indice for SUM control  njctls    = ', njctls
165         WRITE(numout,*) '           End j indice for SUM control    njctle    = ', njctle
166         WRITE(numout,*) '           number of proc. following i     isplt     = ', isplt
167         WRITE(numout,*) '           number of proc. following j     jsplt     = ', jsplt
168         WRITE(numout,*) '           benchmark parameter (0/1)       nbench    = ', nbench
169      ENDIF
170
171      ndastp = ndate0                ! Assign initial date to current date
172! ... Control the sub-domain area indices for the print control
173      IF(ln_ctl)   THEN
174         IF( lk_mpp ) THEN
175            ! the domain is forced to the real splitted domain in MPI
176            isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
177         ELSE
178            IF( isplt == 1 .AND. jsplt == 1  ) THEN
179               IF(lwp) WRITE(numout,cform_war)
180               IF(lwp) WRITE(numout,*)'          - isplt & jsplt are equal to 1'
181               IF(lwp) WRITE(numout,*)'          - the print control will be done over the whole domain'
182               IF(lwp) WRITE(numout,*)
183            ENDIF
184
185            ! compute the total number of processors ijsplt
186            ijsplt = isplt*jsplt
187         ENDIF
188
189         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
190         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
191
192         ! Control the indices used for the SUM control
193         IF( nictls+nictle+njctls+njctle == 0 )   THEN
194            ! the print control is done over the default area
195            lsp_area = .FALSE.
196         ELSE
197            ! the print control is done over a specific  area
198            lsp_area = .TRUE.
199            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
200               IF(lwp) WRITE(numout,cform_war)
201               IF(lwp) WRITE(numout,*)'          - nictls must be 1<=nictls>=jpiglo, it is forced to 1'
202               IF(lwp) WRITE(numout,*)
203               nwarn = nwarn + 1
204               nictls = 1
205            ENDIF
206
207            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
208               IF(lwp) WRITE(numout,cform_war)
209               IF(lwp) WRITE(numout,*)'          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo'
210               IF(lwp) WRITE(numout,*)
211               nwarn = nwarn + 1
212               nictle = jpjglo
213            ENDIF
214
215            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
216               IF(lwp) WRITE(numout,cform_war)
217               IF(lwp) WRITE(numout,*)'          - njctls must be 1<=njctls>=jpjglo, it is forced to 1'
218               IF(lwp) WRITE(numout,*)
219               nwarn = nwarn + 1
220               njctls = 1
221            ENDIF
222
223            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
224               IF(lwp) WRITE(numout,cform_war)
225               IF(lwp) WRITE(numout,*)'          - njctle must be 1<=njctle>= jpjglo, it is forced to jpjglo'
226               IF(lwp) WRITE(numout,*)
227               nwarn = nwarn + 1
228               njctle = jpjglo
229            ENDIF
230
231         ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 )
232       ENDIF            ! IF(ln_ctl)
233
234! ... Control of output frequency
235      IF ( nstock == 0 ) THEN
236          IF(lwp)WRITE(numout,cform_war)
237          IF(lwp)WRITE(numout,*) '           nstock = ', nstock, ' it is forced to ', nitend
238          nstock = nitend
239          nwarn = nwarn + 1
240      ENDIF
241      IF ( nwrite == 0 ) THEN
242          IF(lwp)WRITE(numout,cform_war)
243          IF(lwp)WRITE(numout,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
244          nwrite = nitend
245          nwarn = nwarn + 1
246      ENDIF
247
248      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
249      CASE (  1 ) 
250         CALL ioconf_calendar('gregorian')
251         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year'
252      CASE (  0 )
253         CALL ioconf_calendar('noleap')
254         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year'
255      CASE ( 30 )
256         CALL ioconf_calendar('360d')
257         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year'
258      END SELECT
259
260      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
261      CASE ( 1 )
262         raajj = 365.25
263         raass = raajj * rjjss
264         rmoss = raass/raamo
265      CASE ( 0 )
266         raajj = 365.
267         raass = raajj * rjjss
268         rmoss = raass/raamo
269      CASE DEFAULT
270         raajj = FLOAT( nleapy ) * raamo
271         raass =        raajj    * rjjss
272         rmoss = FLOAT( nleapy ) * rjjss
273      END SELECT
274      IF(lwp) THEN
275         WRITE(numout,*)
276         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
277         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
278         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
279      ENDIF
280
281      ! Read Namelist namzgr : vertical coordinate'
282      ! ---------------------
283      REWIND ( numnam )
284      READ   ( numnam, namzgr )
285
286      ! Parameter control and print
287      ! ---------------------------
288      ! Control print
289      IF(lwp) THEN
290         WRITE(numout,*)
291         WRITE(numout,*) 'Namelist namzgr : vertical coordinate'
292         WRITE(numout,*) '~~~~~~~'
293         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
294         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
295         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
296         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
297      ENDIF
298
299      ! Check Vertical coordinate options
300      ioptio = 0
301      IF( ln_zco ) ioptio = ioptio + 1
302      IF( ln_zps ) ioptio = ioptio + 1
303      IF( ln_sco ) ioptio = ioptio + 1
304      IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' )
305
306      IF( ln_zco ) THEN
307          IF(lwp) WRITE(numout,*) '          z-coordinate with reduced incore memory requirement'
308          IF( ln_zps .OR. ln_sco ) CALL ctl_stop( ' reduced memory with zps or sco option is impossible' )
309      ENDIF
310
311
312      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
313      REWIND( numnam )
314      READ  ( numnam, namdom )
315
316      IF(lwp) THEN
317         WRITE(numout,*)
318         WRITE(numout,*) '        Namelist namdom'
319         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
320         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
321         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
322         WRITE(numout,*) '                = 0   no file created                 '
323         WRITE(numout,*) '                = 1   mesh_mask                       '
324         WRITE(numout,*) '                = 2   mesh and mask                   '
325         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
326         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
327         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
328         WRITE(numout,*) '           time step                      rdt       = ', rdt
329         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
330         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
331         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
332      ENDIF
333
334
335
336      ! Default values
337      n_cla = 0
338
339      ! Namelist cross land advection
340      REWIND( numnam )
341      READ  ( numnam, namcla )
342      IF(lwp) THEN
343         WRITE(numout,*)
344         WRITE(numout,*) '        Namelist namcla'
345         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
346      ENDIF
347
348   END SUBROUTINE dom_nam
349
350
351   SUBROUTINE dom_ctl
352      !!----------------------------------------------------------------------
353      !!                     ***  ROUTINE dom_ctl  ***
354      !!
355      !! ** Purpose :   Domain control.
356      !!
357      !! ** Method  :   compute and print extrema of masked scale factors
358      !!
359      !! History :
360      !!   8.5  !  02-08  (G. Madec)    Original code
361      !!----------------------------------------------------------------------
362      !! * Local declarations
363      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
364      INTEGER, DIMENSION(2) ::   iloc      !
365      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
366      !!----------------------------------------------------------------------
367
368      ! Extrema of the scale factors
369
370      IF(lwp)WRITE(numout,*)
371      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
372      IF(lwp)WRITE(numout,*) '~~~~~~~'
373
374      IF (lk_mpp) THEN
375         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
376         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
377         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
378         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
379      ELSE
380         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
381         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
382         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
383         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
384
385         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
386         iimi1 = iloc(1) + nimpp - 1
387         ijmi1 = iloc(2) + njmpp - 1
388         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
389         iimi2 = iloc(1) + nimpp - 1
390         ijmi2 = iloc(2) + njmpp - 1
391         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
392         iima1 = iloc(1) + nimpp - 1
393         ijma1 = iloc(2) + njmpp - 1
394         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
395         iima2 = iloc(1) + nimpp - 1
396         ijma2 = iloc(2) + njmpp - 1
397      ENDIF
398
399      IF(lwp) THEN
400         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
401         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
402         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
403         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
404      ENDIF
405
406   END SUBROUTINE dom_ctl
407
408   !!======================================================================
409END MODULE domain
Note: See TracBrowser for help on using the repository browser.