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

Last change on this file since 9367 was 9367, checked in by mathiot, 6 years ago

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