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/2012/dev_r3452_UKMO9_RESTART/NEMOGCM/NEMO/OFF_SRC – NEMO

source: branches/2012/dev_r3452_UKMO9_RESTART/NEMOGCM/NEMO/OFF_SRC/domain.F90 @ 3594

Last change on this file since 3594 was 3594, checked in by rfurner, 11 years ago

code not tested through SETTEE, builds and runs, but has not been thoroughly tested, so will not be included in 2012 merge, however submitted back to keep record of work done for 2013 developments
  • Property svn:keywords set to Id
File size: 17.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 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   !! * Substitutions
30#  include "domzgr_substitute.h90"
31   !!----------------------------------------------------------------------
32   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
33   !! $Id$
34   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
35   !!----------------------------------------------------------------------
36
37CONTAINS
38
39   SUBROUTINE dom_init
40      !!----------------------------------------------------------------------
41      !!                  ***  ROUTINE dom_init  ***
42      !!                   
43      !! ** Purpose :   Domain initialization. Call the routines that are
44      !!      required to create the arrays which define the space and time
45      !!      domain of the ocean model.
46      !!
47      !! ** Method  :
48      !!      - dom_stp: defined the model time step
49      !!      - dom_rea: read the meshmask file if nmsh=1
50      !!
51      !! History :
52      !!        !  90-10  (C. Levy - G. Madec)  Original code
53      !!        !  91-11  (G. Madec)
54      !!        !  92-01  (M. Imbard) insert time step initialization
55      !!        !  96-06  (G. Madec) generalized vertical coordinate
56      !!        !  97-02  (G. Madec) creation of domwri.F
57      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
58      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
59      !!----------------------------------------------------------------------
60      !! * Local declarations
61      INTEGER ::   iconf = 0         ! temporary integers
62      !!----------------------------------------------------------------------
63
64      IF(lwp) THEN
65         WRITE(numout,*)
66         WRITE(numout,*) 'dom_init : domain initialization'
67         WRITE(numout,*) '~~~~~~~~'
68      ENDIF
69
70      CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
71      CALL dom_zgr      ! Vertical mesh and bathymetry option
72      CALL dom_rea      ! Create a domain file
73      CALL dom_stp      ! Time step
74      CALL dom_msk      ! Masks
75      CALL dom_ctl      ! Domain control
76
77   END SUBROUTINE dom_init
78
79   SUBROUTINE dom_nam
80      !!----------------------------------------------------------------------
81      !!                     ***  ROUTINE dom_nam  ***
82      !!                   
83      !! ** Purpose :   read domaine namelists and print the variables.
84      !!
85      !! ** input   : - namrun namelist
86      !!              - namdom namelist
87      !!              - namcla namelist
88      !!----------------------------------------------------------------------
89      USE ioipsl
90
91      INTEGER :: js    ! dummy loop variable
92      CHARACTER(LEN=10)   ::   cltimes  ! restart dump times needed
93
94      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
95         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
96         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
97      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,     &
98         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,              &
99         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
100      NAMELIST/namcla/ nn_cla
101#if defined key_netcdf4
102      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
103#endif
104      !!----------------------------------------------------------------------
105
106      REWIND( numnam )              ! Namelist namrun : parameters of the run
107      READ  ( numnam, namrun )
108      !
109      IF(lwp) THEN                  ! control print
110         WRITE(numout,*)
111         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
112         WRITE(numout,*) '~~~~~~~ '
113         WRITE(numout,*) '   Namelist namrun' 
114         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
115         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
116         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
117         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
118         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
119         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
120         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
121         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
122         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
123         IF ( nn_stock(1) < 0 ) THEN
124            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', ABS(nn_stock(1))
125         ELSE
126            WRITE(numout,*) '      list of restart times           nn_stock   = ', nn_stock
127         ENDIF
128         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
129         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
130         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
131         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
132         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
133      ENDIF
134      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
135      cexper = cn_exp
136      nrstdt = nn_rstctl
137      nit000 = nn_it000
138      nitend = nn_itend
139      ndate0 = nn_date0
140      nleapy = nn_leapy
141      ninist = nn_istate
142      nwrite = nn_write
143
144      !                             ! control of output frequency
145      IF ( ALL(nn_stock == 0) ) THEN
146         WRITE(ctmp1,*) 'No restart output times specified, restart forced to output at end of run, kt = ', nitend
147         CALL ctl_warn( ctmp1 )
148         nn_stock(1) = nitend
149      ELSE
150         IF ( nn_stock(1) > 0 ) THEN
151            DO js=1,size(nn_stock)-1
152               IF ( nn_stock(js+1) <= nn_stock(js) .AND. nn_stock(js+1) .NE. 0.0 ) THEN
153                  WRITE(ctmp1,*) 'Restart times in nn_stock not monotonically increasing, some values ignored'
154                  CALL ctl_warn( ctmp1 )
155               ENDIF
156            ENDDO
157            IF ( ANY(nn_stock > nitend) ) THEN
158               WRITE(ctmp1,*) 'some values of nn_stock exceed run length they are forced to end of run, kt = ', nitend
159               CALL ctl_warn( ctmp1 )
160               WHERE (nn_stock > nitend ) nn_stock=nitend
161            ENDIF
162         ELSEIF ( nn_stock(1) < 0 ) THEN
163            IF ( ABS(nn_stock(1)) > nitend ) THEN
164               WRITE(ctmp1,*) 'Attempting to output restarts at frequency greater than run legth, restart forced to output at end of run, kt = ', nitend
165               CALL ctl_warn( ctmp1 )
166               nn_stock(1) = nitend
167            ELSE
168               DO js=1,SIZE(nn_stock) 
169                  nn_stock(js) = MIN( (ABS(nn_stock(1)) * js  +  nit000 - 1), nitend)
170               ENDDO
171               IF ( MAXVAL(nn_stock) < nitend ) THEN
172                  WRITE(cltimes,FMT='(i10)') (nitend - nit000 + 1)/nn_stock(1) + 1   
173                  CALL ctl_stop( 'rst_opn:', &   
174                  'Too many restart dump times to store in the array', &   
175                  'Increase jpstocks to ' // cltimes  ) 
176               ENDIF
177            ENDIF
178         ENDIF
179      ENDIF
180       
181      IF ( nwrite == 0 ) THEN
182         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
183         CALL ctl_warn( ctmp1 )
184         nwrite = nitend
185      ENDIF
186
187      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
188      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
189      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
190
191#if defined key_agrif
192      IF( Agrif_Root() ) THEN
193#endif
194      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
195      CASE (  1 ) 
196         CALL ioconf_calendar('gregorian')
197         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
198      CASE (  0 )
199         CALL ioconf_calendar('noleap')
200         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
201      CASE ( 30 )
202         CALL ioconf_calendar('360d')
203         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
204      END SELECT
205#if defined key_agrif
206      ENDIF
207#endif
208
209      REWIND( numnam )             ! Domain
210      READ  ( numnam, namdom )
211
212      IF(lwp) THEN
213         WRITE(numout,*) 
214         WRITE(numout,*) '   Namelist namdom : space & time domain'
215         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
216         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
217         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
218         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
219         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
220         WRITE(numout,*) '           = 0   no file created                 '
221         WRITE(numout,*) '           = 1   mesh_mask                       '
222         WRITE(numout,*) '           = 2   mesh and mask                   '
223         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
224         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
225         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
226         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
227         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
228         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
229         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
230         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
231         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
232      ENDIF
233
234      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
235      e3zps_min = rn_e3zps_min
236      e3zps_rat = rn_e3zps_rat
237      nmsh      = nn_msh
238      nacc      = nn_acc
239      atfp      = rn_atfp
240      rdt       = rn_rdt
241      rdtmin    = rn_rdtmin
242      rdtmax    = rn_rdtmin
243      rdth      = rn_rdth
244
245      REWIND( numnam )             ! Namelist cross land advection
246      READ  ( numnam, namcla )
247      IF(lwp) THEN
248         WRITE(numout,*)
249         WRITE(numout,*) '   Namelist namcla'
250         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
251      ENDIF
252
253#if defined key_netcdf4
254      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
255      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
256      READ  ( numnam, namnc4 )
257      IF(lwp) THEN                        ! control print
258         WRITE(numout,*)
259         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
260         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
261         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
262         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
263         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
264      ENDIF
265
266      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
267      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
268      snc4set%ni   = nn_nchunks_i
269      snc4set%nj   = nn_nchunks_j
270      snc4set%nk   = nn_nchunks_k
271      snc4set%luse = ln_nc4zip
272#else
273      snc4set%luse = .FALSE.        ! No NetCDF 4 case
274#endif
275      !
276   END SUBROUTINE dom_nam
277
278   SUBROUTINE dom_zgr
279      !!----------------------------------------------------------------------
280      !!                ***  ROUTINE dom_zgr  ***
281      !!                   
282      !! ** Purpose :  set the depth of model levels and the resulting
283      !!      vertical scale factors.
284      !!
285      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0)
286      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
287      !!              - vertical coordinate (gdep., e3.) depending on the
288      !!                coordinate chosen :
289      !!                   ln_zco=T   z-coordinate 
290      !!                   ln_zps=T   z-coordinate with partial steps
291      !!                   ln_zco=T   s-coordinate
292      !!
293      !! ** Action  :   define gdep., e3., mbathy and bathy
294      !!----------------------------------------------------------------------
295      INTEGER ::   ioptio = 0   ! temporary integer
296      !!
297      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
298      !!----------------------------------------------------------------------
299
300      REWIND ( numnam )                ! Read Namelist namzgr : vertical coordinate'
301      READ   ( numnam, namzgr )
302
303      IF(lwp) THEN                     ! Control print
304         WRITE(numout,*)
305         WRITE(numout,*) 'dom_zgr : vertical coordinate'
306         WRITE(numout,*) '~~~~~~~'
307         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
308         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
309         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
310         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
311      ENDIF
312
313      ioptio = 0                       ! Check Vertical coordinate options
314      IF( ln_zco ) ioptio = ioptio + 1
315      IF( ln_zps ) ioptio = ioptio + 1
316      IF( ln_sco ) ioptio = ioptio + 1
317      IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
318
319   END SUBROUTINE dom_zgr
320
321   SUBROUTINE dom_ctl
322      !!----------------------------------------------------------------------
323      !!                     ***  ROUTINE dom_ctl  ***
324      !!
325      !! ** Purpose :   Domain control.
326      !!
327      !! ** Method  :   compute and print extrema of masked scale factors
328      !!
329      !! History :
330      !!   8.5  !  02-08  (G. Madec)    Original code
331      !!----------------------------------------------------------------------
332      !! * Local declarations
333      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
334      INTEGER, DIMENSION(2) ::   iloc      !
335      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
336      !!----------------------------------------------------------------------
337
338      ! Extrema of the scale factors
339
340      IF(lwp)WRITE(numout,*)
341      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
342      IF(lwp)WRITE(numout,*) '~~~~~~~'
343
344      IF (lk_mpp) THEN
345         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
346         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
347         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
348         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
349      ELSE
350         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
351         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
352         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
353         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
354
355         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
356         iimi1 = iloc(1) + nimpp - 1
357         ijmi1 = iloc(2) + njmpp - 1
358         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
359         iimi2 = iloc(1) + nimpp - 1
360         ijmi2 = iloc(2) + njmpp - 1
361         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
362         iima1 = iloc(1) + nimpp - 1
363         ijma1 = iloc(2) + njmpp - 1
364         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
365         iima2 = iloc(1) + nimpp - 1
366         ijma2 = iloc(2) + njmpp - 1
367      ENDIF
368
369      IF(lwp) THEN
370         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
371         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
372         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
373         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
374      ENDIF
375
376   END SUBROUTINE dom_ctl
377
378   !!======================================================================
379END MODULE domain
Note: See TracBrowser for help on using the repository browser.