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/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 8970

Last change on this file since 8970 was 8970, checked in by gm, 6 years ago

dev_CNRS_2017: bug correction in GLS + minor updates

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