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

source: branches/2012/dev_r3452_UKMO9_RESTART/NEMOGCM/NEMO/OPA_SRC/DOM/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   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
7   !!                 !  1992-01  (M. Imbard) insert time step initialization
8   !!                 !  1996-06  (G. Madec) generalized vertical coordinate
9   !!                 !  1997-02  (G. Madec) creation of domwri.F
10   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
11   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
12   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
13   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
14   !!----------------------------------------------------------------------
15   
16   !!----------------------------------------------------------------------
17   !!   dom_init       : initialize the space and time domain
18   !!   dom_nam        : read and contral domain namelists
19   !!   dom_ctl        : control print for the ocean domain
20   !!----------------------------------------------------------------------
21   USE oce             ! ocean variables
22   USE dom_oce         ! domain: ocean
23   USE sbc_oce         ! surface boundary condition: ocean
24   USE phycst          ! physical constants
25   USE closea          ! closed seas
26   USE in_out_manager  ! I/O manager
27   USE lib_mpp         ! distributed memory computing library
28
29   USE domhgr          ! domain: set the horizontal mesh
30   USE domzgr          ! domain: set the vertical mesh
31   USE domstp          ! domain: set the time-step
32   USE dommsk          ! domain: set the mask system
33   USE domwri          ! domain: write the meshmask file
34   USE domvvl          ! variable volume
35   USE c1d             ! 1D vertical configuration
36   USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
37   USE timing          ! Timing
38
39   IMPLICIT NONE
40   PRIVATE
41
42   PUBLIC   dom_init   ! called by opa.F90
43
44   !! * Substitutions
45#  include "domzgr_substitute.h90"
46   !!-------------------------------------------------------------------------
47   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
48   !! $Id$
49   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
50   !!-------------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE dom_init
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE dom_init  ***
56      !!                   
57      !! ** Purpose :   Domain initialization. Call the routines that are
58      !!              required to create the arrays which define the space
59      !!              and time domain of the ocean model.
60      !!
61      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
62      !!              - dom_hgr: compute or read the horizontal grid-point position
63      !!                         and scale factors, and the coriolis factor
64      !!              - dom_zgr: define the vertical coordinate and the bathymetry
65      !!              - dom_stp: defined the model time step
66      !!              - dom_wri: create the meshmask file if nmsh=1
67      !!              - 1D configuration, move Coriolis, u and v at T-point
68      !!----------------------------------------------------------------------
69      INTEGER ::   jk                ! dummy loop argument
70      INTEGER ::   iconf = 0         ! temporary integers
71      !!----------------------------------------------------------------------
72      !
73      IF( nn_timing == 1 )  CALL timing_start('dom_init')
74      !
75      IF(lwp) THEN
76         WRITE(numout,*)
77         WRITE(numout,*) 'dom_init : domain initialization'
78         WRITE(numout,*) '~~~~~~~~'
79      ENDIF
80      !
81                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
82                             CALL dom_clo      ! Closed seas and lake
83                             CALL dom_hgr      ! Horizontal mesh
84                             CALL dom_zgr      ! Vertical mesh and bathymetry
85                             CALL dom_msk      ! Masks
86      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
87      !
88      IF( lk_c1d ) THEN                        ! 1D configuration
89         CALL cor_c1d                          ! Coriolis set at T-point
90         umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point
91         vmask(:,:,:) = tmask(:,:,:)
92      END IF
93      !
94      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
95      hv(:,:) = 0.e0
96      DO jk = 1, jpk
97         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
98         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
99      END DO
100      !                                        ! Inverse of the local depth
101      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
102      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
103
104                             CALL dom_stp      ! time step
105      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
106      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
107      !
108      IF( nn_timing == 1 )  CALL timing_stop('dom_init')
109      !
110   END SUBROUTINE dom_init
111
112
113   SUBROUTINE dom_nam
114      !!----------------------------------------------------------------------
115      !!                     ***  ROUTINE dom_nam  ***
116      !!                   
117      !! ** Purpose :   read domaine namelists and print the variables.
118      !!
119      !! ** input   : - namrun namelist
120      !!              - namdom namelist
121      !!              - namcla namelist
122      !!              - namnc4 namelist   ! "key_netcdf4" only
123      !!----------------------------------------------------------------------
124      USE ioipsl
125
126      INTEGER  ::   js               ! dummy loop indice
127      CHARACTER(LEN=10)   ::   cltimes  ! restart dump times needed
128
129      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
130         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
131         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
132      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
133         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
134         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
135      NAMELIST/namcla/ nn_cla
136#if defined key_netcdf4
137      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
138#endif
139      !!----------------------------------------------------------------------
140
141      REWIND( numnam )              ! Namelist namrun : parameters of the run
142      READ  ( numnam, namrun )
143      !
144      IF(lwp) THEN                  ! control print
145         WRITE(numout,*)
146         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
147         WRITE(numout,*) '~~~~~~~ '
148         WRITE(numout,*) '   Namelist namrun'
149         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
150         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
151         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
152         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
153         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
154         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
155         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
156         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
157         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
158         IF ( nn_stock(1) < 0 ) THEN
159            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', ABS(nn_stock(1))
160         ELSE
161            WRITE(numout,*) '      list of restart times           nn_stock   = ', nn_stock
162         ENDIF
163         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
164         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
165         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
166         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
167         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
168      ENDIF
169
170      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
171      cexper = cn_exp
172      nrstdt = nn_rstctl
173      nit000 = nn_it000
174      nitend = nn_itend
175      ndate0 = nn_date0
176      nleapy = nn_leapy
177      ninist = nn_istate
178      nwrite = nn_write
179
180
181      !                             ! control of output frequency
182      IF ( ALL(nn_stock == 0) ) THEN
183         WRITE(ctmp1,*) 'No restart output times specified, restart forced to output at end of run, kt = ', nitend
184         CALL ctl_warn( ctmp1 )
185         nn_stock(1) = nitend
186      ELSE
187         IF ( nn_stock(1) > 0 ) THEN
188            DO js=1,size(nn_stock)-1
189               IF ( nn_stock(js+1) <= nn_stock(js) .AND. nn_stock(js+1) .NE. 0.0 ) THEN
190                  WRITE(ctmp1,*) 'Restart times in nn_stock not monotonically increasing, some values ignored'
191                  CALL ctl_warn( ctmp1 )
192               ENDIF
193            ENDDO
194            IF ( ANY(nn_stock > nitend) ) THEN
195               WRITE(ctmp1,*) 'some values of nn_stock exceed run length they are forced to end of run, kt = ', nitend
196               CALL ctl_warn( ctmp1 )
197               WHERE (nn_stock > nitend ) nn_stock=nitend
198            ENDIF
199         ELSEIF ( nn_stock(1) < 0 ) THEN
200            IF ( ABS(nn_stock(1)) > nitend ) THEN
201               WRITE(ctmp1,*) 'Attempting to output restarts at frequency greater than run legth, restart forced to output at end of run, kt = ', nitend
202               CALL ctl_warn( ctmp1 )
203               nn_stock(1) = nitend
204            ELSE
205               DO js=1,SIZE(nn_stock) 
206                  nn_stock(js) = MIN( (ABS(nn_stock(1)) * js  +  nit000 - 1), nitend)
207               ENDDO
208               IF ( MAXVAL(nn_stock) < nitend ) THEN
209                  WRITE(cltimes,FMT='(i10)') (nitend - nit000 + 1)/nn_stock(1) + 1   
210                  CALL ctl_stop( 'rst_opn:', &   
211                  'Too many restart dump times to store in the array', &   
212                  'Increase jpstocks to ' // cltimes  ) 
213               ENDIF
214            ENDIF
215         ENDIF
216      ENDIF
217       
218      IF ( nwrite == 0 ) THEN
219         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
220         CALL ctl_warn( ctmp1 )
221         nwrite = nitend
222      ENDIF
223
224#if defined key_agrif
225      IF( Agrif_Root() ) THEN
226#endif
227      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
228      CASE (  1 ) 
229         CALL ioconf_calendar('gregorian')
230         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
231      CASE (  0 )
232         CALL ioconf_calendar('noleap')
233         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
234      CASE ( 30 )
235         CALL ioconf_calendar('360d')
236         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
237      END SELECT
238#if defined key_agrif
239      ENDIF
240#endif
241
242      REWIND( numnam )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
243      READ  ( numnam, namdom )
244
245      IF(lwp) THEN
246         WRITE(numout,*)
247         WRITE(numout,*) '   Namelist namdom : space & time domain'
248         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
249         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
250         WRITE(numout,*) '      min number of ocean level (<0)       '
251         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
252         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
253         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
254         WRITE(numout,*) '           = 0   no file created           '
255         WRITE(numout,*) '           = 1   mesh_mask                 '
256         WRITE(numout,*) '           = 2   mesh and mask             '
257         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
258         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
259         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
260         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
261         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
262         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
263         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
264         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
265         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
266      ENDIF
267
268      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
269      e3zps_min = rn_e3zps_min
270      e3zps_rat = rn_e3zps_rat
271      nmsh      = nn_msh
272      nacc      = nn_acc
273      atfp      = rn_atfp
274      rdt       = rn_rdt
275      rdtmin    = rn_rdtmin
276      rdtmax    = rn_rdtmin
277      rdth      = rn_rdth
278
279      REWIND( numnam )              ! Namelist cross land advection
280      READ  ( numnam, namcla )
281      IF(lwp) THEN
282         WRITE(numout,*)
283         WRITE(numout,*) '   Namelist namcla'
284         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
285      ENDIF
286
287#if defined key_netcdf4
288      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
289      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
290      READ  ( numnam, namnc4 )
291      IF(lwp) THEN                        ! control print
292         WRITE(numout,*)
293         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
294         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
295         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
296         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
297         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
298      ENDIF
299
300      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
301      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
302      snc4set%ni   = nn_nchunks_i
303      snc4set%nj   = nn_nchunks_j
304      snc4set%nk   = nn_nchunks_k
305      snc4set%luse = ln_nc4zip
306#else
307      snc4set%luse = .FALSE.        ! No NetCDF 4 case
308#endif
309      !
310   END SUBROUTINE dom_nam
311
312
313   SUBROUTINE dom_ctl
314      !!----------------------------------------------------------------------
315      !!                     ***  ROUTINE dom_ctl  ***
316      !!
317      !! ** Purpose :   Domain control.
318      !!
319      !! ** Method  :   compute and print extrema of masked scale factors
320      !!----------------------------------------------------------------------
321      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
322      INTEGER, DIMENSION(2) ::   iloc   !
323      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
324      !!----------------------------------------------------------------------
325      !
326      IF(lk_mpp) THEN
327         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
328         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
329         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
330         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
331      ELSE
332         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
333         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
334         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
335         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
336
337         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
338         iimi1 = iloc(1) + nimpp - 1
339         ijmi1 = iloc(2) + njmpp - 1
340         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
341         iimi2 = iloc(1) + nimpp - 1
342         ijmi2 = iloc(2) + njmpp - 1
343         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
344         iima1 = iloc(1) + nimpp - 1
345         ijma1 = iloc(2) + njmpp - 1
346         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
347         iima2 = iloc(1) + nimpp - 1
348         ijma2 = iloc(2) + njmpp - 1
349      ENDIF
350      IF(lwp) THEN
351         WRITE(numout,*)
352         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
353         WRITE(numout,*) '~~~~~~~'
354         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
355         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
356         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
357         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
358      ENDIF
359      !
360   END SUBROUTINE dom_ctl
361
362   !!======================================================================
363END MODULE domain
Note: See TracBrowser for help on using the repository browser.