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 tags/nemo_dev_x2/NEMO/OPA_SRC/DOM – NEMO

source: tags/nemo_dev_x2/NEMO/OPA_SRC/DOM/domain.F90 @ 4310

Last change on this file since 4310 was 72, checked in by opalod, 20 years ago

CT : BUGFIX046 : Bug correction in mpp case, use mpp_max(ze1max ... instead of mpp_min(ze1max)
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.4 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 ice_oce         ! ice variables
18   USE blk_oce         ! bulk variables
19   USE flxrnf          ! runoffs
20   USE daymod          ! calendar
21   USE lib_mpp         ! distributed memory computing library
22
23   USE domhgr          ! domain: set the horizontal mesh
24   USE domzgr          ! domain: set the vertical mesh
25   USE domstp          ! domain: set the time-step
26   USE dommsk          ! domain: set the mask system
27   USE domwri          ! domain: write the meshmask file
28   USE closea          ! closed sea or lake              (dom_clo routine)
29
30   IMPLICIT NONE
31   PRIVATE
32
33   !! * Routine accessibility
34   PUBLIC dom_init       ! called by opa.F90
35
36   !! * Substitutions
37#  include "domzgr_substitute.h90"
38   !!----------------------------------------------------------------------
39   !!   OPA 9.0 , LODYC-IPSL  (2003)
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44   SUBROUTINE dom_init
45      !!----------------------------------------------------------------------
46      !!                  ***  ROUTINE dom_init  ***
47      !!                   
48      !! ** Purpose :   Domain initialization. Call the routines that are
49      !!      required to create the arrays which define the space and time
50      !!      domain of the ocean model.
51      !!
52      !! ** Method  :
53      !!      - dom_msk: compute the masks from the bathymetry file
54      !!      - dom_hgr: compute or read the horizontal grid-point position and
55      !!                scale factors, and the coriolis factor
56      !!      - dom_zgr: define the vertical coordinate system and the bathymetry
57      !!      - dom_stp: defined the model time step
58      !!      - dom_wri: create the meshmask file if nmsh=1
59      !!
60      !! History :
61      !!        !  90-10  (C. Levy - G. Madec)  Original code
62      !!        !  91-11  (G. Madec)
63      !!        !  92-01  (M. Imbard) insert time step initialization
64      !!        !  96-06  (G. Madec) generalized vertical coordinate
65      !!        !  97-02  (G. Madec) creation of domwri.F
66      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
67      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
68      !!----------------------------------------------------------------------
69      !! * Local declarations
70      INTEGER ::   jk                ! dummy loop argument
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_clo                        ! Closed seas and lake
83
84      CALL dom_hgr                        ! Horizontal mesh
85
86      CALL dom_zgr                        ! Vertical mesh and bathymetry
87
88      CALL dom_msk                        ! Masks
89
90
91      ! Local depth or Inverse of the local depth of the water column at u- and v-points
92      ! ------------------------------
93#if defined key_dynspg_fsc
94      ! Ocean depth at U- and V-points
95      hu(:,:) = 0.
96      hv(:,:) = 0.
97
98      DO jk = 1, jpk
99         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
100         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
101      END DO
102#elif defined key_dynspg_rl
103      ! Inverse of the local depth
104      hur(:,:) = fse3u(:,:,1)             ! Lower bound : thickness of the first model level
105      hvr(:,:) = fse3v(:,:,1)
106     
107      DO jk = 2, jpk                      ! Sum of the vertical scale factors
108         hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
109         hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
110      END DO
111
112      ! Compute and mask the inverse of the local depth
113      hur(:,:) = 1. / hur(:,:) * umask(:,:,1)
114      hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1)
115#endif
116
117      CALL dom_stp                        ! Time step
118
119      IF( nmsh /= 0 )   CALL dom_wri      ! Create a domain file
120
121      IF( .NOT.ln_rstart )   CALL dom_ctl    ! Domain control
122
123   END SUBROUTINE dom_init
124
125
126   SUBROUTINE dom_nam
127      !!----------------------------------------------------------------------
128      !!                     ***  ROUTINE dom_nam  ***
129      !!                   
130      !! ** Purpose :   read domaine namelists and print the variables.
131      !!
132      !! ** input   : - namrun namelist
133      !!              - namdom namelist
134      !!              - namcla namelist
135      !!
136      !! History :
137      !!   9.0  !  03-08  (G. Madec)  Original code
138      !!----------------------------------------------------------------------
139      !! * Modules used
140#if ! defined key_fdir
141      USE ioipsl
142#endif
143      NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,   &
144         &             nitend, ndate0   , nleapy   , ninist , nstock,   &
145         &             nprint, nwrite   , nrunoff  , ln_ctl
146      NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, ngrid  , nmsh  ,   &
147         &             nacc  , atfp     , rdt      , rdtmin , rdtmax,   &
148         &             rdth  , nfice    , nfbulk   , nclosea
149      NAMELIST/namcla/ n_cla
150      !!----------------------------------------------------------------------
151
152      IF(lwp) THEN
153         WRITE(numout,*)
154         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
155         WRITE(numout,*) '~~~~~~~ '
156      ENDIF
157
158      ! Namelist namrun : parameters of the run
159      REWIND( numnam )
160      READ  ( numnam, namrun )
161
162      IF(lwp) THEN
163         WRITE(numout,*) '        Namelist namrun'
164         WRITE(numout,*) '           job number                      no        = ', no
165         WRITE(numout,*) '           experiment name for output      cexper    = ', cexper
166         WRITE(numout,*) '           restart logical                 ln_rstart = ', ln_rstart
167         WRITE(numout,*) '           control of time step            nrstdt    = ', nrstdt
168         WRITE(numout,*) '           number of the first time step   nit000    = ', nit000
169         WRITE(numout,*) '           number of the last time step    nitend    = ', nitend
170         WRITE(numout,*) '           initial calendar date aammjj    ndate0    = ', ndate0
171         WRITE(numout,*) '           leap year calendar (0/1)        nleapy    = ', nleapy
172         WRITE(numout,*) '           initial state output            ninist    = ', ninist
173         WRITE(numout,*) '           level of print                  nprint    = ', nprint
174         WRITE(numout,*) '           frequency of restart file       nstock    = ', nstock
175         WRITE(numout,*) '           frequency of output file        nwrite    = ', nwrite
176         WRITE(numout,*) '           runoff option                   nrunoff   = ', nrunoff
177         WRITE(numout,*) '           run control (for debugging)     ln_ctl    = ', ln_ctl
178      ENDIF
179
180      l_ctl = ln_ctl .AND. lwp       ! trend control print on the 1st processor only
181
182      ndastp = ndate0                ! Assign initial date to current date
183
184
185! ... Control of output frequency
186      IF ( nstock == 0 ) THEN
187          IF(lwp)WRITE(numout,cform_war)
188          IF(lwp)WRITE(numout,*) '           nstock = ', nstock, ' it is forced to ', nitend
189          nstock = nitend
190          nwarn = nwarn + 1
191      ENDIF
192      IF ( nwrite == 0 ) THEN
193          IF(lwp)WRITE(numout,cform_war)
194          IF(lwp)WRITE(numout,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
195          nwrite = nitend
196          nwarn = nwarn + 1
197      ENDIF
198
199#if ! defined key_fdir
200
201      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
202      CASE (  1 ) 
203         CALL ioconf_calendar('gregorian')
204         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year'
205      CASE (  0 )
206         CALL ioconf_calendar('noleap')
207         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year'
208      CASE ( 30 )
209         CALL ioconf_calendar('360d')
210         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year'
211      END SELECT
212#endif
213
214      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
215      CASE ( 1 )
216         raajj = 365.25
217         raass = raajj * rjjss
218         rmoss = raass/raamo
219      CASE ( 0 )
220         raajj = 365.
221         raass = raajj * rjjss
222         rmoss = raass/raamo
223      CASE DEFAULT
224         raajj = FLOAT( nleapy ) * raamo
225         raass =        raajj    * rjjss
226         rmoss = FLOAT( nleapy ) * rjjss
227      END SELECT
228      IF(lwp) THEN
229         WRITE(numout,*)
230         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
231         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
232         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
233      ENDIF
234
235      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
236      REWIND( numnam )
237      READ  ( numnam, namdom )
238
239      IF(lwp) THEN
240         WRITE(numout,*)
241         WRITE(numout,*) '        Namelist namdom'
242         WRITE(numout,*) '           flag read/compute bathymetry   ntopo     = ', ntopo
243         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
244         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
245         WRITE(numout,*) '           flag read/compute coordinates  ngrid     = ', ngrid
246         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
247         WRITE(numout,*) '                = 0   no file created                 '
248         WRITE(numout,*) '                = 1   mesh_mask                       '
249         WRITE(numout,*) '                = 2   mesh and mask                   '
250         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
251         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
252         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
253         WRITE(numout,*) '           time step                      rdt       = ', rdt
254         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
255         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
256         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
257         IF( lk_ice_lim ) THEN
258            WRITE(numout,*) '           ice model coupling frequency      nfice  = ', nfice
259            nfbulk = nfice
260         ENDIF
261         WRITE(numout,*) '           bulk computation frequency       nfbulk  = ', nfbulk, ' = nfice if ice model used'
262         WRITE(numout,*) '           flag closed sea or not           nclosea = ', nclosea
263      ENDIF
264
265      ! Default values
266      n_cla = 0
267
268      ! Namelist cross land advection
269      REWIND( numnam )
270      READ  ( numnam, namcla )
271      IF(lwp) THEN
272         WRITE(numout,*)
273         WRITE(numout,*) '        Namelist namcla'
274         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
275      ENDIF
276
277   END SUBROUTINE dom_nam
278
279
280   SUBROUTINE dom_ctl
281      !!----------------------------------------------------------------------
282      !!                     ***  ROUTINE dom_ctl  ***
283      !!
284      !! ** Purpose :   Domain control.
285      !!
286      !! ** Method  :   compute and print extrema of masked scale factors
287      !!
288      !! History :
289      !!   8.5  !  02-08  (G. Madec)    Original code
290      !!----------------------------------------------------------------------
291      !! * Local declarations
292      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
293      INTEGER, DIMENSION(2) ::   iloc      !
294      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
295      !!----------------------------------------------------------------------
296
297      ! Extrema of the scale factors
298
299      IF(lwp)WRITE(numout,*)
300      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
301      IF(lwp)WRITE(numout,*) '~~~~~~~'
302      ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
303      ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
304      ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
305      ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
306
307      IF( lk_mpp )   CALL mpp_min( ze1min )   ! min over the global domain
308      IF( lk_mpp )   CALL mpp_min( ze2min )
309      IF( lk_mpp )   CALL mpp_max( ze1max )   ! max over the global domain
310      IF( lk_mpp )   CALL mpp_max( ze2max )
311
312      iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
313      iimi1 = iloc(1) + nimpp - 1
314      ijmi1 = iloc(2) + njmpp - 1
315      iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
316      iimi2 = iloc(1) + nimpp - 1
317      ijmi2 = iloc(2) + njmpp - 1
318      iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
319      iima1 = iloc(1) + nimpp - 1
320      ijma1 = iloc(2) + njmpp - 1
321      iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
322      iima2 = iloc(1) + nimpp - 1
323      ijma2 = iloc(2) + njmpp - 1
324
325      IF( lk_mpp ) THEN
326         CALL mpp_isl( iimi1 )
327         CALL mpp_isl( ijmi1 )
328         CALL mpp_isl( iimi2 )
329         CALL mpp_isl( ijmi2 )
330         CALL mpp_isl( iima1 )
331         CALL mpp_isl( ijma1 )
332         CALL mpp_isl( iima2 )
333         CALL mpp_isl( ijma2 )
334      ENDIF
335
336      IF(lwp) THEN
337         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i3,' j= ',i3)") ze1max, iima1, ijma1
338         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i3,' j= ',i3)") ze1min, iimi1, ijmi1
339         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i3,' j= ',i3)") ze2max, iima2, ijma2
340         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i3,' j= ',i3)") ze2min, iimi2, ijmi2
341      ENDIF
342
343   END SUBROUTINE dom_ctl
344
345   !!======================================================================
346END MODULE domain
Note: See TracBrowser for help on using the repository browser.