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

source: trunk/NEMO/OPA_SRC/DOM/domain.F90 @ 93

Last change on this file since 93 was 93, checked in by opalod, 19 years ago

CT : UPDATE060 : A new configuration, named GYRE, has been added.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.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 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 , nbench
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         WRITE(numout,*) '           benchmark parameter (0/1)       nbench    = ', nbench
179      ENDIF
180
181      l_ctl = ln_ctl .AND. lwp       ! trend control print on the 1st processor only
182
183      ndastp = ndate0                ! Assign initial date to current date
184
185
186! ... Control of output frequency
187      IF ( nstock == 0 ) THEN
188          IF(lwp)WRITE(numout,cform_war)
189          IF(lwp)WRITE(numout,*) '           nstock = ', nstock, ' it is forced to ', nitend
190          nstock = nitend
191          nwarn = nwarn + 1
192      ENDIF
193      IF ( nwrite == 0 ) THEN
194          IF(lwp)WRITE(numout,cform_war)
195          IF(lwp)WRITE(numout,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
196          nwrite = nitend
197          nwarn = nwarn + 1
198      ENDIF
199
200#if ! defined key_fdir
201
202      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
203      CASE (  1 ) 
204         CALL ioconf_calendar('gregorian')
205         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year'
206      CASE (  0 )
207         CALL ioconf_calendar('noleap')
208         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year'
209      CASE ( 30 )
210         CALL ioconf_calendar('360d')
211         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year'
212      END SELECT
213#endif
214
215      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
216      CASE ( 1 )
217         raajj = 365.25
218         raass = raajj * rjjss
219         rmoss = raass/raamo
220      CASE ( 0 )
221         raajj = 365.
222         raass = raajj * rjjss
223         rmoss = raass/raamo
224      CASE DEFAULT
225         raajj = FLOAT( nleapy ) * raamo
226         raass =        raajj    * rjjss
227         rmoss = FLOAT( nleapy ) * rjjss
228      END SELECT
229      IF(lwp) THEN
230         WRITE(numout,*)
231         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
232         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
233         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
234      ENDIF
235
236      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
237      REWIND( numnam )
238      READ  ( numnam, namdom )
239
240      IF(lwp) THEN
241         WRITE(numout,*)
242         WRITE(numout,*) '        Namelist namdom'
243         WRITE(numout,*) '           flag read/compute bathymetry   ntopo     = ', ntopo
244         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
245         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
246         WRITE(numout,*) '           flag read/compute coordinates  ngrid     = ', ngrid
247         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
248         WRITE(numout,*) '                = 0   no file created                 '
249         WRITE(numout,*) '                = 1   mesh_mask                       '
250         WRITE(numout,*) '                = 2   mesh and mask                   '
251         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
252         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
253         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
254         WRITE(numout,*) '           time step                      rdt       = ', rdt
255         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
256         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
257         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
258         IF( lk_ice_lim ) THEN
259            WRITE(numout,*) '           ice model coupling frequency      nfice  = ', nfice
260            nfbulk = nfice
261         ENDIF
262         WRITE(numout,*) '           bulk computation frequency       nfbulk  = ', nfbulk, ' = nfice if ice model used'
263         WRITE(numout,*) '           flag closed sea or not           nclosea = ', nclosea
264      ENDIF
265
266      ! Default values
267      n_cla = 0
268
269      ! Namelist cross land advection
270      REWIND( numnam )
271      READ  ( numnam, namcla )
272      IF(lwp) THEN
273         WRITE(numout,*)
274         WRITE(numout,*) '        Namelist namcla'
275         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
276      ENDIF
277
278   END SUBROUTINE dom_nam
279
280
281   SUBROUTINE dom_ctl
282      !!----------------------------------------------------------------------
283      !!                     ***  ROUTINE dom_ctl  ***
284      !!
285      !! ** Purpose :   Domain control.
286      !!
287      !! ** Method  :   compute and print extrema of masked scale factors
288      !!
289      !! History :
290      !!   8.5  !  02-08  (G. Madec)    Original code
291      !!----------------------------------------------------------------------
292      !! * Local declarations
293      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
294      INTEGER, DIMENSION(2) ::   iloc      !
295      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
296      !!----------------------------------------------------------------------
297
298      ! Extrema of the scale factors
299
300      IF(lwp)WRITE(numout,*)
301      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
302      IF(lwp)WRITE(numout,*) '~~~~~~~'
303      ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
304      ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
305      ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
306      ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
307
308      IF( lk_mpp )   CALL mpp_min( ze1min )   ! min over the global domain
309      IF( lk_mpp )   CALL mpp_min( ze2min )
310      IF( lk_mpp )   CALL mpp_max( ze1max )   ! max over the global domain
311      IF( lk_mpp )   CALL mpp_max( ze2max )
312
313      iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
314      iimi1 = iloc(1) + nimpp - 1
315      ijmi1 = iloc(2) + njmpp - 1
316      iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
317      iimi2 = iloc(1) + nimpp - 1
318      ijmi2 = iloc(2) + njmpp - 1
319      iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
320      iima1 = iloc(1) + nimpp - 1
321      ijma1 = iloc(2) + njmpp - 1
322      iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
323      iima2 = iloc(1) + nimpp - 1
324      ijma2 = iloc(2) + njmpp - 1
325
326      IF( lk_mpp ) THEN
327!CT bug         CALL mpp_isl( iimi1 )
328!CT bug         CALL mpp_isl( ijmi1 )
329!CT bug         CALL mpp_isl( iimi2 )
330!CT bug         CALL mpp_isl( ijmi2 )
331!CT bug         CALL mpp_isl( iima1 )
332!CT bug         CALL mpp_isl( ijma1 )
333!CT bug         CALL mpp_isl( iima2 )
334!CT bug         CALL mpp_isl( ijma2 )
335      ENDIF
336
337      IF(lwp) THEN
338         IF(lk_mpp) THEN
339            WRITE(numout,cform_war)
340            WRITE(numout,*)'      Min(Max) of e1t, e2t are those of the first proc only'
341            WRITE(numout,*)
342         END IF
343         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i3,' j= ',i3)") ze1max, iima1, ijma1
344         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i3,' j= ',i3)") ze1min, iimi1, ijmi1
345         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i3,' j= ',i3)") ze2max, iima2, ijma2
346         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i3,' j= ',i3)") ze2min, iimi2, ijmi2
347      ENDIF
348
349   END SUBROUTINE dom_ctl
350
351   !!======================================================================
352END MODULE domain
Note: See TracBrowser for help on using the repository browser.