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 branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 6976

Last change on this file since 6976 was 6976, checked in by flavoni, 8 years ago

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