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/UKMO/dev_r8600_closea_rewrite/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/UKMO/dev_r8600_closea_rewrite/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 9207

Last change on this file since 9207 was 9078, checked in by davestorkey, 7 years ago

UKMO/dev_r8600_closea_rewrite branch : slight redesign after discussion with Gurvan:

  1. Mask fields included in domain_cfg file.
  2. Control variables changed.
  3. Suppression of closed seas now done in dom_zgr.
File size: 36.2 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   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
17   !!----------------------------------------------------------------------
18   
19   !!----------------------------------------------------------------------
20   !!   dom_init      : initialize the space and time domain
21   !!   dom_glo       : initialize global domain <--> local domain indices
22   !!   dom_nam       : read and contral domain namelists
23   !!   dom_ctl       : control print for the ocean domain
24   !!   domain_cfg    : read the global domain size in domain configuration file
25   !!   cfg_write     : create the domain configuration file
26   !!----------------------------------------------------------------------
27   USE oce            ! ocean variables
28   USE dom_oce        ! domain: ocean
29   USE sbc_oce        ! surface boundary condition: ocean
30   USE trc_oce        ! shared ocean & passive tracers variab
31   USE phycst         ! physical constants
32   USE closea         ! closed seas
33   USE domhgr         ! domain: set the horizontal mesh
34   USE domzgr         ! domain: set the vertical mesh
35   USE dommsk         ! domain: set the mask system
36   USE domwri         ! domain: write the meshmask file
37   USE domvvl         ! variable volume
38   USE c1d            ! 1D configuration
39   USE domc1d         ! 1D configuration: column location
40   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
41   USE wet_dry        ! wetting and drying
42   !
43   USE in_out_manager ! I/O manager
44   USE iom            ! I/O library
45   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
46   USE lib_mpp        ! distributed memory computing library
47   USE wrk_nemo       ! Memory Allocation
48   USE timing         ! Timing
49
50   IMPLICIT NONE
51   PRIVATE
52
53   PUBLIC   dom_init     ! called by nemogcm.F90
54   PUBLIC   domain_cfg   ! called by nemogcm.F90
55
56   !!-------------------------------------------------------------------------
57   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
58   !! $Id$
59   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
60   !!-------------------------------------------------------------------------
61CONTAINS
62
63   SUBROUTINE dom_init
64      !!----------------------------------------------------------------------
65      !!                  ***  ROUTINE dom_init  ***
66      !!                   
67      !! ** Purpose :   Domain initialization. Call the routines that are
68      !!              required to create the arrays which define the space
69      !!              and time domain of the ocean model.
70      !!
71      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
72      !!              - dom_hgr: compute or read the horizontal grid-point position
73      !!                         and scale factors, and the coriolis factor
74      !!              - dom_zgr: define the vertical coordinate and the bathymetry
75      !!              - dom_wri: create the meshmask file if nn_msh=1
76      !!              - 1D configuration, move Coriolis, u and v at T-point
77      !!----------------------------------------------------------------------
78      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
79      INTEGER ::   iconf = 0    ! local integers
80      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
81      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
82      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
83      !!----------------------------------------------------------------------
84      !
85      IF( nn_timing == 1 )   CALL timing_start('dom_init')
86      !
87      IF(lwp) THEN         ! Ocean domain Parameters (control print)
88         WRITE(numout,*)
89         WRITE(numout,*) 'dom_init : domain initialization'
90         WRITE(numout,*) '~~~~~~~~'
91         !
92         WRITE(numout,*)     '   Domain info'
93         WRITE(numout,*)     '      dimension of model:'
94         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
95         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
96         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
97         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
98         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
99         WRITE(numout,*)     '      mpp local domain info (mpp):'
100         WRITE(numout,*)     '              jpni    : ', jpni, '   jpreci  : ', jpreci
101         WRITE(numout,*)     '              jpnj    : ', jpnj, '   jprecj  : ', jprecj
102         WRITE(numout,*)     '              jpnij   : ', jpnij
103         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
104         SELECT CASE ( jperio )
105         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
106         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
107         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. equatorial symmetric)'
108         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
109         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
110         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
111         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
112         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
113         CASE DEFAULT
114            CALL ctl_stop( 'jperio is out of range' )
115         END SELECT
116         WRITE(numout,*)     '      Ocean model configuration used:'
117         WRITE(numout,*)     '              cn_cfg = ', cn_cfg
118         WRITE(numout,*)     '              nn_cfg = ', nn_cfg
119      ENDIF
120      !
121      !     
122!!gm  This should be removed with the new configuration interface
123      IF( lk_c1d .AND. ln_c1d_locpt )  CALL dom_c1d( rn_lat1d, rn_lon1d )
124!!gm end
125      !
126      !           !==  Reference coordinate system  ==!
127      !
128      CALL dom_glo                     ! global domain versus local domain
129      CALL dom_nam                     ! read namelist ( namrun, namdom )
130      CALL dom_hgr                     ! Horizontal mesh
131      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
132      CALL dom_msk( ik_top, ik_bot )   ! Masks
133      IF( ln_closea ) CALL dom_clo     ! ln_closea=T : closed seas included in the simulation
134                                       ! Read in masks to define closed seas and lakes
135      !
136      DO jj = 1, jpj                   ! depth of the iceshelves
137         DO ji = 1, jpi
138            ik = mikt(ji,jj)
139            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
140         END DO
141      END DO
142      !
143      ht_0(:,:) = 0._wp  ! Reference ocean thickness
144      hu_0(:,:) = 0._wp
145      hv_0(:,:) = 0._wp
146      DO jk = 1, jpk
147         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
148         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
149         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
150      END DO
151      !
152      !           !==  time varying part of coordinate system  ==!
153      !
154      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
155      !
156         !       before        !          now          !       after         !
157            gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
158            gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
159                                   gde3w_n = gde3w_0   !        ---          !
160         !                                                                 
161              e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
162              e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
163              e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
164                                     e3f_n =   e3f_0   !        ---          !
165              e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
166             e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
167             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
168         !
169         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
170         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
171         !
172         !        before       !          now          !       after         !
173                                      ht_n =    ht_0   !                     ! water column thickness
174               hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !
175               hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
176            r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
177            r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
178         !
179         !
180      ELSE                       != time varying : initialize before/now/after variables
181         !
182         IF( .NOT.l_offline )  CALL dom_vvl_init 
183         !
184      ENDIF
185      !
186      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
187      !
188      IF( nn_msh > 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file
189      IF( nn_msh > 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file
190      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
191      !
192     
193      IF(lwp) THEN
194         WRITE(numout,*)
195         WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh
196         WRITE(numout,*) 
197      ENDIF
198      !
199      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file
200      !
201      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
202      !
203   END SUBROUTINE dom_init
204
205
206   SUBROUTINE dom_glo
207      !!----------------------------------------------------------------------
208      !!                     ***  ROUTINE dom_glo  ***
209      !!
210      !! ** Purpose :   initialization of global domain <--> local domain indices
211      !!
212      !! ** Method  :   
213      !!
214      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
215      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
216      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
217      !!----------------------------------------------------------------------
218      INTEGER ::   ji, jj   ! dummy loop argument
219      !!----------------------------------------------------------------------
220      !
221      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
222        mig(ji) = ji + nimpp - 1
223      END DO
224      DO jj = 1, jpj
225        mjg(jj) = jj + njmpp - 1
226      END DO
227      !                              ! global domain indices ==> local domain indices
228      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
229      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
230      DO ji = 1, jpiglo
231        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
232        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
233      END DO
234      DO jj = 1, jpjglo
235        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
236        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
237      END DO
238      IF(lwp) THEN                   ! control print
239         WRITE(numout,*)
240         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
241         WRITE(numout,*) '~~~~~~~ '
242         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
243         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
244         WRITE(numout,*)
245         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
246         IF( nn_print >= 1 ) THEN
247            WRITE(numout,*)
248            WRITE(numout,*) '          conversion local  ==> global i-index domain'
249            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
250            WRITE(numout,*)
251            WRITE(numout,*) '          conversion global ==> local  i-index domain'
252            WRITE(numout,*) '             starting index'
253            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
254            WRITE(numout,*) '             ending index'
255            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
256            WRITE(numout,*)
257            WRITE(numout,*) '          conversion local  ==> global j-index domain'
258            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
259            WRITE(numout,*)
260            WRITE(numout,*) '          conversion global ==> local  j-index domain'
261            WRITE(numout,*) '             starting index'
262            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
263            WRITE(numout,*) '             ending index'
264            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
265         ENDIF
266      ENDIF
267 25   FORMAT( 100(10x,19i4,/) )
268      !
269   END SUBROUTINE dom_glo
270
271
272   SUBROUTINE dom_nam
273      !!----------------------------------------------------------------------
274      !!                     ***  ROUTINE dom_nam  ***
275      !!                   
276      !! ** Purpose :   read domaine namelists and print the variables.
277      !!
278      !! ** input   : - namrun namelist
279      !!              - namdom namelist
280      !!              - namnc4 namelist   ! "key_netcdf4" only
281      !!----------------------------------------------------------------------
282      USE ioipsl
283      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
284         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
285         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
286         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
287         &             ln_cfmeta, ln_iscpl
288      NAMELIST/namdom/ ln_linssh, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs
289#if defined key_netcdf4
290      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
291#endif
292      INTEGER  ::   ios                 ! Local integer output status for namelist read
293      !!----------------------------------------------------------------------
294      !
295      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
296      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
297901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
298      !
299      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
300      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
301902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
302      IF(lwm) WRITE ( numond, namrun )
303      !
304      IF(lwp) THEN                  ! control print
305         WRITE(numout,*)
306         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
307         WRITE(numout,*) '~~~~~~~ '
308         WRITE(numout,*) '   Namelist namrun'
309         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
310         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
311         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
312         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
313         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
314         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
315         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
316         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
317         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
318         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
319         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
320         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
321         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
322         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
323         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
324         IF( ln_rst_list ) THEN
325            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
326         ELSE
327            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
328         ENDIF
329         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
330         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
331         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
332         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
333         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
334         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
335      ENDIF
336
337      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
338      cexper = cn_exp
339      nrstdt = nn_rstctl
340      nit000 = nn_it000
341      nitend = nn_itend
342      ndate0 = nn_date0
343      nleapy = nn_leapy
344      ninist = nn_istate
345      nstock = nn_stock
346      nstocklist = nn_stocklist
347      nwrite = nn_write
348      neuler = nn_euler
349      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
350         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
351         CALL ctl_warn( ctmp1 )
352         neuler = 0
353      ENDIF
354      !                             ! control of output frequency
355      IF ( nstock == 0 .OR. nstock > nitend ) THEN
356         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
357         CALL ctl_warn( ctmp1 )
358         nstock = nitend
359      ENDIF
360      IF ( nwrite == 0 ) THEN
361         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
362         CALL ctl_warn( ctmp1 )
363         nwrite = nitend
364      ENDIF
365
366#if defined key_agrif
367      IF( Agrif_Root() ) THEN
368#endif
369      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
370      CASE (  1 ) 
371         CALL ioconf_calendar('gregorian')
372         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
373      CASE (  0 )
374         CALL ioconf_calendar('noleap')
375         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
376      CASE ( 30 )
377         CALL ioconf_calendar('360d')
378         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
379      END SELECT
380#if defined key_agrif
381      ENDIF
382#endif
383
384      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
385      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
386903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
387      !
388      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
389      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
390904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
391      IF(lwm) WRITE ( numond, namdom )
392      !
393      IF(lwp) THEN
394         WRITE(numout,*)
395         WRITE(numout,*) '   Namelist namdom : space & time domain'
396         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh
397         WRITE(numout,*) '      create mesh/mask file(s)              nn_msh     = ', nn_msh
398         WRITE(numout,*) '           = 0   no file created           '
399         WRITE(numout,*) '           = 1   mesh_mask                 '
400         WRITE(numout,*) '           = 2   mesh and mask             '
401         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
402         WRITE(numout,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)'
403         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt
404         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp
405         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs
406      ENDIF
407     
408      call flush( numout )
409      !
410!     !          ! conversion DOCTOR names into model names (this should disappear soon)
411      atfp      = rn_atfp
412      rdt       = rn_rdt
413
414#if defined key_netcdf4
415      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
416      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
417      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
418907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
419      !
420      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
421      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
422908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
423      IF(lwm) WRITE( numond, namnc4 )
424
425      IF(lwp) THEN                        ! control print
426         WRITE(numout,*)
427         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
428         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
429         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
430         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
431         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
432      ENDIF
433
434      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
435      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
436      snc4set%ni   = nn_nchunks_i
437      snc4set%nj   = nn_nchunks_j
438      snc4set%nk   = nn_nchunks_k
439      snc4set%luse = ln_nc4zip
440#else
441      snc4set%luse = .FALSE.        ! No NetCDF 4 case
442#endif
443      !
444   END SUBROUTINE dom_nam
445
446
447   SUBROUTINE dom_ctl
448      !!----------------------------------------------------------------------
449      !!                     ***  ROUTINE dom_ctl  ***
450      !!
451      !! ** Purpose :   Domain control.
452      !!
453      !! ** Method  :   compute and print extrema of masked scale factors
454      !!----------------------------------------------------------------------
455      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
456      INTEGER, DIMENSION(2) ::   iloc   !
457      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
458      !!----------------------------------------------------------------------
459      !
460      IF(lk_mpp) THEN
461         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
462         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
463         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
464         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
465      ELSE
466         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
467         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
468         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
469         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
470         !
471         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
472         iimi1 = iloc(1) + nimpp - 1
473         ijmi1 = iloc(2) + njmpp - 1
474         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
475         iimi2 = iloc(1) + nimpp - 1
476         ijmi2 = iloc(2) + njmpp - 1
477         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
478         iima1 = iloc(1) + nimpp - 1
479         ijma1 = iloc(2) + njmpp - 1
480         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
481         iima2 = iloc(1) + nimpp - 1
482         ijma2 = iloc(2) + njmpp - 1
483      ENDIF
484      IF(lwp) THEN
485         WRITE(numout,*)
486         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
487         WRITE(numout,*) '~~~~~~~'
488         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
489         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
490         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
491         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
492      ENDIF
493      !
494   END SUBROUTINE dom_ctl
495
496
497   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
498      !!----------------------------------------------------------------------
499      !!                     ***  ROUTINE dom_nam  ***
500      !!                   
501      !! ** Purpose :   read the domain size in domain configuration file
502      !!
503      !! ** Method  :   
504      !!
505      !!----------------------------------------------------------------------
506      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
507      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
508      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
509      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
510      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
511      !
512      INTEGER ::   inum, ii   ! local integer
513      REAL(wp) ::   zorca_res                     ! local scalars
514      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
515      !!----------------------------------------------------------------------
516      !
517      ii = 1
518      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
519      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'   ;   ii = ii+1
520      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
521      !
522      CALL iom_open( cn_domcfg, inum )
523      !
524      !                                   !- ORCA family specificity
525      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
526         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
527         !
528         cd_cfg = 'ORCA'
529         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res )
530         !
531         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
532         WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                         ;   ii = ii+1
533         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
534         !
535      ELSE                                !- cd_cfg & k_cfg are not used
536         cd_cfg = 'UNKNOWN'
537         kk_cfg = -9999999
538                                          !- or they may be present as global attributes
539                                          !- (netcdf only) 
540         IF( iom_file(inum)%iolib == jpnf90 ) THEN
541            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
542            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
543            IF( TRIM(cd_cfg) .EQ. '!') cd_cfg = 'UNKNOWN'
544            IF( kk_cfg .EQ. -999     ) kk_cfg = -9999999
545         ENDIF
546         !
547      ENDIF
548      !
549      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo )
550      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo )
551      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo )
552      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio )
553      CALL iom_close( inum )
554      !
555      WRITE(ldtxt(ii),*) '   cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
556      WRITE(ldtxt(ii),*) '   jpiglo = ', kpi                                              ;   ii = ii+1
557      WRITE(ldtxt(ii),*) '   jpjglo = ', kpj                                              ;   ii = ii+1
558      WRITE(ldtxt(ii),*) '   jpkglo = ', kpk                                              ;   ii = ii+1
559      WRITE(ldtxt(ii),*) '   type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
560      !       
561   END SUBROUTINE domain_cfg
562   
563   
564   SUBROUTINE cfg_write
565      !!----------------------------------------------------------------------
566      !!                  ***  ROUTINE cfg_write  ***
567      !!                   
568      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
569      !!              contains all the ocean domain informations required to
570      !!              define an ocean configuration.
571      !!
572      !! ** Method  :   Write in a file all the arrays required to set up an
573      !!              ocean configuration.
574      !!
575      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
576      !!                       mesh, Coriolis parameter, and vertical scale factors
577      !!                    NB: also contain ORCA family information
578      !!----------------------------------------------------------------------
579      INTEGER           ::   ji, jj, jk   ! dummy loop indices
580      INTEGER           ::   izco, izps, isco, icav
581      INTEGER           ::   inum     ! local units
582      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
583      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
584      !!----------------------------------------------------------------------
585      !
586      IF(lwp) WRITE(numout,*)
587      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
588      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
589      !
590      !                       ! ============================= !
591      !                       !  create 'domcfg_out.nc' file  !
592      !                       ! ============================= !
593      !         
594      clnam = 'domcfg_out'  ! filename (configuration information)
595      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
596     
597      !
598      !                             !==  ORCA family specificities  ==!
599      IF( cn_cfg == "ORCA" ) THEN
600         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
601         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
602      ENDIF
603      !
604      !                             !==  global domain size  ==!
605      !
606      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
607      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
608      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
609      !
610      !                             !==  domain characteristics  ==!
611      !
612      !                                   ! lateral boundary of the global domain
613      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
614      !
615      !                                   ! type of vertical coordinate
616      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
617      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
618      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
619      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
620      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
621      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
622      !
623      !                                   ! ocean cavities under iceshelves
624      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
625      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
626      !
627      !                             !==  horizontal mesh  !
628      !
629      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
630      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
631      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
632      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
633      !                               
634      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
635      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
636      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
637      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
638      !                               
639      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
640      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
641      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
642      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
643      !
644      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
645      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
646      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
647      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
648      !
649      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
650      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
651      !
652      !                             !==  vertical mesh  ==!
653      !                                                     
654      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
655      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
656      !
657      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
658      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
659      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
660      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
661      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
662      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
663      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
664      !                                         
665      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
666      !
667      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
668      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
669      !
670      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
671         CALL dom_stiff( z2d )
672         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
673      ENDIF
674      !
675      IF( ln_wd ) THEN              ! wetting and drying domain
676         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
677         CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
678      ENDIF
679      !
680      ! Add some global attributes ( netcdf only )
681      IF( iom_file(inum)%iolib == jpnf90 ) THEN
682         CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
683         CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
684      ENDIF
685      !
686      !                                ! ============================
687      !                                !        close the files
688      !                                ! ============================
689      CALL iom_close( inum )
690      !
691   END SUBROUTINE cfg_write
692
693   !!======================================================================
694END MODULE domain
Note: See TracBrowser for help on using the repository browser.