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 utils/tools/DOMAINcfg/src – NEMO

source: utils/tools/DOMAINcfg/src/domain.F90 @ 14095

Last change on this file since 14095 was 13390, checked in by mathiot, 4 years ago

ticket #2502: merge ticket branch into trunk. DOMAIN_cfg namelist contains now fields to specify input files names (bathy meter and level files, coord file, isf draft meter and level files), save it into the netcdf (dom_doc.exe) and re-generate the namelist if needed (xtrac_namelist.bash). The usage is documented in the DOMAIN_cfg README.rst.

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