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

Last change on this file since 6717 was 6717, checked in by gm, 8 years ago

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