New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
domain.f90 in NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src – NEMO

source: NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/domain.f90 @ 15126

Last change on this file since 15126 was 15121, checked in by dbruciaferri, 3 years ago

adding code for MEs-coordinate system v1.0 (same of PhD)
File size: 27.1 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      IF( nmsh /= 0 ) CALL dom_wri ! DB create mesh_mask
136      CALL cfg_write               ! create the configuration file
137      !
138      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
139      !
140   END SUBROUTINE dom_init
141
142
143   SUBROUTINE dom_nam
144      !!----------------------------------------------------------------------
145      !!                     ***  ROUTINE dom_nam  ***
146      !!                   
147      !! ** Purpose :   read domaine namelists and print the variables.
148      !!
149      !! ** input   : - namrun namelist
150      !!              - namdom namelist
151      !!              - namnc4 namelist   ! "key_netcdf4" only
152      !!----------------------------------------------------------------------
153      USE ioipsl
154      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
155                       nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
156         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
157         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
158         &             ln_cfmeta, ln_iscpl
159      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, rn_isfhmin, &
160         &             rn_atfp , rn_rdt   , nn_closea   , ln_crs      , jphgr_msh ,                  &
161         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m,                         &
162         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh,                  &
163         &             ppa2, ppkth2, ppacr2
164
165
166
167      INTEGER  ::   ios                 ! Local integer output status for namelist read
168      !!----------------------------------------------------------------------
169
170      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
171      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
172901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
173
174      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
175      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
176902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
177      IF(lwm) WRITE ( numond, namrun )
178      !
179      IF(lwp) THEN                  ! control print
180         WRITE(numout,*)
181         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
182         WRITE(numout,*) '~~~~~~~ '
183         WRITE(numout,*) '   Namelist namrun'
184         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
185         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
186         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
187         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
188         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
189         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
190         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
191         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
192         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
193         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
194         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
195         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
196         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
197         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
198         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
199         IF( ln_rst_list ) THEN
200            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
201         ELSE
202            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
203         ENDIF
204         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
205         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
206         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
207         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
208         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
209         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
210      ENDIF
211
212      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
213      cexper = cn_exp
214      nrstdt = nn_rstctl
215      nit000 = nn_it000
216      nitend = nn_itend
217      ndate0 = nn_date0
218      nleapy = nn_leapy
219      ninist = nn_istate
220      nstock = nn_stock
221      nstocklist = nn_stocklist
222      nwrite = nn_write
223      neuler = nn_euler
224      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
225         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
226         CALL ctl_warn( ctmp1 )
227         neuler = 0
228      ENDIF
229
230      !                             ! control of output frequency
231      IF ( nstock == 0 .OR. nstock > nitend ) THEN
232         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
233         CALL ctl_warn( ctmp1 )
234         nstock = nitend
235      ENDIF
236      IF ( nwrite == 0 ) THEN
237         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
238         CALL ctl_warn( ctmp1 )
239         nwrite = nitend
240      ENDIF
241
242
243
244
245      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
246      CASE (  1 ) 
247         CALL ioconf_calendar('gregorian')
248         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
249      CASE (  0 )
250         CALL ioconf_calendar('noleap')
251         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
252      CASE ( 30 )
253         CALL ioconf_calendar('360d')
254         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
255      END SELECT
256
257
258
259
260      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
261      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
262903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
263 
264      !
265      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
266      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
267904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
268      IF(lwm) WRITE ( numond, namdom )
269      !
270      IF(lwp) THEN
271         WRITE(numout,*)
272         WRITE(numout,*) '   Namelist namdom : space & time domain'
273         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
274         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
275         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
276         WRITE(numout,*) '      min number of ocean level (<0)       '
277         WRITE(numout,*) '      treshold to open the isf cavity   rn_isfhmin   = ', rn_isfhmin, ' (m)'
278         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
279         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
280         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
281         WRITE(numout,*) '           = 0   no file created           '
282         WRITE(numout,*) '           = 1   mesh_mask                 '
283         WRITE(numout,*) '           = 2   mesh and mask             '
284         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
285         WRITE(numout,*) '      ocean time step                       rn_rdt    = ', rn_rdt
286         WRITE(numout,*) '      asselin time filter parameter         rn_atfp   = ', rn_atfp
287         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea = ', nn_closea
288         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs    = ', ln_crs
289         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
290         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
291         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
292         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
293         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
294         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
295         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
296         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
297         WRITE(numout,*) '                                        ppa0            = ', ppa0
298         WRITE(numout,*) '                                        ppa1            = ', ppa1
299         WRITE(numout,*) '                                        ppkth           = ', ppkth
300         WRITE(numout,*) '                                        ppacr           = ', ppacr
301         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
302         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
303         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
304         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
305         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
306         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
307      ENDIF
308      !
309      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
310      e3zps_min = rn_e3zps_min
311      e3zps_rat = rn_e3zps_rat
312      nmsh      = nn_msh
313      atfp      = rn_atfp
314      rdt       = rn_rdt
315
316      snc4set%luse = .FALSE.        ! No NetCDF 4 case
317      !
318   END SUBROUTINE dom_nam
319
320
321   SUBROUTINE dom_ctl
322      !!----------------------------------------------------------------------
323      !!                     ***  ROUTINE dom_ctl  ***
324      !!
325      !! ** Purpose :   Domain control.
326      !!
327      !! ** Method  :   compute and print extrema of masked scale factors
328      !!----------------------------------------------------------------------
329      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
330      INTEGER, DIMENSION(2) ::   iloc   !
331      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
332      !!----------------------------------------------------------------------
333      !
334      IF(lk_mpp) THEN
335         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
336         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
337         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
338         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
339      ELSE
340         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
341         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
342         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
343         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
344
345         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
346         iimi1 = iloc(1) + nimpp - 1
347         ijmi1 = iloc(2) + njmpp - 1
348         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
349         iimi2 = iloc(1) + nimpp - 1
350         ijmi2 = iloc(2) + njmpp - 1
351         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
352         iima1 = iloc(1) + nimpp - 1
353         ijma1 = iloc(2) + njmpp - 1
354         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
355         iima2 = iloc(1) + nimpp - 1
356         ijma2 = iloc(2) + njmpp - 1
357      ENDIF
358      IF(lwp) THEN
359         WRITE(numout,*)
360         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
361         WRITE(numout,*) '~~~~~~~'
362         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
363         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
364         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
365         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
366      ENDIF
367      !
368   END SUBROUTINE dom_ctl
369
370
371   SUBROUTINE cfg_write
372      !!----------------------------------------------------------------------
373      !!                  ***  ROUTINE cfg_write  ***
374      !!                   
375      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which
376      !!              contains all the ocean domain informations required to
377      !!              define an ocean configuration.
378      !!
379      !! ** Method  :   Write in a file all the arrays required to set up an
380      !!              ocean configuration.
381      !!
382      !! ** output file :   domain_cfg.nc : domain size, characteristics,horizontal mesh,
383      !!                              Coriolis parameter, and vertical scale factors
384      !!                              NB: also contains ORCA family information (if cp_cfg = "ORCA")
385      !!                              and depths (ln_e3_dep=F)
386      !!----------------------------------------------------------------------
387      INTEGER           ::   ji, jj, jk   ! dummy loop indices
388      INTEGER           ::   izco, izps, isco, icav
389      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file
390      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
391      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
392      !!----------------------------------------------------------------------
393      !
394      IF(lwp) WRITE(numout,*)
395      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information'
396      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
397      !
398      !                       ! ============================= !
399      !                       !  create 'domain_cfg.nc' file  !
400      !                       ! ============================= !
401      !         
402      clnam = 'domain_cfg'  ! filename (configuration information)
403      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
404     
405      !
406      !                             !==  ORCA family specificities  ==!
407      IF( cp_cfg == "ORCA" ) THEN
408         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
409         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( jp_cfg, wp), ktype = jp_i4 )         
410      ENDIF
411      !                             !==  global domain size  ==!
412      !
413      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
414      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
415      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
416      !
417      !                             !==  domain characteristics  ==!
418      !
419      !                                   ! lateral boundary of the global
420      !                                   domain
421      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
422      !
423      !                                   ! type of vertical coordinate
424      IF( ln_zco             ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
425      IF( ln_zps             ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
426      IF( ln_sco .OR. ln_mes ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
427      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
428      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
429      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
430      !
431      !                                   ! ocean cavities under iceshelves
432      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
433      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
434      !
435      !                             !==  horizontal mesh  !
436      !
437      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
438      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
439      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
440      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
441      !                               
442      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
443      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
444      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
445      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
446      !                               
447      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
448      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
449      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
450      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
451      !
452      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
453      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
454      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
455      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
456      !
457      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
458      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
459      !
460      !                             !==  vertical mesh  ==!
461      !                                                     
462      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 )   !  reference 1D-coordinate
463      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 )
464      !
465      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   !  vertical scale factors (e
466      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 )
467      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 )
468      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 )
469      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 )
470      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 )
471      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 )
472      !
473      IF(.NOT.ln_e3_dep ) THEN                                             !  depth (t- & w-points)
474         CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   ! required only with 
475         CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 )   ! the old e3. definition
476         CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )
477         CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 )
478      ENDIF
479      !                                         
480      !                             !==  ocean top and bottom level  ==!
481      !
482      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
483      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
484      DO jj = 1,jpj
485         DO ji = 1,jpi
486            z2d (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
487         END DO
488      END DO
489      CALL iom_rstput( 0, 0, inum, 'bathy_meter'   , z2d , ktype = jp_r4 )
490
491      !
492      IF( ln_sco .OR. ln_mes ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
493         CALL dom_stiff( z2d )
494         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
495      ENDIF
496      !
497      !                                ! ============================
498      !                                !        close the files
499      !                                ! ============================
500      CALL iom_close( inum )
501      !
502   END SUBROUTINE cfg_write
503
504
505
506   !!======================================================================
507END MODULE domain
Note: See TracBrowser for help on using the repository browser.