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

source: tags/nemo_v3_2/nemo_v3_2/NEMO/OFF_SRC/DOM/domain.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm
File size: 16.5 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 lib_mpp         ! distributed memory computing library
18
19   USE domstp          ! domain: set the time-step
20   USE domrea          ! domain: write the meshmask file
21   USE dommsk          ! domain : mask
22
23   IMPLICIT NONE
24   PRIVATE
25
26   !! * Routine accessibility
27   PUBLIC dom_init       ! called by opa.F90
28
29   !! * Module variables
30      REAL(wp) ::          & !!: Namelist nam_zgr_sco
31      sbot_min =  300.  ,  &  !: minimum depth of s-bottom surface (>0) (m)
32      sbot_max = 5250.  ,  &  !: maximum depth of s-bottom surface (= ocean depth) (>0) (m)
33      theta    =    6.0 ,  &  !: surface control parameter (0<=theta<=20)
34      thetb    =    0.75,  &  !: bottom control parameter  (0<=thetb<= 1)
35      r_max    =    0.15      !: maximum cut-off r-value allowed (0<r_max<1)
36
37
38   !! * Substitutions
39#  include "domzgr_substitute.h90"
40   !!----------------------------------------------------------------------
41   !!   OPA 9.0 , LOCEAN-IPSL  (2005)
42   !!   $Id: domain.F90 1748 2009-11-23 10:51:20Z cetlod $
43   !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
44   !!----------------------------------------------------------------------
45
46CONTAINS
47
48   SUBROUTINE dom_init
49      !!----------------------------------------------------------------------
50      !!                  ***  ROUTINE dom_init  ***
51      !!                   
52      !! ** Purpose :   Domain initialization. Call the routines that are
53      !!      required to create the arrays which define the space and time
54      !!      domain of the ocean model.
55      !!
56      !! ** Method  :
57      !!      - dom_stp: defined the model time step
58      !!      - dom_rea: read 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 ::   iconf = 0         ! temporary integers
71      !!----------------------------------------------------------------------
72
73      IF(lwp) THEN
74         WRITE(numout,*)
75         WRITE(numout,*) 'dom_init : domain initialization'
76         WRITE(numout,*) '~~~~~~~~'
77      ENDIF
78
79      CALL dom_nam                        ! read namelist ( namrun, namdom, namcla )
80
81      CALL dom_stp                        ! Time step
82
83      CALL dom_rea      ! Create a domain file
84
85      CALL dom_msk      ! Masks
86
87      CALL dom_ctl    ! Domain control
88
89   END SUBROUTINE dom_init
90
91
92   SUBROUTINE dom_nam
93      !!----------------------------------------------------------------------
94      !!                     ***  ROUTINE dom_nam  ***
95      !!                   
96      !! ** Purpose :   read domaine namelists and print the variables.
97      !!
98      !! ** input   : - namrun namelist
99      !!              - namdom namelist
100      !!              - namcla namelist
101      !!
102      !! History :
103      !!   9.0  !  03-08  (G. Madec)  Original code
104      !!----------------------------------------------------------------------
105      !! * Modules used
106      USE ioipsl
107      INTEGER ::   ioptio = 0      ! temporary integer
108
109      NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,         &
110         &             nitend, ndate0   , nleapy    , ninist , nstock,         &
111         &             nwrite, ln_mskland 
112
113      NAMELIST/namctl/ ln_ctl , nprint, nictls, nictle,   &
114         &             njctls, njctle   , nbench   , isplt  , jsplt
115
116      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
117
118      NAMELIST/namdom/ e3zps_min, e3zps_rat, nmsh  ,   &
119         &             nacc  , atfp     , rdt      , rdtmin , rdtmax,   &
120         &             rdth 
121
122      NAMELIST/namcla/ n_cla
123      !!----------------------------------------------------------------------
124
125      IF(lwp) THEN
126         WRITE(numout,*)
127         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
128         WRITE(numout,*) '~~~~~~~ '
129      ENDIF
130
131      ! Namelist namrun : parameters of the run
132      REWIND( numnam )
133      READ  ( numnam, namrun )
134
135      IF(lwp) THEN
136         WRITE(numout,*) '        Namelist namrun'
137         WRITE(numout,*) '           job number                      no        = ', no
138         WRITE(numout,*) '           experiment name for output      cexper    = ', cexper
139         WRITE(numout,*) '           restart logical                 ln_rstart = ', ln_rstart
140         WRITE(numout,*) '           control of time step            nrstdt    = ', nrstdt
141         WRITE(numout,*) '           number of the first time step   nit000    = ', nit000
142         WRITE(numout,*) '           number of the last time step    nitend    = ', nitend
143         WRITE(numout,*) '           initial calendar date aammjj    ndate0    = ', ndate0
144         WRITE(numout,*) '           leap year calendar (0/1)        nleapy    = ', nleapy
145         WRITE(numout,*) '           initial state output            ninist    = ', ninist
146         WRITE(numout,*) '           frequency of restart file       nstock    = ', nstock
147         WRITE(numout,*) '           frequency of output file        nwrite    = ', nwrite
148         WRITE(numout,*) '           mask land points             ln_mskland   = ', ln_mskland
149      ENDIF
150
151      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
152      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
153      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
154      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
155
156      CASE (  1 )
157         CALL ioconf_calendar('gregorian')
158         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
159      CASE (  0 )
160         CALL ioconf_calendar('noleap')
161         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
162      CASE ( 30 )
163         CALL ioconf_calendar('360d')
164         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
165      END SELECT
166
167     ! Namelist namctl : print control
168      REWIND( numnam )
169      READ  ( numnam, namctl )
170
171      IF(lwp) THEN
172         WRITE(numout,*) '        Namelist namctl'
173         WRITE(numout,*) '           run control (for debugging)     ln_ctl    = ', ln_ctl
174         WRITE(numout,*) '           level of print                  nprint    = ', nprint
175         WRITE(numout,*) '           Start i indice for SUM control  nictls    = ', nictls
176         WRITE(numout,*) '           End i indice for SUM control    nictle    = ', nictle
177         WRITE(numout,*) '           Start j indice for SUM control  njctls    = ', njctls
178         WRITE(numout,*) '           End j indice for SUM control    njctle    = ', njctle
179         WRITE(numout,*) '           number of proc. following i     isplt     = ', isplt
180         WRITE(numout,*) '           number of proc. following j     jsplt     = ', jsplt
181         WRITE(numout,*) '           benchmark parameter (0/1)       nbench    = ', nbench
182      ENDIF
183
184      ! ... Control the sub-domain area indices for the print control
185      IF(ln_ctl)   THEN
186         IF( lk_mpp ) THEN
187            ! the domain is forced to the real splitted domain in MPI
188            isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
189         ELSE
190            IF( isplt == 1 .AND. jsplt == 1  ) THEN
191               IF(lwp) WRITE(numout,cform_war)
192               IF(lwp) WRITE(numout,*)'          - isplt & jsplt are equal to 1'
193               IF(lwp) WRITE(numout,*)'          - the print control will be done over the whole domain'
194               IF(lwp) WRITE(numout,*)
195            ENDIF
196
197            ! compute the total number of processors ijsplt
198            ijsplt = isplt*jsplt
199         ENDIF
200
201         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
202         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
203
204         ! Control the indices used for the SUM control
205         IF( nictls+nictle+njctls+njctle == 0 )   THEN
206            ! the print control is done over the default area
207            lsp_area = .FALSE.
208         ELSE
209            ! the print control is done over a specific  area
210            lsp_area = .TRUE.
211            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
212               IF(lwp) WRITE(numout,cform_war)
213               IF(lwp) WRITE(numout,*)'          - nictls must be 1<=nictls>=jpiglo, it is forced to 1'
214               IF(lwp) WRITE(numout,*)
215               nwarn = nwarn + 1
216               nictls = 1
217            ENDIF
218
219            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
220               IF(lwp) WRITE(numout,cform_war)
221               IF(lwp) WRITE(numout,*)'          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo'
222               IF(lwp) WRITE(numout,*)
223               nwarn = nwarn + 1
224               nictle = jpjglo
225            ENDIF
226
227            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
228               IF(lwp) WRITE(numout,cform_war)
229               IF(lwp) WRITE(numout,*)'          - njctls must be 1<=njctls>=jpjglo, it is forced to 1'
230               IF(lwp) WRITE(numout,*)
231               nwarn = nwarn + 1
232               njctls = 1
233            ENDIF
234
235            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
236               IF(lwp) WRITE(numout,cform_war)
237               IF(lwp) WRITE(numout,*)'          - njctle must be 1<=njctle>= jpjglo, it is forced to jpjglo'
238               IF(lwp) WRITE(numout,*)
239               nwarn = nwarn + 1
240               njctle = jpjglo
241            ENDIF
242
243         ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 )
244       ENDIF            ! IF(ln_ctl)
245
246! ... Control of output frequency
247      IF ( nstock == 0 ) THEN
248          IF(lwp)WRITE(numout,cform_war)
249          IF(lwp)WRITE(numout,*) '           nstock = ', nstock, ' it is forced to ', nitend
250          nstock = nitend
251          nwarn = nwarn + 1
252      ENDIF
253      IF ( nwrite == 0 ) THEN
254          IF(lwp)WRITE(numout,cform_war)
255          IF(lwp)WRITE(numout,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
256          nwrite = nitend
257          nwarn = nwarn + 1
258      ENDIF
259
260      ! Read Namelist namzgr : vertical coordinate'
261      ! ---------------------
262      REWIND ( numnam )
263      READ   ( numnam, namzgr )
264
265      ! Parameter control and print
266      ! ---------------------------
267      ! Control print
268      IF(lwp) THEN
269         WRITE(numout,*)
270         WRITE(numout,*) 'Namelist namzgr : vertical coordinate'
271         WRITE(numout,*) '~~~~~~~'
272         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
273         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
274         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
275         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
276      ENDIF
277
278      ! Check Vertical coordinate options
279      ioptio = 0
280      IF( ln_zco ) ioptio = ioptio + 1
281      IF( ln_zps ) ioptio = ioptio + 1
282      IF( ln_sco ) ioptio = ioptio + 1
283      IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' )
284
285      IF( ln_zco ) THEN
286          IF(lwp) WRITE(numout,*) '          z-coordinate with reduced incore memory requirement'
287          IF( ln_zps .OR. ln_sco ) CALL ctl_stop( ' reduced memory with zps or sco option is impossible' )
288      ENDIF
289
290
291      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
292      REWIND( numnam )
293      READ  ( numnam, namdom )
294
295      IF(lwp) THEN
296         WRITE(numout,*)
297         WRITE(numout,*) '        Namelist namdom'
298         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
299         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
300         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
301         WRITE(numout,*) '                = 0   no file created                 '
302         WRITE(numout,*) '                = 1   mesh_mask                       '
303         WRITE(numout,*) '                = 2   mesh and mask                   '
304         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
305         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
306         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
307         WRITE(numout,*) '           time step                      rdt       = ', rdt
308         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
309         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
310         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
311      ENDIF
312
313
314
315      ! Default values
316      n_cla = 0
317
318      ! Namelist cross land advection
319      REWIND( numnam )
320      READ  ( numnam, namcla )
321      IF(lwp) THEN
322         WRITE(numout,*)
323         WRITE(numout,*) '        Namelist namcla'
324         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
325      ENDIF
326
327   END SUBROUTINE dom_nam
328
329
330   SUBROUTINE dom_ctl
331      !!----------------------------------------------------------------------
332      !!                     ***  ROUTINE dom_ctl  ***
333      !!
334      !! ** Purpose :   Domain control.
335      !!
336      !! ** Method  :   compute and print extrema of masked scale factors
337      !!
338      !! History :
339      !!   8.5  !  02-08  (G. Madec)    Original code
340      !!----------------------------------------------------------------------
341      !! * Local declarations
342      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
343      INTEGER, DIMENSION(2) ::   iloc      !
344      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
345      !!----------------------------------------------------------------------
346
347      ! Extrema of the scale factors
348
349      IF(lwp)WRITE(numout,*)
350      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
351      IF(lwp)WRITE(numout,*) '~~~~~~~'
352
353      IF (lk_mpp) THEN
354         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
355         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
356         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
357         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
358      ELSE
359         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
360         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
361         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
362         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
363
364         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
365         iimi1 = iloc(1) + nimpp - 1
366         ijmi1 = iloc(2) + njmpp - 1
367         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
368         iimi2 = iloc(1) + nimpp - 1
369         ijmi2 = iloc(2) + njmpp - 1
370         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
371         iima1 = iloc(1) + nimpp - 1
372         ijma1 = iloc(2) + njmpp - 1
373         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
374         iima2 = iloc(1) + nimpp - 1
375         ijma2 = iloc(2) + njmpp - 1
376      ENDIF
377
378      IF(lwp) THEN
379         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
380         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
381         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
382         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
383      ENDIF
384
385   END SUBROUTINE dom_ctl
386
387   !!======================================================================
388END MODULE domain
Note: See TracBrowser for help on using the repository browser.