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

Last change on this file since 6667 was 6667, checked in by gm, 9 years ago

#1692 - branch SIMPLIF_2_usrdef: reduced domain_cfg.nc file: GYRE OK using usrdef or reading file
  • Property svn:keywords set to Id
File size: 28.4 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_wri       : 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 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), POINTER, DIMENSION(:,:)   ::   zht, 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, '   jpidta  : ', jpidta
89         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta
90         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo, '   jpkdta  : ', jpkdta
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                     ! Closed seas and lake
103      CALL dom_hgr                     ! Horizontal mesh
104      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
105      CALL dom_msk( ik_top, ik_bot )   ! Masks
106      !
107      IF( ln_sco )  CALL dom_stiff     ! Maximum stiffness ratio/hydrostatic consistency
108      !
109      DO jj = 1, jpj                   ! depth of the iceshelves
110         DO ji = 1, jpj
111            risfdep(ji,jj) = gdepw_0(ji,jj,mikt(ji,jj))
112         END DO
113      END DO
114      !
115      ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness
116      hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1)
117      hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1)
118      DO jk = 2, jpk
119         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
120         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
121         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
122      END DO
123      !
124      !           !==  time varying part of coordinate system  ==!
125      !
126      IF( ln_linssh ) THEN          ! Fix in time : set to the reference one for all
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         CALL wrk_alloc( jpi,jpj,   z1_hu_0, z1_hv_0 )
141         !
142         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
143         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
144         !
145         !        before       !          now          !       after         !
146         ;                     ;      ht_n =    ht_0   !                     ! water column thickness
147         ;     hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !
148         ;     hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
149         ;  r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
150         ;  r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
151         !
152         CALL wrk_dealloc( jpi,jpj,   z1_hu_0, z1_hv_0 )
153         !
154      ELSE                         ! time varying : initialize before/now/after variables
155         !
156         CALL dom_vvl_init 
157         !
158      ENDIF
159      !
160      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
161      !
162      IF( nn_msh > 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file
163      IF( nn_msh > 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file
164      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
165      !
166     
167      IF(lwp) THEN
168         WRITE(numout,*)
169         WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh
170         WRITE(numout,*) 
171      ENDIF
172      !
173      IF( ln_write_cfg )   CALL cfg_wri           ! create the configuration file
174      !
175      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
176      !
177   END SUBROUTINE dom_init
178
179
180   SUBROUTINE dom_nam
181      !!----------------------------------------------------------------------
182      !!                     ***  ROUTINE dom_nam  ***
183      !!                   
184      !! ** Purpose :   read domaine namelists and print the variables.
185      !!
186      !! ** input   : - namrun namelist
187      !!              - namdom namelist
188      !!              - namnc4 namelist   ! "key_netcdf4" only
189      !!----------------------------------------------------------------------
190      USE ioipsl
191      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
192                       nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
193         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
194         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
195         &             ln_cfmeta, ln_iscpl
196      NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs
197#if defined key_netcdf4
198      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
199#endif
200      INTEGER  ::   ios                 ! Local integer output status for namelist read
201      !!----------------------------------------------------------------------
202
203      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
204      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
205901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
206
207      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
208      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
209902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
210      IF(lwm) WRITE ( numond, namrun )
211      !
212      IF(lwp) THEN                  ! control print
213         WRITE(numout,*)
214         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
215         WRITE(numout,*) '~~~~~~~ '
216         WRITE(numout,*) '   Namelist namrun'
217         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
218         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
219         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
220         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
221         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
222         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
223         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
224         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
225         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
226         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
227         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
228         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
229         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
230         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
231         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
232         IF( ln_rst_list ) THEN
233            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
234         ELSE
235            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
236         ENDIF
237         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
238         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
239         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
240         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
241         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
242         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
243      ENDIF
244
245      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
246      cexper = cn_exp
247      nrstdt = nn_rstctl
248      nit000 = nn_it000
249      nitend = nn_itend
250      ndate0 = nn_date0
251      nleapy = nn_leapy
252      ninist = nn_istate
253      nstock = nn_stock
254      nstocklist = nn_stocklist
255      nwrite = nn_write
256      neuler = nn_euler
257      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
258         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
259         CALL ctl_warn( ctmp1 )
260         neuler = 0
261      ENDIF
262      !                             ! control of output frequency
263      IF ( nstock == 0 .OR. nstock > nitend ) THEN
264         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
265         CALL ctl_warn( ctmp1 )
266         nstock = nitend
267      ENDIF
268      IF ( nwrite == 0 ) THEN
269         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
270         CALL ctl_warn( ctmp1 )
271         nwrite = nitend
272      ENDIF
273
274#if defined key_agrif
275      IF( Agrif_Root() ) THEN
276#endif
277      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
278      CASE (  1 ) 
279         CALL ioconf_calendar('gregorian')
280         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
281      CASE (  0 )
282         CALL ioconf_calendar('noleap')
283         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
284      CASE ( 30 )
285         CALL ioconf_calendar('360d')
286         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
287      END SELECT
288#if defined key_agrif
289      ENDIF
290#endif
291
292      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
293      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
294903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
295 
296      !
297      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
298      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
299904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
300      IF(lwm) WRITE ( numond, namdom )
301      !
302      IF(lwp) THEN
303         WRITE(numout,*)
304         WRITE(numout,*) '   Namelist namdom : space & time domain'
305         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh
306         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea  = ', nn_closea
307         WRITE(numout,*) '      create mesh/mask file(s)              nn_msh     = ', nn_msh
308         WRITE(numout,*) '           = 0   no file created           '
309         WRITE(numout,*) '           = 1   mesh_mask                 '
310         WRITE(numout,*) '           = 2   mesh and mask             '
311         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
312         WRITE(numout,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)'
313         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt
314         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp
315         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs
316      ENDIF
317     
318      call flush( numout )
319      !
320!     !          ! conversion DOCTOR names into model names (this should disappear soon)
321      atfp      = rn_atfp
322      rdt       = rn_rdt
323
324#if defined key_netcdf4
325      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
326      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
327      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
328907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
329
330      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
331      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
332908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
333      IF(lwm) WRITE( numond, namnc4 )
334
335      IF(lwp) THEN                        ! control print
336         WRITE(numout,*)
337         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
338         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
339         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
340         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
341         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
342      ENDIF
343
344      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
345      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
346      snc4set%ni   = nn_nchunks_i
347      snc4set%nj   = nn_nchunks_j
348      snc4set%nk   = nn_nchunks_k
349      snc4set%luse = ln_nc4zip
350#else
351      snc4set%luse = .FALSE.        ! No NetCDF 4 case
352#endif
353      !
354   END SUBROUTINE dom_nam
355
356
357   SUBROUTINE dom_ctl
358      !!----------------------------------------------------------------------
359      !!                     ***  ROUTINE dom_ctl  ***
360      !!
361      !! ** Purpose :   Domain control.
362      !!
363      !! ** Method  :   compute and print extrema of masked scale factors
364      !!----------------------------------------------------------------------
365      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
366      INTEGER, DIMENSION(2) ::   iloc   !
367      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
368      !!----------------------------------------------------------------------
369      !
370      IF(lk_mpp) THEN
371         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
372         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
373         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
374         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
375      ELSE
376         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
377         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
378         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
379         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
380         !
381         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
382         iimi1 = iloc(1) + nimpp - 1
383         ijmi1 = iloc(2) + njmpp - 1
384         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
385         iimi2 = iloc(1) + nimpp - 1
386         ijmi2 = iloc(2) + njmpp - 1
387         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
388         iima1 = iloc(1) + nimpp - 1
389         ijma1 = iloc(2) + njmpp - 1
390         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
391         iima2 = iloc(1) + nimpp - 1
392         ijma2 = iloc(2) + njmpp - 1
393      ENDIF
394      IF(lwp) THEN
395         WRITE(numout,*)
396         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
397         WRITE(numout,*) '~~~~~~~'
398         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
399         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
400         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
401         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
402      ENDIF
403      !
404   END SUBROUTINE dom_ctl
405
406
407   SUBROUTINE cfg_wri
408      !!----------------------------------------------------------------------
409      !!                  ***  ROUTINE cfg_wri  ***
410      !!                   
411      !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the
412      !!      ocean domain informations (mesh and mask arrays). This (these)
413      !!      file(s) is (are) used for visualisation (SAXO software) and
414      !!      diagnostic computation.
415      !!
416      !! ** Method  :   Write in a file all the arrays generated in routines
417      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
418      !!      the vertical coord. used (z-coord, partial steps, s-coord)
419      !!            MOD(nn_msh, 3) = 1  :   'mesh_mask.nc' file
420      !!                         = 2  :   'mesh.nc' and mask.nc' files
421      !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
422      !!                                  'mask.nc' files
423      !!      For huge size domain, use option 2 or 3 depending on your
424      !!      vertical coordinate.
425      !!
426      !!      if     nn_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
427      !!      if 3 < nn_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays
428      !!                        corresponding to the depth of the bottom t- and w-points
429      !!      if 6 < nn_msh <= 9: write 2D arrays corresponding to the depth and the
430      !!                        thickness (e3[tw]_ps) of the bottom points
431      !!
432      !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position,
433      !!                                   masks, depth and vertical scale factors
434      !!----------------------------------------------------------------------
435      INTEGER           ::   ji, jj, jk   ! dummy loop indices
436      INTEGER           ::   izco, izps, isco, icav
437      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file
438      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
439      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
440      !!----------------------------------------------------------------------
441      !
442      IF(lwp) WRITE(numout,*)
443      IF(lwp) WRITE(numout,*) 'cfg_wri : create the "domain_cfg.nc" file containing all required configuration information'
444      IF(lwp) WRITE(numout,*) '~~~~~~~'
445      !
446      !                       ! ============================= !
447      !                       !  create 'domain_cfg.nc' file  !
448      !                       ! ============================= !
449      !         
450      clnam = 'domain_cfg'  ! filename (configuration information)
451      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
452     
453      !                             !==  global domain size  ==!
454      !
455      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
456      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
457      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
458      !
459      !                             !==  domain characteristics  ==!
460      !
461      !                                   ! lateral boundary of the global domain
462      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
463      !
464      !                                   ! type of vertical coordinate
465      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
466      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
467      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
468      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
469      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
470      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
471      !
472      !                                   ! ocean cavities under iceshelves
473      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
474      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
475      !
476      !                             !==  horizontal mesh  !
477      !
478      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
479      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
480      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
481      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
482      !                               
483      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
484      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
485      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
486      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
487      !                               
488      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
489      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
490      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
491      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
492      !
493      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
494      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
495      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
496      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
497      !
498      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
499      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
500      !
501      !                             !==  vertical mesh - 3D mask  ==!
502      !                                                     
503      CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   ! reference 1D-coordinate
504      CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 )
505      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 )
506      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 )
507      !                                                     
508      CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )   ! depth (t- & w-points)
509      CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 )
510      !
511      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   ! vertical scale factors (e
512      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 )
513      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 )
514      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 )
515      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 )
516      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 )
517      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 )
518      !                                         
519      !                             !==  ocean top and bottom level  ==!
520      !
521      CALL iom_rstput( 0, 0, inum, 'bottom level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
522      CALL iom_rstput( 0, 0, inum, 'top    level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
523      !
524      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
525         CALL dom_stiff( z2d )
526         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
527      ENDIF
528      !
529      !                                ! ============================
530      !                                !        close the files
531      !                                ! ============================
532      CALL iom_close( inum )
533      !
534   END SUBROUTINE cfg_wri
535
536   !!======================================================================
537END MODULE domain
Note: See TracBrowser for help on using the repository browser.