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 @ 4400

Last change on this file since 4400 was 3837, checked in by trackstand2, 11 years ago

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