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

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 9124

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

dev_merge_2017: ln_timing instead of nn_timing + restricted timing to nemo_init and routine called by step in OPA_SRC

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