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 NEMO/branches/2019/ENHANCE-02_ISF_domcfg/src – NEMO

source: NEMO/branches/2019/ENHANCE-02_ISF_domcfg/src/domain.F90 @ 11568

Last change on this file since 11568 was 11308, checked in by mathiot, 5 years ago

ENHANCE-02_ISF_domcfg: create domisf to isolate isf related work and add new isf geometry computation used by UKESM (ticket #2142)

File size: 23.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   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
15   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
16   !!----------------------------------------------------------------------
17   
18   !!----------------------------------------------------------------------
19   !!   dom_init       : initialize the space and time domain
20   !!   dom_nam        : read and contral domain namelists
21   !!   dom_ctl        : control print for the ocean domain
22   !!----------------------------------------------------------------------
23   USE dom_oce         ! domain: ocean
24   USE phycst          ! physical constants
25   USE domhgr          ! domain: set the horizontal mesh
26   USE domzgr          ! domain: set the vertical mesh
27   USE dommsk          ! domain: set the mask system
28   USE domclo          ! domain: set closed sea mask
29   !
30   USE in_out_manager  ! I/O manager
31   USE iom             !
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   dom_init   ! called by opa.F90
37   PUBLIC   dom_nam  ! called by opa.F90
38   PUBLIC   cfg_write   ! called by opa.F90
39
40   !!-------------------------------------------------------------------------
41   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
42   !! $Id: domain.F90 6140 2015-12-21 11:35:23Z timgraham $
43   !! Software governed by the CeCILL licence        (./LICENSE)
44   !!-------------------------------------------------------------------------
45CONTAINS
46
47   SUBROUTINE dom_init
48      !!----------------------------------------------------------------------
49      !!                  ***  ROUTINE dom_init  ***
50      !!                   
51      !! ** Purpose :   Domain initialization. Call the routines that are
52      !!              required to create the arrays which define the space
53      !!              and time domain of the ocean model.
54      !!
55      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
56      !!              - dom_hgr: compute or read the horizontal grid-point position
57      !!                         and scale factors, and the coriolis factor
58      !!              - dom_zgr: define the vertical coordinate and the bathymetry
59      !!              - dom_stp: defined the model time step
60      !!              - dom_wri: create the meshmask file if nmsh=1
61      !!              - 1D configuration, move Coriolis, u and v at T-point
62      !!----------------------------------------------------------------------
63      INTEGER ::   jk          ! dummy loop indices
64      INTEGER ::   iconf = 0   ! local integers
65      REAL(wp), POINTER, DIMENSION(:,:) ::   z1_hu_0, z1_hv_0
66      !!----------------------------------------------------------------------
67      !
68      IF(lwp) THEN
69         WRITE(numout,*)
70         WRITE(numout,*) 'dom_init : domain initialization'
71         WRITE(numout,*) '~~~~~~~~'
72      ENDIF
73      !
74      !                       !==  Reference coordinate system  ==!
75      !
76      CALL dom_nam                  ! read namelist ( namrun, namdom )
77      !
78      CALL dom_hgr                  ! Horizontal mesh
79      !
80      CALL dom_zgr                  ! Vertical mesh and bathymetry
81      !
82      IF ( ln_domclo .OR. nmsh > 0 ) CALL dom_msk                  ! compute mask (needed by dom_clo
83      !
84      IF ( ln_domclo ) CALL dom_clo ! Closed seas and lake
85      !
86      CALL cfg_write                ! create the configuration file
87      !
88   END SUBROUTINE dom_init
89
90   SUBROUTINE dom_nam
91      !!----------------------------------------------------------------------
92      !!                     ***  ROUTINE dom_nam  ***
93      !!                   
94      !! ** Purpose :   read domaine namelists and print the variables.
95      !!
96      !! ** input   : - namrun namelist
97      !!              - namdom namelist
98      !!              - namnc4 namelist   ! "key_netcdf4" only
99      !!----------------------------------------------------------------------
100      USE ioipsl
101      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
102                       nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
103         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
104         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
105         &             ln_cfmeta, ln_iscpl
106      NAMELIST/namdom/ nn_bathy, cn_topo, cn_bath, cn_lon, cn_lat, nn_interp,                        &
107         &             rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,                       &
108         &             rn_atfp , rn_rdt   , ln_crs      , jphgr_msh ,                                &
109         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         &
110         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  &
111         &             ppa2, ppkth2, ppacr2
112
113
114
115      INTEGER  ::   ios                 ! Local integer output status for namelist read
116      !!----------------------------------------------------------------------
117
118      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
119      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
120901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
121
122      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
123      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
124902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
125      IF(lwm) WRITE ( numond, namrun )
126      !
127      IF(lwp) THEN                  ! control print
128         WRITE(numout,*)
129         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
130         WRITE(numout,*) '~~~~~~~ '
131         WRITE(numout,*) '   Namelist namrun'
132         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
133         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
134         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
135         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
136         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
137      ENDIF
138
139      cexper = cn_exp
140      nrstdt = nn_rstctl
141      nit000 = nn_it000
142      nitend = nn_itend
143      ndate0 = nn_date0
144      nleapy = nn_leapy
145      ninist = nn_istate
146      nstock = nn_stock
147      nstocklist = nn_stocklist
148      nwrite = nn_write
149      neuler = nn_euler
150      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
151         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
152         CALL ctl_warn( ctmp1 )
153         neuler = 0
154      ENDIF
155
156      !                             ! control of output frequency
157      IF ( nstock == 0 .OR. nstock > nitend ) THEN
158         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
159         CALL ctl_warn( ctmp1 )
160         nstock = nitend
161      ENDIF
162      IF ( nwrite == 0 ) THEN
163         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
164         CALL ctl_warn( ctmp1 )
165         nwrite = nitend
166      ENDIF
167
168
169
170
171      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
172      CASE (  1 ) 
173         CALL ioconf_calendar('gregorian')
174         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
175      CASE (  0 )
176         CALL ioconf_calendar('noleap')
177         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
178      CASE ( 30 )
179         CALL ioconf_calendar('360d')
180         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
181      END SELECT
182
183
184
185
186      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
187      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
188903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
189 
190      !
191      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
192      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
193904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
194      IF(lwm) WRITE ( numond, namdom )
195      !
196      IF(lwp) THEN
197         WRITE(numout,*)
198         WRITE(numout,*) '   Namelist namdom : space & time domain'
199         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
200         IF( nn_bathy == 2 ) THEN
201            WRITE(numout,*) '      compute bathymetry from file      cn_topo      = ', cn_topo
202         ENDIF   
203         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
204         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
205         WRITE(numout,*) '      min number of ocean level (<0)       '
206         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
207         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
208         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
209         WRITE(numout,*) '           = 0   no file created           '
210         WRITE(numout,*) '           = 1   mesh_mask                 '
211         WRITE(numout,*) '           = 2   mesh and mask             '
212         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
213         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
214         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
215         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
216         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
217         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
218         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
219         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
220         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
221         WRITE(numout,*) '                                        ppa0            = ', ppa0
222         WRITE(numout,*) '                                        ppa1            = ', ppa1
223         WRITE(numout,*) '                                        ppkth           = ', ppkth
224         WRITE(numout,*) '                                        ppacr           = ', ppacr
225         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
226         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
227         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
228         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
229         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
230         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
231      ENDIF
232      !
233      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
234      e3zps_min = rn_e3zps_min
235      e3zps_rat = rn_e3zps_rat
236      nmsh      = nn_msh
237      atfp      = rn_atfp
238      rdt       = rn_rdt
239
240      snc4set%luse = .FALSE.        ! No NetCDF 4 case
241      !
242   END SUBROUTINE dom_nam
243
244
245   SUBROUTINE dom_ctl
246      !!----------------------------------------------------------------------
247      !!                     ***  ROUTINE dom_ctl  ***
248      !!
249      !! ** Purpose :   Domain control.
250      !!
251      !! ** Method  :   compute and print extrema of masked scale factors
252      !!----------------------------------------------------------------------
253      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
254      INTEGER, DIMENSION(2) ::   iloc   !
255      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
256      !!----------------------------------------------------------------------
257      !
258#undef CHECK_DOM
259#ifdef CHECK_DOM
260      IF(lk_mpp) THEN
261         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
262         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
263         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
264         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
265      ELSE
266         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
267         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
268         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
269         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
270
271         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
272         iimi1 = iloc(1) + nimpp - 1
273         ijmi1 = iloc(2) + njmpp - 1
274         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
275         iimi2 = iloc(1) + nimpp - 1
276         ijmi2 = iloc(2) + njmpp - 1
277         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
278         iima1 = iloc(1) + nimpp - 1
279         ijma1 = iloc(2) + njmpp - 1
280         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
281         iima2 = iloc(1) + nimpp - 1
282         ijma2 = iloc(2) + njmpp - 1
283      ENDIF
284      IF(lwp) THEN
285         WRITE(numout,*)
286         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
287         WRITE(numout,*) '~~~~~~~'
288         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
289         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
290         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
291         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
292      ENDIF
293#endif
294      !
295   END SUBROUTINE dom_ctl
296
297
298   SUBROUTINE cfg_write
299      !!----------------------------------------------------------------------
300      !!                  ***  ROUTINE cfg_write  ***
301      !!                   
302      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which
303      !!              contains all the ocean domain informations required to
304      !!              define an ocean configuration.
305      !!
306      !! ** Method  :   Write in a file all the arrays required to set up an
307      !!              ocean configuration.
308      !!
309      !! ** output file :   domain_cfg.nc : domain size, characteristics,horizontal mesh,
310      !!                              Coriolis parameter, and vertical scale factors
311      !!                              NB: also contains ORCA family information (if cp_cfg = "ORCA")
312      !!                              and depths (ln_e3_dep=F)
313      !!----------------------------------------------------------------------
314      INTEGER           ::   ji, jj, jk   ! dummy loop indices
315      INTEGER           ::   izco, izps, isco, icav
316      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file
317      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
318      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
319      !!----------------------------------------------------------------------
320      !
321      IF(lwp) WRITE(numout,*)
322      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information'
323      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
324      !
325      !                       ! ============================= !
326      !                       !  create 'domain_cfg.nc' file  !
327      !                       ! ============================= !
328      !         
329      clnam = 'domain_cfg'  ! filename (configuration information)
330      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE.)!, kiolib = jprstlib )
331     
332      !
333      !                             !==  ORCA family specificities  ==!
334      IF( cp_cfg == "ORCA" ) THEN
335         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
336         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( jp_cfg, wp), ktype = jp_i4 )         
337      ENDIF
338      !                             !==  global domain size  ==!
339      !
340      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
341      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
342      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
343      !
344      !                             !==  domain characteristics  ==!
345      !
346      !                                   ! lateral boundary of the global
347      !                                   domain
348      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
349      !
350      !                                   ! type of vertical coordinate
351      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
352      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
353      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
354      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
355      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
356      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
357      !
358      !                                   ! ocean cavities under iceshelves
359      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
360      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
361      !
362      !                             !==  horizontal mesh  !
363      !
364      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
365      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
366      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
367      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
368      !                               
369      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
370      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
371      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
372      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
373      !                               
374      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
375      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
376      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
377      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
378      !
379      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
380      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
381      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
382      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
383      !
384      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
385      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
386      !
387      !                             !==  vertical mesh  ==!
388      !                                                     
389      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 )   !  reference 1D-coordinate
390      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 )
391      !
392      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   !  vertical scale factors (e
393      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 )
394      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 )
395      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 )
396      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 )
397      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 )
398      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 )
399      !
400      IF(.NOT.ln_e3_dep ) THEN                                             !  depth (t- & w-points)
401         CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   ! required only with 
402         CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 )   ! the old e3. definition
403         CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )
404         CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 )
405      ENDIF
406      !                                         
407      !                             !==  ocean top and bottom level  ==!
408      !
409      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
410      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
411      DO jj = 1,jpj
412         DO ji = 1,jpi
413            z2d (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
414         END DO
415      END DO
416      CALL iom_rstput( 0, 0, inum, 'bathy_metry_e3'   , z2d , ktype = jp_r4 )
417      DO jj = 1,jpj
418         DO ji = 1,jpi
419            z2d (ji,jj) = SUM ( e3t_0(ji,jj, 1:mikt(ji,jj)-1 ) ) * ssmask(ji,jj) 
420         END DO
421      END DO
422      CALL iom_rstput( 0, 0, inum, 'isf_draft_e3'   , z2d , ktype = jp_r4 )
423      CALL iom_rstput( 0, 0, inum, 'isf_draft'   , risfdep , ktype = jp_r4 )
424      CALL iom_rstput( 0, 0, inum, 'bathy_metry'   , bathy , ktype = jp_r4 )
425      CALL iom_rstput( 0, 0, inum, 'hw',bathy-risfdep, ktype = jp_r4 )
426      CALL iom_rstput( 0, 0, inum, 'mhw',mbkt*ssmask-mikt*ssmask, ktype = jp_i4 )
427      !
428      !                              !== closed sea ==!
429      IF (ln_domclo) THEN
430         ! mask for the open sea
431         CALL iom_rstput( 0, 0, inum, 'mask_opensea', msk_opnsea, ktype = jp_i4 )
432         ! mask for all the under closed sea
433         CALL iom_rstput( 0, 0, inum, 'mask_csundef', msk_closea, ktype = jp_i4 )
434         ! mask for global, local net precip, local net precip and evaporation correction
435         CALL iom_rstput( 0, 0, inum, 'mask_csglo', msk_glo, ktype = jp_i4 )
436         CALL iom_rstput( 0, 0, inum, 'mask_csemp', msk_emp, ktype = jp_i4 )
437         CALL iom_rstput( 0, 0, inum, 'mask_csrnf', msk_rnf, ktype = jp_i4 )
438         ! mask for the various river mouth (in case multiple lake in the same outlet)
439         CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_gloid, ktype = jp_i4 )
440         CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_empid, ktype = jp_i4 )
441         CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_rnfid, ktype = jp_i4 )
442      END IF
443      !
444      !                                ! ============================
445      !                                !        close the files
446      !                                ! ============================
447      CALL iom_close( inum )
448      !
449   END SUBROUTINE cfg_write
450
451
452
453   !!======================================================================
454END MODULE domain
Note: See TracBrowser for help on using the repository browser.