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

Last change on this file since 14684 was 14684, checked in by jchanut, 3 years ago

Allow chosing type of input bathymetry in child grids again (wrongly introduced @14630), #2638

File size: 26.6 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_glo                     ! global domain versus local domain
79      CALL dom_nam               ! read namelist ( namrun, namdom )
80                  !   CALL dom_clo               ! Closed seas and lake
81         
82      CALL dom_hgr               ! Horizontal mesh
83      CALL dom_zgr( ik_top, ik_bot )  ! Vertical mesh and bathymetry
84      CALL dom_msk( ik_top, ik_bot )  ! Masks
85      !
86      !
87      CALL dom_ctl                  ! print extrema of masked scale factors
88      !
89#if ! defined key_agrif
90      CALL cfg_write                ! create the configuration file
91#endif
92      !
93   END SUBROUTINE dom_init
94
95   SUBROUTINE dom_glo
96      !!----------------------------------------------------------------------
97      !!                     ***  ROUTINE dom_glo  ***
98      !!
99      !! ** Purpose :   initialization of global domain <--> local domain indices
100      !!
101      !! ** Method  :   
102      !!
103      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices
104      !!              - mig0, mjg0: local  domain indices ==> global domain, excluding halos, indices
105      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
106      !!              - mj0 , mj1   (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
107      !!----------------------------------------------------------------------
108      INTEGER ::   ji, jj   ! dummy loop argument
109      !!----------------------------------------------------------------------
110      !
111      DO ji = 1, jpi                 ! local domain indices ==> global domain, including halos, indices
112        mig(ji) = ji + nimpp - 1
113      END DO
114      DO jj = 1, jpj
115        mjg(jj) = jj + njmpp - 1
116      END DO
117      !                              ! local domain indices ==> global domain, excluding halos, indices
118      !
119      mig0(:) = mig(:) - nn_hls
120      mjg0(:) = mjg(:) - nn_hls 
121      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,
122      ! we must define mig0 and mjg0 as bellow.
123      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as:
124      mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) )
125      mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) )
126      !
127      !                              ! global domain, including halos, indices ==> local domain indices
128      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
129      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
130      DO ji = 1, jpiglo
131        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
132        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
133      END DO
134      DO jj = 1, jpjglo
135        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
136        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
137      END DO
138      IF(lwp) THEN                   ! control print
139         WRITE(numout,*)
140         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
141         WRITE(numout,*) '~~~~~~~ '
142         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
143         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
144         WRITE(numout,*)
145      ENDIF
146      !
147   END SUBROUTINE dom_glo
148
149   SUBROUTINE dom_nam
150      !!----------------------------------------------------------------------
151      !!                     ***  ROUTINE dom_nam  ***
152      !!                   
153      !! ** Purpose :   read domaine namelists and print the variables.
154      !!
155      !! ** input   : - namrun namelist
156      !!              - namdom namelist
157      !!              - namnc4 namelist   ! "key_netcdf4" only
158      !!----------------------------------------------------------------------
159      USE ioipsl
160      NAMELIST/namrun/ cn_exp   ,    &         
161         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  ,     &
162         &             ln_mskland  , ln_clobber   , nn_chunksz,     &
163         &             ln_cfmeta, ln_iscpl
164
165      NAMELIST/namdom/ ln_read_cfg, nn_bathy, cn_domcfg, cn_topo, cn_bath, cn_lon, cn_lat, rn_scale, nn_interp, &
166         &             cn_topolvl, cn_fisfd, cn_visfd, cn_bathlvl, cn_fcoord,                        & 
167         &             rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,                       &
168         &             rn_atfp , rn_rdt   ,  ln_crs      , jphgr_msh ,                               &
169         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         &
170         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  &
171         &             ppa2, ppkth2, ppacr2
172
173      INTEGER  ::   ios                 ! Local integer output status for namelist read
174      CHARACTER(256) :: c_iomsg
175      !!----------------------------------------------------------------------
176
177   
178      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
179901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist')
180
181      READ  ( numnam_cfg, namrun, IOSTAT = ios, IOMSG = c_iomsg, ERR = 902 )
182
183902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist')
184      IF(lwm) WRITE ( numond, namrun )
185      !
186      IF(lwp) THEN                  ! control print
187         WRITE(numout,*)
188         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
189         WRITE(numout,*) '~~~~~~~ '
190         WRITE(numout,*) '   Namelist namrun'
191         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
192         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
193         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
194         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
195         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
196      ENDIF
197
198      cexper = cn_exp
199      nit000 = nn_it000
200      nitend = nn_itend
201      ndate0 = nn_date0
202      nleapy = nn_leapy
203
204      !
205      cn_topo =''
206      cn_bath =''
207      cn_lon  =''
208      cn_lat  =''
209      rn_scale = 1.
210
211      !REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
212      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
213903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' )
214 
215      !
216      !REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
217      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
218904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' )
219      IF(lwm) WRITE ( numond, namdom )
220      !
221#if defined key_agrif
222      IF (.NOT.Agrif_root()) THEN
223         jphgr_msh = Agrif_Parent(jphgr_msh)
224!         nn_bathy = Agrif_Parent(nn_bathy)
225         rn_bathy = Agrif_Parent(rn_bathy)
226         ppglam0 = Agrif_Parent(ppglam0)
227         ppgphi0 = Agrif_Parent(ppgphi0) 
228         ppe1_deg = Agrif_Parent(ppe1_deg)/Agrif_Rhox()
229         ppe2_deg = Agrif_Parent(ppe2_deg)/Agrif_Rhoy()
230         ppe1_m = Agrif_Parent(ppe1_m)/Agrif_Rhox()
231         ppe2_m = Agrif_Parent(ppe2_m)/Agrif_Rhoy() 
232      ENDIF
233#endif
234
235
236      IF(lwp) THEN
237         WRITE(numout,*)
238         WRITE(numout,*) '   Namelist namdom : space & time domain'
239         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
240         IF( nn_bathy == 1 ) THEN
241            WRITE(numout,*) '   read bathymetry from file      cn_topo      = ' ,TRIM(cn_topo)
242            WRITE(numout,*) '   bathymetry name in file        cn_bath      = ' ,TRIM(cn_bath)
243            WRITE(numout,*) '   read isf draft from file       cn_fisfd     = ' ,TRIM(cn_fisfd)
244            WRITE(numout,*) '   isf draft name in file         cn_visfd     = ' ,TRIM(cn_visfd)
245         ELSE IF( nn_bathy == 2 ) THEN
246            WRITE(numout,*) '   compute bathymetry from file      cn_topo      = ' , cn_topo
247            WRITE(numout,*) '   bathymetry name in file           cn_bath      = ' , cn_bath
248            WRITE(numout,*) '   longitude name in file            cn_lon       = ' , cn_lon
249            WRITE(numout,*) '   latitude  name in file            cn_lat       = ' , cn_lat
250            WRITE(numout,*) '   bathmetry scale factor            rn_scale     = ' , rn_scale 
251         ENDIF   
252         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
253         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
254         WRITE(numout,*) '      min number of ocean level (<0)       '
255         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
256         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
257         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
258         WRITE(numout,*) '           = 0   no file created           '
259         WRITE(numout,*) '           = 1   mesh_mask                 '
260         WRITE(numout,*) '           = 2   mesh and mask             '
261         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
262         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
263         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
264         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
265         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
266         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
267         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
268         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
269         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
270         WRITE(numout,*) '                                        ppa0            = ', ppa0
271         WRITE(numout,*) '                                        ppa1            = ', ppa1
272         WRITE(numout,*) '                                        ppkth           = ', ppkth
273         WRITE(numout,*) '                                        ppacr           = ', ppacr
274         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
275         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
276         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
277         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
278         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
279         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
280      ENDIF
281      !
282      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
283      e3zps_min = rn_e3zps_min
284      e3zps_rat = rn_e3zps_rat
285      nmsh      = nn_msh
286      atfp      = rn_atfp
287      rdt       = rn_rdt
288
289      snc4set%luse = .FALSE.        ! No NetCDF 4 case
290      !
291   END SUBROUTINE dom_nam
292
293
294   SUBROUTINE dom_ctl
295      !!----------------------------------------------------------------------
296      !!                     ***  ROUTINE dom_ctl  ***
297      !!
298      !! ** Purpose :   Domain control.
299      !!
300      !! ** Method  :   compute and print extrema of masked scale factors
301      !!----------------------------------------------------------------------
302      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
303      INTEGER, DIMENSION(2) ::   iloc   !
304      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
305      !!----------------------------------------------------------------------
306      !
307#undef CHECK_DOM
308#ifdef CHECK_DOM
309      IF(lk_mpp) THEN
310         CALL mpp_minloc( 'dom_ctl', e1t(:,:), tmask_i(:,:), ze1min, iloc )
311         iimi1 = iloc(1) ; ijmi1 = iloc(2)
312         CALL mpp_minloc( 'dom_ctl', e2t(:,:), tmask_i(:,:), ze2min, iloc )
313         iimi2 = iloc(1) ; ijmi2 = iloc(2)
314         CALL mpp_maxloc( 'dom_ctl', e1t(:,:), tmask_i(:,:), ze1max, iloc )
315         iima1 = iloc(1) ; ijma1 = iloc(2)
316         CALL mpp_maxloc( 'dom_ctl', e2t(:,:), tmask_i(:,:), ze2max, iloc )
317         iima2 = iloc(1) ; ijma2 = iloc(2)
318      ELSE
319         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
320         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
321         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
322         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
323
324         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
325         iimi1 = iloc(1) + nimpp - 1
326         ijmi1 = iloc(2) + njmpp - 1
327         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
328         iimi2 = iloc(1) + nimpp - 1
329         ijmi2 = iloc(2) + njmpp - 1
330         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
331         iima1 = iloc(1) + nimpp - 1
332         ijma1 = iloc(2) + njmpp - 1
333         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
334         iima2 = iloc(1) + nimpp - 1
335         ijma2 = iloc(2) + njmpp - 1
336      ENDIF
337      IF(lwp) THEN
338         WRITE(numout,*)
339         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
340         WRITE(numout,*) '~~~~~~~'
341         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
342         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
343         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
344         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
345      ENDIF
346#endif
347      !
348      ! check that all processes are still there... If some process have an error,
349      ! they will never enter in cfg_write
350      IF( lk_mpp )   CALL mpp_max( 'nemogcm',nstop )
351      IF (nstop /= 0) THEN
352         WRITE(numout,*) ''
353         WRITE(numout,*) '========================================================'
354         WRITE(numout,*) 'E R R O R : ',nstop, ' error have been found'
355         WRITE(numout,*) '========================================================'
356         WRITE(numout,*) ''
357         IF ( lk_mpp ) THEN
358            CALL mppstop()
359         ELSE
360            STOP 123
361         END IF
362      END IF
363      !
364   END SUBROUTINE dom_ctl
365
366
367   SUBROUTINE cfg_write
368      !!----------------------------------------------------------------------
369      !!                  ***  ROUTINE cfg_write  ***
370      !!                   
371      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which
372      !!              contains all the ocean domain informations required to
373      !!              define an ocean configuration.
374      !!
375      !! ** Method  :   Write in a file all the arrays required to set up an
376      !!              ocean configuration.
377      !!
378      !! ** output file :   domain_cfg.nc : domain size, characteristics,horizontal mesh,
379      !!                              Coriolis parameter, and vertical scale factors
380      !!                              NB: also contains ORCA family information (if cp_cfg = "ORCA")
381      !!                              and depths (ln_e3_dep=F)
382      !!----------------------------------------------------------------------
383      INTEGER           ::   ji, jj, jk   ! dummy loop indices
384      INTEGER           ::   izco, izps, isco, icav
385      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file
386      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
387      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
388      !!----------------------------------------------------------------------
389      !
390      IF(lwp) WRITE(numout,*)
391      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information'
392      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
393      !
394      !                       ! ============================= !
395      !                       !  create 'domain_cfg.nc' file  !
396      !                       ! ============================= !
397      !         
398      clnam = 'domain_cfg'  ! filename (configuration information)
399      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE.)!, kiolib = jprstlib )
400     
401      !
402      !                             !==  ORCA family specificities  ==!
403      IF( cp_cfg == "ORCA" ) THEN
404         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
405         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( jp_cfg, wp), ktype = jp_i4 )         
406      ENDIF
407      !                             !==  global domain size  ==!
408      !
409      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
410      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
411      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
412      !
413      !                             !==  domain characteristics  ==!
414      !
415      !                                   ! lateral boundary of the global
416      !                                   domain
417      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
418      !
419      !                                   ! type of vertical coordinate
420      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
421      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
422      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
423      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
424      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
425      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
426      !
427      !                                   ! ocean cavities under iceshelves
428      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
429      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
430      !
431      !                             !==  horizontal mesh  !
432      !
433      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
434      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
435      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
436      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
437      !                               
438      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
439      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
440      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
441      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
442      !                               
443      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
444      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
445      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
446      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
447      !
448      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
449      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
450      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
451      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
452      !
453      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
454      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
455      !
456      !                             !==  vertical mesh  ==!
457      !                                                     
458      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 )   !  reference 1D-coordinate
459      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 )
460      !
461      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   !  vertical scale factors (e
462      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 )
463      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 )
464      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 )
465      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 )
466      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 )
467      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 )
468      !
469      IF(.NOT.ln_e3_dep ) THEN                                             !  depth (t- & w-points)
470         CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   ! required only with 
471         CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 )   ! the old e3. definition
472         CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )
473         CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 )
474      ENDIF
475      !                                         
476      !                             !==  ocean top and bottom level  ==!
477      !
478      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
479      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
480      CALL iom_rstput( 0, 0, inum, 'isf_draft'    , risfdep , ktype = jp_r8 )
481      DO jj = 1,jpj
482         DO ji = 1,jpi
483            z2d (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
484         END DO
485      END DO
486      CALL iom_rstput( 0, 0, inum, 'bathy_metry'   , z2d , ktype = jp_r8 )
487      !
488      !                              !== closed sea ==!
489      IF (ln_domclo) THEN
490         ! mask for the open sea
491         CALL iom_rstput( 0, 0, inum, 'mask_opensea' , msk_opnsea  , ktype = jp_i4 )
492         ! mask for all the under closed sea
493         CALL iom_rstput( 0, 0, inum, 'mask_csundef' , msk_csundef , ktype = jp_i4 )
494         ! mask for global, local net precip, local net precip and evaporation correction
495         CALL iom_rstput( 0, 0, inum, 'mask_csglo'   , msk_csglo   , ktype = jp_i4 )
496         CALL iom_rstput( 0, 0, inum, 'mask_csemp'   , msk_csemp   , ktype = jp_i4 )
497         CALL iom_rstput( 0, 0, inum, 'mask_csrnf'   , msk_csrnf   , ktype = jp_i4 )
498         ! mask for the various river mouth (in case multiple lake in the same outlet)
499         CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_csgrpglo, ktype = jp_i4 )
500         CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_csgrpemp, ktype = jp_i4 )
501         CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_csgrprnf, ktype = jp_i4 )
502      END IF
503      !
504      !                                ! ============================
505      !                                !        close the files
506      !                                ! ============================
507      CALL iom_close( inum )
508      !
509   END SUBROUTINE cfg_write
510
511   !!======================================================================
512END MODULE domain
Note: See TracBrowser for help on using the repository browser.