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/2015/dev_r5056_CMCC4_simplification/NEMOGCM/NEMO/OFF_SRC – NEMO

source: branches/2015/dev_r5056_CMCC4_simplification/NEMOGCM/NEMO/OFF_SRC/domain.F90 @ 5282

Last change on this file since 5282 was 5282, checked in by diovino, 9 years ago

Dev. branch CMCC4_simplification ticket #1456

  • Property svn:keywords set to Id
File size: 19.8 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 ::   jk                ! dummy loop argument
62      INTEGER ::   iconf = 0         ! temporary integers
63      !!----------------------------------------------------------------------
64
65      IF(lwp) THEN
66         WRITE(numout,*)
67         WRITE(numout,*) 'dom_init : domain initialization'
68         WRITE(numout,*) '~~~~~~~~'
69      ENDIF
70
71      CALL dom_nam      ! read namelist ( namrun, namdom )
72      CALL dom_zgr      ! Vertical mesh and bathymetry option
73      CALL dom_rea      ! Create a domain file
74
75     !
76      ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines
77      !        but could be usefull in many other routines
78      e12t    (:,:) = e1t(:,:) * e2t(:,:)
79      e1e2t   (:,:) = e1t(:,:) * e2t(:,:)
80      e12u    (:,:) = e1u(:,:) * e2u(:,:)
81      e12v    (:,:) = e1v(:,:) * e2v(:,:)
82      e12f    (:,:) = e1f(:,:) * e2f(:,:)
83      r1_e12t (:,:) = 1._wp    / e12t(:,:)
84      r1_e12u (:,:) = 1._wp    / e12u(:,:)
85      r1_e12v (:,:) = 1._wp    / e12v(:,:)
86      r1_e12f (:,:) = 1._wp    / e12f(:,:)
87      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
88      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
89      !
90      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points
91      hv(:,:) = 0._wp
92      DO jk = 1, jpk
93         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
94         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
95      END DO
96      !                                        ! Inverse of the local depth
97      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
98      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
99
100      CALL dom_stp      ! Time step
101      CALL dom_msk      ! Masks
102      CALL dom_ctl      ! Domain control
103
104   END SUBROUTINE dom_init
105
106   SUBROUTINE dom_nam
107      !!----------------------------------------------------------------------
108      !!                     ***  ROUTINE dom_nam  ***
109      !!                   
110      !! ** Purpose :   read domaine namelists and print the variables.
111      !!
112      !! ** input   : - namrun namelist
113      !!              - namdom namelist
114      !!----------------------------------------------------------------------
115      USE ioipsl
116      INTEGER  ::   ios                 ! Local integer output status for namelist read
117      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
118         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
119         &             nn_write, ln_mskland  , ln_clobber   , nn_chunksz, nn_euler
120      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
121         &             rn_atfp  , rn_rdt   , nn_baro     , nn_closea , ln_crs, jphgr_msh,  &
122         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
123         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
124         &             ppa2, ppkth2, ppacr2
125#if defined key_netcdf4
126      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
127#endif
128      !!----------------------------------------------------------------------
129
130      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
131      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
132901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
133
134      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
135      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
136902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
137      IF(lwm) WRITE ( numond, namrun )
138      !
139      IF(lwp) THEN                  ! control print
140         WRITE(numout,*)
141         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
142         WRITE(numout,*) '~~~~~~~ '
143         WRITE(numout,*) '   Namelist namrun' 
144         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
145         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
146         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
147         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
148         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
149         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
150         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
151         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
152         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
153         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
154         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
155         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
156         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
157         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
158      ENDIF
159      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
160      cexper = cn_exp
161      nrstdt = nn_rstctl
162      nit000 = nn_it000
163      nitend = nn_itend
164      ndate0 = nn_date0
165      nleapy = nn_leapy
166      ninist = nn_istate
167      nstock = nn_stock
168      nwrite = nn_write
169
170
171      !                             ! control of output frequency
172      IF ( nstock == 0 .OR. nstock > nitend ) THEN
173         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
174         CALL ctl_warn( ctmp1 )
175         nstock = nitend
176      ENDIF
177      IF ( nwrite == 0 ) THEN
178         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
179         CALL ctl_warn( ctmp1 )
180         nwrite = nitend
181      ENDIF
182
183      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
184      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
185      adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday
186
187#if defined key_agrif
188      IF( Agrif_Root() ) THEN
189#endif
190      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
191      CASE (  1 ) 
192         CALL ioconf_calendar('gregorian')
193         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
194      CASE (  0 )
195         CALL ioconf_calendar('noleap')
196         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
197      CASE ( 30 )
198         CALL ioconf_calendar('360d')
199         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
200      END SELECT
201#if defined key_agrif
202      ENDIF
203#endif
204
205      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
206      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
207903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
208
209      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
210      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
211904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
212      IF(lwm) WRITE ( numond, namdom )
213
214      IF(lwp) THEN
215         WRITE(numout,*) 
216         WRITE(numout,*) '   Namelist namdom : space & time domain'
217         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
218         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
219         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
220         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
221         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
222         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
223         WRITE(numout,*) '           = 0   no file created                 '
224         WRITE(numout,*) '           = 1   mesh_mask                       '
225         WRITE(numout,*) '           = 2   mesh and mask                   '
226         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
227         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
228         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
229         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
230         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
231         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
232         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
233         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
234         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
235         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
236         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
237         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
238         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
239         WRITE(numout,*) '                                        ppa0            = ', ppa0
240         WRITE(numout,*) '                                        ppa1            = ', ppa1
241         WRITE(numout,*) '                                        ppkth           = ', ppkth
242         WRITE(numout,*) '                                        ppacr           = ', ppacr
243         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
244         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
245         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
246         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
247         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
248         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
249      ENDIF
250
251      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
252      e3zps_min = rn_e3zps_min
253      e3zps_rat = rn_e3zps_rat
254      nmsh      = nn_msh
255      atfp      = rn_atfp
256      rdt       = rn_rdt
257#if defined key_netcdf4
258      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
259      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
260      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
261907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
262
263      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
264      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
265908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
266      IF(lwm) WRITE( numond, namnc4 )
267      IF(lwp) THEN                        ! control print
268         WRITE(numout,*)
269         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
270         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
271         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
272         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
273         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
274      ENDIF
275
276      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
277      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
278      snc4set%ni   = nn_nchunks_i
279      snc4set%nj   = nn_nchunks_j
280      snc4set%nk   = nn_nchunks_k
281      snc4set%luse = ln_nc4zip
282#else
283      snc4set%luse = .FALSE.        ! No NetCDF 4 case
284#endif
285      !
286   END SUBROUTINE dom_nam
287
288   SUBROUTINE dom_zgr
289      !!----------------------------------------------------------------------
290      !!                ***  ROUTINE dom_zgr  ***
291      !!                   
292      !! ** Purpose :  set the depth of model levels and the resulting
293      !!      vertical scale factors.
294      !!
295      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
296      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
297      !!              - vertical coordinate (gdep., e3.) depending on the
298      !!                coordinate chosen :
299      !!                   ln_zco=T   z-coordinate 
300      !!                   ln_zps=T   z-coordinate with partial steps
301      !!                   ln_zco=T   s-coordinate
302      !!
303      !! ** Action  :   define gdep., e3., mbathy and bathy
304      !!----------------------------------------------------------------------
305      INTEGER ::   ioptio = 0   ! temporary integer
306      INTEGER ::   ios
307      !!
308      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
309      !!----------------------------------------------------------------------
310
311      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
312      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
313901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
314
315      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
316      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
317902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
318      IF(lwm) WRITE ( numond, namzgr )
319
320      IF(lwp) THEN                     ! Control print
321         WRITE(numout,*)
322         WRITE(numout,*) 'dom_zgr : vertical coordinate'
323         WRITE(numout,*) '~~~~~~~'
324         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
325         WRITE(numout,*) '             z-coordinate - full steps      ln_zco    = ', ln_zco
326         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps    = ', ln_zps
327         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
328         WRITE(numout,*) '             ice shelf cavity               ln_isfcav = ', ln_isfcav
329      ENDIF
330
331      ioptio = 0                       ! Check Vertical coordinate options
332      IF( ln_zco ) ioptio = ioptio + 1
333      IF( ln_zps ) ioptio = ioptio + 1
334      IF( ln_sco ) ioptio = ioptio + 1
335      IF( ln_isfcav ) ioptio = 33
336      IF ( ioptio /= 1  )   CALL ctl_stop( ' none or several vertical coordinate options used' )
337      IF ( ioptio == 33 )   CALL ctl_stop( ' isf cavity with off line module not yet done    ' )
338
339   END SUBROUTINE dom_zgr
340
341   SUBROUTINE dom_ctl
342      !!----------------------------------------------------------------------
343      !!                     ***  ROUTINE dom_ctl  ***
344      !!
345      !! ** Purpose :   Domain control.
346      !!
347      !! ** Method  :   compute and print extrema of masked scale factors
348      !!
349      !! History :
350      !!   8.5  !  02-08  (G. Madec)    Original code
351      !!----------------------------------------------------------------------
352      !! * Local declarations
353      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
354      INTEGER, DIMENSION(2) ::   iloc      !
355      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
356      !!----------------------------------------------------------------------
357
358      ! Extrema of the scale factors
359
360      IF(lwp)WRITE(numout,*)
361      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
362      IF(lwp)WRITE(numout,*) '~~~~~~~'
363
364      IF (lk_mpp) THEN
365         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
366         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
367         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
368         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
369      ELSE
370         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
371         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
372         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
373         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
374
375         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
376         iimi1 = iloc(1) + nimpp - 1
377         ijmi1 = iloc(2) + njmpp - 1
378         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
379         iimi2 = iloc(1) + nimpp - 1
380         ijmi2 = iloc(2) + njmpp - 1
381         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
382         iima1 = iloc(1) + nimpp - 1
383         ijma1 = iloc(2) + njmpp - 1
384         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
385         iima2 = iloc(1) + nimpp - 1
386         ijma2 = iloc(2) + njmpp - 1
387      ENDIF
388
389      IF(lwp) THEN
390         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
391         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
392         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
393         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
394      ENDIF
395
396   END SUBROUTINE dom_ctl
397
398   !!======================================================================
399END MODULE domain
Note: See TracBrowser for help on using the repository browser.