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

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 3211

Last change on this file since 3211 was 3211, checked in by spickles2, 13 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.
  • Property svn:keywords set to Id
File size: 16.3 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
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC   dom_init   ! called by opa.F90
42
43   !! * Control permutation of array indices
44#  include "oce_ftrans.h90"
45#  include "dom_oce_ftrans.h90"
46#  include "sbc_oce_ftrans.h90"
47#  include "domvvl_ftrans.h90"
48
49   !! * Substitutions
50#  include "domzgr_substitute.h90"
51   !!-------------------------------------------------------------------------
52   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
53   !! $Id$
54   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
55   !!-------------------------------------------------------------------------
56CONTAINS
57
58   SUBROUTINE dom_init
59      !!----------------------------------------------------------------------
60      !!                  ***  ROUTINE dom_init  ***
61      !!                   
62      !! ** Purpose :   Domain initialization. Call the routines that are
63      !!              required to create the arrays which define the space
64      !!              and time domain of the ocean model.
65      !!
66      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
67      !!              - dom_hgr: compute or read the horizontal grid-point position
68      !!                         and scale factors, and the coriolis factor
69      !!              - dom_zgr: define the vertical coordinate and the bathymetry
70      !!              - dom_stp: defined the model time step
71      !!              - dom_wri: create the meshmask file if nmsh=1
72      !!              - 1D configuration, move Coriolis, u and v at T-point
73      !!----------------------------------------------------------------------
74      INTEGER ::   jk                ! dummy loop argument
75      INTEGER ::   iconf = 0         ! temporary integers
76      !!----------------------------------------------------------------------
77      !
78      IF(lwp) THEN
79         WRITE(numout,*)
80         WRITE(numout,*) 'dom_init : domain initialization'
81         WRITE(numout,*) '~~~~~~~~'
82      ENDIF
83      !
84                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
85                             CALL dom_clo      ! Closed seas and lake
86                             CALL dom_hgr      ! Horizontal mesh
87                             CALL dom_zgr      ! Vertical mesh and bathymetry
88                             CALL dom_msk      ! Masks
89      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
90      !
91      IF( lk_c1d ) THEN                        ! 1D configuration
92         CALL cor_c1d                          ! Coriolis set at T-point
93         umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point
94         vmask(:,:,:) = tmask(:,:,:)
95#if defined key_z_first
96         umask_1(:,:) = umask(:,:,1)
97         vmask_1(:,:) = vmask(:,:,1)
98#endif
99      END IF
100      !
101      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
102      hv(:,:) = 0.e0
103      DO jk = 1, jpk
104         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
105         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
106      END DO
107      !                                        ! Inverse of the local depth
108#if defined key_z_first
109      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask_1(:,:) ) * umask_1(:,:)
110      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask_1(:,:) ) * vmask_1(:,:)
111#else
112      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
113      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
114#endif
115
116                             CALL dom_stp      ! time step
117      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
118      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
119      !
120   END SUBROUTINE dom_init
121
122
123   SUBROUTINE dom_nam
124      !!----------------------------------------------------------------------
125      !!                     ***  ROUTINE dom_nam  ***
126      !!                   
127      !! ** Purpose :   read domaine namelists and print the variables.
128      !!
129      !! ** input   : - namrun namelist
130      !!              - namdom namelist
131      !!              - namcla namelist
132      !!              - namnc4 namelist   ! "key_netcdf4" only
133      !!----------------------------------------------------------------------
134      USE ioipsl
135      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
136         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
137         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
138      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
139         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
140         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
141      NAMELIST/namcla/ nn_cla
142#if defined key_netcdf4
143      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
144#endif
145      !!----------------------------------------------------------------------
146
147      REWIND( numnam )              ! Namelist namrun : parameters of the run
148      READ  ( numnam, namrun )
149      !
150      IF(lwp) THEN                  ! control print
151         WRITE(numout,*)
152         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
153         WRITE(numout,*) '~~~~~~~ '
154         WRITE(numout,*) '   Namelist namrun'
155         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
156         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
157         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
158         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
159         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
160         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
161         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
162         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
163         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
164         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
165         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
166         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
167         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
168         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
169         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
170      ENDIF
171
172      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
173      cexper = cn_exp
174      nrstdt = nn_rstctl
175      nit000 = nn_it000
176      nitend = nn_itend
177      ndate0 = nn_date0
178      nleapy = nn_leapy
179      ninist = nn_istate
180      nstock = nn_stock
181      nwrite = nn_write
182
183
184      !                             ! control of output frequency
185      IF ( nstock == 0 .OR. nstock > nitend ) THEN
186         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
187         CALL ctl_warn( ctmp1 )
188         nstock = nitend
189      ENDIF
190      IF ( nwrite == 0 ) THEN
191         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
192         CALL ctl_warn( ctmp1 )
193         nwrite = nitend
194      ENDIF
195
196#if defined key_agrif
197      IF( Agrif_Root() ) THEN
198#endif
199      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
200      CASE (  1 ) 
201         CALL ioconf_calendar('gregorian')
202         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
203      CASE (  0 )
204         CALL ioconf_calendar('noleap')
205         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
206      CASE ( 30 )
207         CALL ioconf_calendar('360d')
208         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
209      END SELECT
210#if defined key_agrif
211      ENDIF
212#endif
213
214      REWIND( numnam )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
215      READ  ( numnam, namdom )
216
217      IF(lwp) THEN
218         WRITE(numout,*)
219         WRITE(numout,*) '   Namelist namdom : space & time domain'
220         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
221         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
222         WRITE(numout,*) '      min number of ocean level (<0)       '
223         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
224         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
225         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
226         WRITE(numout,*) '           = 0   no file created           '
227         WRITE(numout,*) '           = 1   mesh_mask                 '
228         WRITE(numout,*) '           = 2   mesh and mask             '
229         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
230         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
231         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
232         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
233         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
234         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
235         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
236         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
237         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
238      ENDIF
239
240      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
241      e3zps_min = rn_e3zps_min
242      e3zps_rat = rn_e3zps_rat
243      nmsh      = nn_msh
244      nacc      = nn_acc
245      atfp      = rn_atfp
246      rdt       = rn_rdt
247      rdtmin    = rn_rdtmin
248      rdtmax    = rn_rdtmin
249      rdth      = rn_rdth
250      nclosea   = nn_closea
251
252      REWIND( numnam )              ! Namelist cross land advection
253      READ  ( numnam, namcla )
254      IF(lwp) THEN
255         WRITE(numout,*)
256         WRITE(numout,*) '   Namelist namcla'
257         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
258      ENDIF
259
260#if defined key_netcdf4
261      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
262      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
263      READ  ( numnam, namnc4 )
264      IF(lwp) THEN                        ! control print
265         WRITE(numout,*)
266         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
267         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
268         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
269         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
270         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
271      ENDIF
272
273      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
274      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
275      snc4set%ni   = nn_nchunks_i
276      snc4set%nj   = nn_nchunks_j
277      snc4set%nk   = nn_nchunks_k
278      snc4set%luse = ln_nc4zip
279#else
280      snc4set%luse = .FALSE.        ! No NetCDF 4 case
281#endif
282      !
283   END SUBROUTINE dom_nam
284
285
286   SUBROUTINE dom_ctl
287      !!----------------------------------------------------------------------
288      !!                     ***  ROUTINE dom_ctl  ***
289      !!
290      !! ** Purpose :   Domain control.
291      !!
292      !! ** Method  :   compute and print extrema of masked scale factors
293      !!----------------------------------------------------------------------
294      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
295      INTEGER, DIMENSION(2) ::   iloc   !
296      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
297      !!----------------------------------------------------------------------
298      !
299      IF(lk_mpp) THEN
300#if defined key_z_first
301         CALL mpp_minloc( e1t(:,:), tmask_1(:,:), ze1min, iimi1,ijmi1 )
302         CALL mpp_minloc( e2t(:,:), tmask_1(:,:), ze2min, iimi2,ijmi2 )
303         CALL mpp_maxloc( e1t(:,:), tmask_1(:,:), ze1max, iima1,ijma1 )
304         CALL mpp_maxloc( e2t(:,:), tmask_1(:,:), ze2max, iima2,ijma2 )
305#else
306         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
307         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
308         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
309         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
310#endif
311      ELSE
312         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
313         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
314         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
315         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
316
317         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
318         iimi1 = iloc(1) + nimpp - 1
319         ijmi1 = iloc(2) + njmpp - 1
320         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
321         iimi2 = iloc(1) + nimpp - 1
322         ijmi2 = iloc(2) + njmpp - 1
323         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
324         iima1 = iloc(1) + nimpp - 1
325         ijma1 = iloc(2) + njmpp - 1
326         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
327         iima2 = iloc(1) + nimpp - 1
328         ijma2 = iloc(2) + njmpp - 1
329      ENDIF
330      IF(lwp) THEN
331         WRITE(numout,*)
332         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
333         WRITE(numout,*) '~~~~~~~'
334         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
335         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
336         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
337         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
338      ENDIF
339      !
340   END SUBROUTINE dom_ctl
341
342   !!======================================================================
343END MODULE domain
Note: See TracBrowser for help on using the repository browser.