source: utils/tools/DOMAINcfg/src/domain.f90 @ 9722

Last change on this file since 9722 was 9722, checked in by flavoni, 2 years ago

add bathy_meter field in domain_cfg.nc input files

File size: 27.0 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 oce             ! ocean variables
24   USE dom_oce         ! domain: ocean
25   USE phycst          ! physical constants
26   USE closea          ! closed seas
27   USE domhgr          ! domain: set the horizontal mesh
28   USE domzgr          ! domain: set the vertical mesh
29   USE domstp          ! domain: set the time-step
30   USE dommsk          ! domain: set the mask system
31   USE domwri          ! domain: write the meshmask file
32   USE domvvl          ! variable volume
33   !
34   USE in_out_manager  ! I/O manager
35   USE iom             !
36   USE wrk_nemo        ! Memory Allocation
37   USE lib_mpp         ! distributed memory computing library
38   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
39   USE timing          ! Timing
40
41   IMPLICIT NONE
42   PRIVATE
43
44   PUBLIC   dom_init   ! called by opa.F90
45
46   !!-------------------------------------------------------------------------
47   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
48   !! $Id: domain.F90 6140 2015-12-21 11:35:23Z timgraham $
49   !! Software governed by the CeCILL licence        (./LICENSE)
50   !!-------------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE dom_init
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE dom_init  ***
56      !!                   
57      !! ** Purpose :   Domain initialization. Call the routines that are
58      !!              required to create the arrays which define the space
59      !!              and time domain of the ocean model.
60      !!
61      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
62      !!              - dom_hgr: compute or read the horizontal grid-point position
63      !!                         and scale factors, and the coriolis factor
64      !!              - dom_zgr: define the vertical coordinate and the bathymetry
65      !!              - dom_stp: defined the model time step
66      !!              - dom_wri: create the meshmask file if nmsh=1
67      !!              - 1D configuration, move Coriolis, u and v at T-point
68      !!----------------------------------------------------------------------
69      INTEGER ::   jk          ! dummy loop indices
70      INTEGER ::   iconf = 0   ! local integers
71      REAL(wp), POINTER, DIMENSION(:,:) ::   z1_hu_0, z1_hv_0
72      !!----------------------------------------------------------------------
73      !
74      IF( nn_timing == 1 )   CALL timing_start('dom_init')
75      !
76      IF(lwp) THEN
77         WRITE(numout,*)
78         WRITE(numout,*) 'dom_init : domain initialization'
79         WRITE(numout,*) '~~~~~~~~'
80      ENDIF
81      !
82      !                       !==  Reference coordinate system  ==!
83      !
84                     CALL dom_nam               ! read namelist ( namrun, namdom )
85                     CALL dom_clo               ! Closed seas and lake
86                     CALL dom_hgr               ! Horizontal mesh
87                     CALL dom_zgr               ! Vertical mesh and bathymetry
88                     CALL dom_msk               ! Masks
89      !
90      ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness
91      hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1)
92      hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1)
93      DO jk = 2, jpk
94         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
95         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
96         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
97      END DO
98      !
99      !              !==  time varying part of coordinate system  ==!
100      !
101      IF( ln_linssh ) THEN          ! Fix in time : set to the reference one for all
102         !       before        !          now          !       after         !
103         ;  gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
104         ;  gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
105         ;                     ;   gde3w_n = gde3w_0   !        ---          !
106         !                                                                 
107         ;    e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
108         ;    e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
109         ;    e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
110         ;                     ;     e3f_n =   e3f_0   !        ---          !
111         ;    e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
112         ;   e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
113         ;   e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
114         !
115         CALL wrk_alloc( jpi,jpj,   z1_hu_0, z1_hv_0 )
116         !
117         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
118         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
119         !
120         !        before       !          now          !       after         !
121         ;                     ;      ht_n =    ht_0   !                     ! water column thickness
122         ;     hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !
123         ;     hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
124         ;  r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
125         ;  r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
126         !
127         CALL wrk_dealloc( jpi,jpj,   z1_hu_0, z1_hv_0 )
128         !
129      ELSE                         ! time varying : initialize before/now/after variables
130         !
131         CALL dom_vvl_init 
132         !
133      ENDIF
134      !
135      CALL cfg_write         ! create the configuration file
136      !
137      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
138      !
139   END SUBROUTINE dom_init
140
141
142   SUBROUTINE dom_nam
143      !!----------------------------------------------------------------------
144      !!                     ***  ROUTINE dom_nam  ***
145      !!                   
146      !! ** Purpose :   read domaine namelists and print the variables.
147      !!
148      !! ** input   : - namrun namelist
149      !!              - namdom namelist
150      !!              - namnc4 namelist   ! "key_netcdf4" only
151      !!----------------------------------------------------------------------
152      USE ioipsl
153      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
154                       nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
155         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
156         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
157         &             ln_cfmeta, ln_iscpl
158      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, rn_isfhmin, &
159         &             rn_atfp , rn_rdt   , nn_closea   , ln_crs      , jphgr_msh ,                  &
160         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         &
161         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  &
162         &             ppa2, ppkth2, ppacr2
163
164
165
166      INTEGER  ::   ios                 ! Local integer output status for namelist read
167      !!----------------------------------------------------------------------
168
169      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
170      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
171901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
172
173      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
174      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
175902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
176      IF(lwm) WRITE ( numond, namrun )
177      !
178      IF(lwp) THEN                  ! control print
179         WRITE(numout,*)
180         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
181         WRITE(numout,*) '~~~~~~~ '
182         WRITE(numout,*) '   Namelist namrun'
183         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
184         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
185         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
186         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
187         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
188         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
189         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
190         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
191         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
192         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
193         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
194         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
195         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
196         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
197         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
198         IF( ln_rst_list ) THEN
199            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
200         ELSE
201            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
202         ENDIF
203         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
204         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
205         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
206         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
207         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
208         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
209      ENDIF
210
211      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
212      cexper = cn_exp
213      nrstdt = nn_rstctl
214      nit000 = nn_it000
215      nitend = nn_itend
216      ndate0 = nn_date0
217      nleapy = nn_leapy
218      ninist = nn_istate
219      nstock = nn_stock
220      nstocklist = nn_stocklist
221      nwrite = nn_write
222      neuler = nn_euler
223      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
224         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
225         CALL ctl_warn( ctmp1 )
226         neuler = 0
227      ENDIF
228
229      !                             ! control of output frequency
230      IF ( nstock == 0 .OR. nstock > nitend ) THEN
231         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
232         CALL ctl_warn( ctmp1 )
233         nstock = nitend
234      ENDIF
235      IF ( nwrite == 0 ) THEN
236         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
237         CALL ctl_warn( ctmp1 )
238         nwrite = nitend
239      ENDIF
240
241
242
243
244      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
245      CASE (  1 ) 
246         CALL ioconf_calendar('gregorian')
247         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
248      CASE (  0 )
249         CALL ioconf_calendar('noleap')
250         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
251      CASE ( 30 )
252         CALL ioconf_calendar('360d')
253         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
254      END SELECT
255
256
257
258
259      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
260      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
261903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
262 
263      !
264      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
265      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
266904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
267      IF(lwm) WRITE ( numond, namdom )
268      !
269      IF(lwp) THEN
270         WRITE(numout,*)
271         WRITE(numout,*) '   Namelist namdom : space & time domain'
272         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
273         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
274         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
275         WRITE(numout,*) '      min number of ocean level (<0)       '
276         WRITE(numout,*) '      treshold to open the isf cavity   rn_isfhmin   = ', rn_isfhmin, ' (m)'
277         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
278         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
279         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
280         WRITE(numout,*) '           = 0   no file created           '
281         WRITE(numout,*) '           = 1   mesh_mask                 '
282         WRITE(numout,*) '           = 2   mesh and mask             '
283         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
284         WRITE(numout,*) '      ocean time step                       rn_rdt    = ', rn_rdt
285         WRITE(numout,*) '      asselin time filter parameter         rn_atfp   = ', rn_atfp
286         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea = ', nn_closea
287         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs    = ', ln_crs
288         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
289         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
290         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
291         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
292         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
293         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
294         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
295         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
296         WRITE(numout,*) '                                        ppa0            = ', ppa0
297         WRITE(numout,*) '                                        ppa1            = ', ppa1
298         WRITE(numout,*) '                                        ppkth           = ', ppkth
299         WRITE(numout,*) '                                        ppacr           = ', ppacr
300         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
301         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
302         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
303         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
304         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
305         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
306      ENDIF
307      !
308      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
309      e3zps_min = rn_e3zps_min
310      e3zps_rat = rn_e3zps_rat
311      nmsh      = nn_msh
312      atfp      = rn_atfp
313      rdt       = rn_rdt
314
315      snc4set%luse = .FALSE.        ! No NetCDF 4 case
316      !
317   END SUBROUTINE dom_nam
318
319
320   SUBROUTINE dom_ctl
321      !!----------------------------------------------------------------------
322      !!                     ***  ROUTINE dom_ctl  ***
323      !!
324      !! ** Purpose :   Domain control.
325      !!
326      !! ** Method  :   compute and print extrema of masked scale factors
327      !!----------------------------------------------------------------------
328      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
329      INTEGER, DIMENSION(2) ::   iloc   !
330      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
331      !!----------------------------------------------------------------------
332      !
333      IF(lk_mpp) THEN
334         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
335         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
336         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
337         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
338      ELSE
339         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
340         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
341         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
342         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
343
344         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
345         iimi1 = iloc(1) + nimpp - 1
346         ijmi1 = iloc(2) + njmpp - 1
347         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
348         iimi2 = iloc(1) + nimpp - 1
349         ijmi2 = iloc(2) + njmpp - 1
350         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
351         iima1 = iloc(1) + nimpp - 1
352         ijma1 = iloc(2) + njmpp - 1
353         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
354         iima2 = iloc(1) + nimpp - 1
355         ijma2 = iloc(2) + njmpp - 1
356      ENDIF
357      IF(lwp) THEN
358         WRITE(numout,*)
359         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
360         WRITE(numout,*) '~~~~~~~'
361         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
362         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
363         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
364         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
365      ENDIF
366      !
367   END SUBROUTINE dom_ctl
368
369
370   SUBROUTINE cfg_write
371      !!----------------------------------------------------------------------
372      !!                  ***  ROUTINE cfg_write  ***
373      !!                   
374      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which
375      !!              contains all the ocean domain informations required to
376      !!              define an ocean configuration.
377      !!
378      !! ** Method  :   Write in a file all the arrays required to set up an
379      !!              ocean configuration.
380      !!
381      !! ** output file :   domain_cfg.nc : domain size, characteristics,horizontal mesh,
382      !!                              Coriolis parameter, and vertical scale factors
383      !!                              NB: also contains ORCA family information (if cp_cfg = "ORCA")
384      !!                              and depths (ln_e3_dep=F)
385      !!----------------------------------------------------------------------
386      INTEGER           ::   ji, jj, jk   ! dummy loop indices
387      INTEGER           ::   izco, izps, isco, icav
388      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file
389      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
390      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
391      !!----------------------------------------------------------------------
392      !
393      IF(lwp) WRITE(numout,*)
394      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information'
395      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
396      !
397      !                       ! ============================= !
398      !                       !  create 'domain_cfg.nc' file  !
399      !                       ! ============================= !
400      !         
401      clnam = 'domain_cfg'  ! filename (configuration information)
402      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
403     
404      !
405      !                             !==  ORCA family specificities  ==!
406      IF( cp_cfg == "ORCA" ) THEN
407         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
408         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( jp_cfg, wp), ktype = jp_i4 )         
409      ENDIF
410      !                             !==  global domain size  ==!
411      !
412      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
413      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
414      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
415      !
416      !                             !==  domain characteristics  ==!
417      !
418      !                                   ! lateral boundary of the global
419      !                                   domain
420      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
421      !
422      !                                   ! type of vertical coordinate
423      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
424      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
425      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
426      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
427      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
428      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
429      !
430      !                                   ! ocean cavities under iceshelves
431      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
432      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
433      !
434      !                             !==  horizontal mesh  !
435      !
436      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
437      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
438      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
439      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
440      !                               
441      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
442      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
443      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
444      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
445      !                               
446      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
447      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
448      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
449      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
450      !
451      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
452      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
453      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
454      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
455      !
456      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
457      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
458      !
459      !                             !==  vertical mesh  ==!
460      !                                                     
461      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 )   !  reference 1D-coordinate
462      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 )
463      !
464      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   !  vertical scale factors (e
465      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 )
466      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 )
467      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 )
468      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 )
469      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 )
470      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 )
471      !
472      IF(.NOT.ln_e3_dep ) THEN                                             !  depth (t- & w-points)
473         CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   ! required only with 
474         CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 )   ! the old e3. definition
475         CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )
476         CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 )
477      ENDIF
478      !                                         
479      !                             !==  ocean top and bottom level  ==!
480      !
481      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
482      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
483      DO jj = 1,jpj
484         DO ji = 1,jpi
485            z2d (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
486         END DO
487      END DO
488      CALL iom_rstput( 0, 0, inum, 'bathy_metry'   , z2d , ktype = jp_r4 )
489
490      !
491      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
492         CALL dom_stiff( z2d )
493         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
494      ENDIF
495      !
496      !                                ! ============================
497      !                                !        close the files
498      !                                ! ============================
499      CALL iom_close( inum )
500      !
501   END SUBROUTINE cfg_write
502
503
504
505   !!======================================================================
506END MODULE domain
Note: See TracBrowser for help on using the repository browser.