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

Last change on this file since 343 was 343, checked in by opalod, 18 years ago

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