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

source: utils/tools_AGRIF_CMEMS_2020/DOMAINcfg/src/domain.F90 @ 10727

Last change on this file since 10727 was 10727, checked in by rblod, 6 years ago

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