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

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

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