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

source: branches/dev_001_GM/NEMO/OFF_SRC/DOM/domain.F90 @ 950

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

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