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 NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/DOM – NEMO

source: NEMO/branches/2020/dev_12905_xios_ancil/src/OCE/DOM/domain.F90 @ 13039

Last change on this file since 13039 was 13039, checked in by andmirek, 4 years ago

Ticket #2475 fix for AGRIF
  • 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 domhgr         ! domain: set the horizontal mesh
33   USE domzgr         ! domain: set the vertical mesh
34   USE dommsk         ! domain: set the mask system
35   USE domwri         ! domain: write the meshmask file
36   USE domvvl         ! variable volume
37   USE c1d            ! 1D configuration
38   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
39   USE wet_dry, ONLY : ll_wd
40   USE closea , ONLY : dom_clo ! closed seas
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/OCE 4.0 , NEMO Consortium (2018)
55   !! $Id$
56   !! Software governed by the CeCILL license (see ./LICENSE)
57   !!-------------------------------------------------------------------------
58CONTAINS
59
60   SUBROUTINE dom_init( Kbb, Kmm, Kaa, 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          , INTENT(in) :: Kbb, Kmm, Kaa          ! ocean time level indices
76      CHARACTER (len=*), INTENT(in) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables
77      !
78      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
79      INTEGER ::   iconf = 0    ! local integers
80      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
81      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
82      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
83      !!----------------------------------------------------------------------
84      !
85      IF(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, '   nn_hls  : ', nn_hls
99         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
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. cyclic north-south)'
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 = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
116      ENDIF
117      lwxios = .FALSE.
118      ln_xios_read = .FALSE.
119      !
120      !           !==  Reference coordinate system  ==!
121      !
122      CALL dom_glo                     ! global domain versus local domain
123      CALL dom_nam                     ! read namelist ( namrun, namdom )
124
125      !
126      IF( lwxios ) THEN
127!define names for restart write and set core output (restart.F90)
128         CALL iom_set_rst_vars(rst_wfields)
129         CALL iom_set_rstw_core(cdstr)
130      ENDIF
131!reset namelist for SAS
132      IF(cdstr == 'SAS') THEN
133         IF(lrxios) THEN
134               IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'
135               lrxios = .FALSE.
136         ENDIF
137      ENDIF
138      !
139      CALL dom_hgr                      ! Horizontal mesh
140
141      IF( ln_closea ) CALL dom_clo      ! Read in masks to define closed seas and lakes
142
143      CALL dom_zgr( ik_top, ik_bot )    ! Vertical mesh and bathymetry
144
145      CALL dom_msk( ik_top, ik_bot )    ! Masks
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(:,:,:,Kbb) = gdept_0  ;   gdept(:,:,:,Kmm) = gdept_0   ;   gdept(:,:,:,Kaa) = gdept_0   ! depth of grid-points
162            gdepw(:,:,:,Kbb) = gdepw_0  ;   gdepw(:,:,:,Kmm) = gdepw_0   ;   gdepw(:,:,:,Kaa) = gdepw_0   !
163                                   gde3w = gde3w_0   !        ---          !
164         !                                                                 
165              e3t(:,:,:,Kbb) =   e3t_0  ;     e3t(:,:,:,Kmm) =   e3t_0   ;   e3t(:,:,:,Kaa) =  e3t_0    ! scale factors
166              e3u(:,:,:,Kbb) =   e3u_0  ;     e3u(:,:,:,Kmm) =   e3u_0   ;   e3u(:,:,:,Kaa) =  e3u_0    !
167              e3v(:,:,:,Kbb) =   e3v_0  ;     e3v(:,:,:,Kmm) =   e3v_0   ;   e3v(:,:,:,Kaa) =  e3v_0    !
168                                     e3f =   e3f_0   !        ---          !
169              e3w(:,:,:,Kbb) =   e3w_0  ;     e3w(:,:,:,Kmm) =   e3w_0   ;    e3w(:,:,:,Kaa) =   e3w_0   !
170             e3uw(:,:,:,Kbb) =  e3uw_0  ;    e3uw(:,:,:,Kmm) =  e3uw_0   ;   e3uw(:,:,:,Kaa) =  e3uw_0   ! 
171             e3vw(:,:,:,Kbb) =  e3vw_0  ;    e3vw(:,:,:,Kmm) =  e3vw_0   ;   e3vw(:,:,:,Kaa) =  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 =    ht_0   !                     ! water column thickness
178               hu(:,:,Kbb) =    hu_0  ;      hu(:,:,Kmm) =    hu_0   ;    hu(:,:,Kaa) =    hu_0   !
179               hv(:,:,Kbb) =    hv_0  ;      hv(:,:,Kmm) =    hv_0   ;    hv(:,:,Kaa) =    hv_0   !
180            r1_hu(:,:,Kbb) = z1_hu_0  ;   r1_hu(:,:,Kmm) = z1_hu_0   ; r1_hu(:,:,Kaa) = z1_hu_0   ! inverse of water column thickness
181            r1_hv(:,:,Kbb) = z1_hv_0  ;   r1_hv(:,:,Kmm) = z1_hv_0   ; r1_hv(:,:,Kaa) = z1_hv_0   !
182         !
183         !
184      ELSE                       != time varying : initialize before/now/after variables
185         !
186         IF( .NOT.l_offline )  CALL dom_vvl_init( Kbb, Kmm, Kaa )
187         !
188      ENDIF
189      !
190      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
191      !
192      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file
193      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
194      !
195      IF( ln_write_cfg   )   CALL cfg_write     ! create the configuration file
196      !
197      IF(lwp) THEN
198         WRITE(numout,*)
199         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization'
200         WRITE(numout,*) '~~~~~~~~'
201         WRITE(numout,*) 
202      ENDIF
203      !
204   END SUBROUTINE dom_init
205
206
207   SUBROUTINE dom_glo
208      !!----------------------------------------------------------------------
209      !!                     ***  ROUTINE dom_glo  ***
210      !!
211      !! ** Purpose :   initialization of global domain <--> local domain indices
212      !!
213      !! ** Method  :   
214      !!
215      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
216      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
217      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
218      !!----------------------------------------------------------------------
219      INTEGER ::   ji, jj   ! dummy loop argument
220      !!----------------------------------------------------------------------
221      !
222      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
223        mig(ji) = ji + nimpp - 1
224      END DO
225      DO jj = 1, jpj
226        mjg(jj) = jj + njmpp - 1
227      END DO
228      !                              ! global domain indices ==> local domain indices
229      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
230      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
231      DO ji = 1, jpiglo
232        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
233        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
234      END DO
235      DO jj = 1, jpjglo
236        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
237        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
238      END DO
239      IF(lwp) THEN                   ! control print
240         WRITE(numout,*)
241         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
242         WRITE(numout,*) '~~~~~~~ '
243         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
244         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
245         WRITE(numout,*)
246         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
247         IF( nn_print >= 1 ) THEN
248            WRITE(numout,*)
249            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
250            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
251            WRITE(numout,*)
252            WRITE(numout,*) '          conversion global ==> local  i-index domain'
253            WRITE(numout,*) '             starting index (mi0)'
254            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
255            WRITE(numout,*) '             ending index (mi1)'
256            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
257            WRITE(numout,*)
258            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
259            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
260            WRITE(numout,*)
261            WRITE(numout,*) '          conversion global ==> local  j-index domain'
262            WRITE(numout,*) '             starting index (mj0)'
263            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
264            WRITE(numout,*) '             ending index (mj1)'
265            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
266         ENDIF
267      ENDIF
268 25   FORMAT( 100(10x,19i4,/) )
269      !
270   END SUBROUTINE dom_glo
271
272
273   SUBROUTINE dom_nam
274      !!----------------------------------------------------------------------
275      !!                     ***  ROUTINE dom_nam  ***
276      !!                   
277      !! ** Purpose :   read domaine namelists and print the variables.
278      !!
279      !! ** input   : - namrun namelist
280      !!              - namdom namelist
281      !!              - namnc4 namelist   ! "key_netcdf4" only
282      !!----------------------------------------------------------------------
283      USE ioipsl
284      !!
285      INTEGER  ::   ios   ! Local integer
286      !
287      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
288         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
289         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
290         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, ln_1st_euler  , &
291         &             ln_cfmeta, ln_xios_read, nn_wxios
292      NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask
293#if defined key_netcdf4
294      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
295#endif
296      !!----------------------------------------------------------------------
297      !
298      IF(lwp) THEN
299         WRITE(numout,*)
300         WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
301         WRITE(numout,*) '~~~~~~~ '
302      ENDIF
303      !
304      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
305901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist' )
306      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
307902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' )
308      IF(lwm) WRITE ( numond, namrun )
309      !
310      IF(lwp) THEN                  ! control print
311         WRITE(numout,*) '   Namelist : namrun   ---   run parameters'
312         WRITE(numout,*) '      Assimilation cycle              nn_no           = ', nn_no
313         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           )
314         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     )
315         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  )
316         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    )
317         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
318         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
319         WRITE(numout,*) '      start with forward time step    ln_1st_euler    = ', ln_1st_euler
320         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
321         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
322         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend
323         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0
324         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0
325         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy
326         WRITE(numout,*) '      initial state output            nn_istate       = ', nn_istate
327         IF( ln_rst_list ) THEN
328            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist
329         ELSE
330            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock
331         ENDIF
332#if ! defined key_iomput
333         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write
334#endif
335         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland
336         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta
337         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
338         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
339         IF( TRIM(Agrif_CFixed()) == '0' ) THEN
340            WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
341            WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
342            WRITE(numout,*) '      READ config using XIOS          ln_xios_cfg  = ', ln_xios_cfg
343         ELSE
344            WRITE(numout,*) "      AGRIF: nn_wxios will be ingored. See setting for parent"
345            WRITE(numout,*) "      AGRIF: ln_xios_read will be ingored. See setting for parent"
346            WRITE(numout,*) "      AGRIF: ln_xios_cfg will be ingored. See setting for parent"
347         ENDIF
348      ENDIF
349
350      cexper = cn_exp         ! conversion DOCTOR names into model names (this should disappear soon)
351      nrstdt = nn_rstctl
352      nit000 = nn_it000
353      nitend = nn_itend
354      ndate0 = nn_date0
355      nleapy = nn_leapy
356      ninist = nn_istate
357      l_1st_euler = ln_1st_euler
358      IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN
359         IF(lwp) WRITE(numout,*) 
360         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
361         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. '   
362         l_1st_euler = .true.
363      ENDIF
364      !                             ! control of output frequency
365      IF( .NOT. ln_rst_list ) THEN     ! we use nn_stock
366         IF( nn_stock == -1 )   CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' )
367         IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN
368            WRITE(ctmp1,*) 'nn_stock = ', nn_stock, ' it is forced to ', nitend
369            CALL ctl_warn( ctmp1 )
370            nn_stock = nitend
371         ENDIF
372      ENDIF
373#if ! defined key_iomput
374      IF( nn_write == -1 )   CALL ctl_warn( 'nn_write = -1 --> no output files will be done' )
375      IF ( nn_write == 0 ) THEN
376         WRITE(ctmp1,*) 'nn_write = ', nn_write, ' it is forced to ', nitend
377         CALL ctl_warn( ctmp1 )
378         nn_write = nitend
379      ENDIF
380#endif
381
382#if defined key_agrif
383      IF( Agrif_Root() ) THEN
384#endif
385      IF(lwp) WRITE(numout,*)
386      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
387      CASE (  1 ) 
388         CALL ioconf_calendar('gregorian')
389         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
390      CASE (  0 )
391         CALL ioconf_calendar('noleap')
392         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
393      CASE ( 30 )
394         CALL ioconf_calendar('360d')
395         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
396      END SELECT
397#if defined key_agrif
398      ENDIF
399#endif
400
401      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
402903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' )
403      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
404904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' )
405      IF(lwm) WRITE( numond, namdom )
406      !
407      IF(lwp) THEN
408         WRITE(numout,*)
409         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
410         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
411         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
412         WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt
413         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp
414         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
415      ENDIF
416      !
417      !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3
418      rDt  = 2._wp * rn_Dt
419      r1_Dt = 1._wp / rDt
420
421      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
422         lrxios = ln_xios_read.AND.ln_rstart
423!set output file type for XIOS based on NEMO namelist
424         IF (nn_wxios > 0) lwxios = .TRUE. 
425         nxioso = nn_wxios
426         lcfg_xios = ln_xios_cfg .AND. (.NOT. ln_use_jattr)
427      ENDIF
428
429#if defined key_netcdf4
430      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
431      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
432907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
433      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
434908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
435      IF(lwm) WRITE( numond, namnc4 )
436
437      IF(lwp) THEN                        ! control print
438         WRITE(numout,*)
439         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
440         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i
441         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j
442         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k
443         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip
444      ENDIF
445
446      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
447      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
448      snc4set%ni   = nn_nchunks_i
449      snc4set%nj   = nn_nchunks_j
450      snc4set%nk   = nn_nchunks_k
451      snc4set%luse = ln_nc4zip
452#else
453      snc4set%luse = .FALSE.        ! No NetCDF 4 case
454#endif
455      !
456   END SUBROUTINE dom_nam
457
458
459   SUBROUTINE dom_ctl
460      !!----------------------------------------------------------------------
461      !!                     ***  ROUTINE dom_ctl  ***
462      !!
463      !! ** Purpose :   Domain control.
464      !!
465      !! ** Method  :   compute and print extrema of masked scale factors
466      !!----------------------------------------------------------------------
467      INTEGER, DIMENSION(2) ::   imi1, imi2, ima1, ima2
468      INTEGER, DIMENSION(2) ::   iloc   !
469      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
470      !!----------------------------------------------------------------------
471      !
472      IF(lk_mpp) THEN
473         CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 )
474         CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 )
475         CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 )
476         CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 )
477      ELSE
478         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
479         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
480         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
481         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
482         !
483         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
484         imi1(1) = iloc(1) + nimpp - 1
485         imi1(2) = iloc(2) + njmpp - 1
486         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
487         imi2(1) = iloc(1) + nimpp - 1
488         imi2(2) = iloc(2) + njmpp - 1
489         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
490         ima1(1) = iloc(1) + nimpp - 1
491         ima1(2) = iloc(2) + njmpp - 1
492         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
493         ima2(1) = iloc(1) + nimpp - 1
494         ima2(2) = iloc(2) + njmpp - 1
495      ENDIF
496      IF(lwp) THEN
497         WRITE(numout,*)
498         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
499         WRITE(numout,*) '~~~~~~~'
500         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
501         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
502         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
503         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
504      ENDIF
505      !
506   END SUBROUTINE dom_ctl
507
508
509   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
510      !!----------------------------------------------------------------------
511      !!                     ***  ROUTINE dom_nam  ***
512      !!                   
513      !! ** Purpose :   read the domain size in domain configuration file
514      !!
515      !! ** Method  :   read the cn_domcfg NetCDF file
516      !!----------------------------------------------------------------------
517      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
518      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
519      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
520      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
521      !
522      INTEGER ::   inum   ! local integer
523      REAL(wp) ::   zorca_res                     ! local scalars
524      REAL(wp) ::   zperio                        !   -      -
525      INTEGER, DIMENSION(4) ::   idvar, idimsz    ! size   of dimensions
526      !!----------------------------------------------------------------------
527      !
528      IF(lwp) THEN
529         WRITE(numout,*) '           '
530         WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
531         WRITE(numout,*) '~~~~~~~~~~ '
532      ENDIF
533      !
534      CALL iom_open( cn_domcfg, inum )
535      !
536      !                                   !- ORCA family specificity
537      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
538         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
539         !
540         cd_cfg = 'ORCA'
541         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res )
542         !
543         IF(lwp) THEN
544            WRITE(numout,*) '   .'
545            WRITE(numout,*) '   ==>>>   ORCA configuration '
546            WRITE(numout,*) '   .'
547         ENDIF
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         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
555         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
556         IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
557         IF( kk_cfg == -999     ) kk_cfg = -9999999
558         !
559      ENDIF
560       !
561      idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz )   ! use e3t_0, that must exist, to get jp(ijk)glo
562      kpi = idimsz(1)
563      kpj = idimsz(2)
564      kpk = idimsz(3)
565      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio )
566      CALL iom_close( inum )
567      !
568      IF(lwp) THEN
569         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg
570         WRITE(numout,*) '      jpiglo = ', kpi
571         WRITE(numout,*) '      jpjglo = ', kpj
572         WRITE(numout,*) '      jpkglo = ', kpk
573         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio
574      ENDIF
575      !       
576   END SUBROUTINE domain_cfg
577   
578   
579   SUBROUTINE cfg_write
580      !!----------------------------------------------------------------------
581      !!                  ***  ROUTINE cfg_write  ***
582      !!                   
583      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
584      !!              contains all the ocean domain informations required to
585      !!              define an ocean configuration.
586      !!
587      !! ** Method  :   Write in a file all the arrays required to set up an
588      !!              ocean configuration.
589      !!
590      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
591      !!                       mesh, Coriolis parameter, and vertical scale factors
592      !!                    NB: also contain ORCA family information
593      !!----------------------------------------------------------------------
594      INTEGER           ::   ji, jj, jk   ! dummy loop indices
595      INTEGER           ::   izco, izps, isco, icav
596      INTEGER           ::   inum     ! local units
597      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
598      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
599      !!----------------------------------------------------------------------
600      !
601      IF(lwp) WRITE(numout,*)
602      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
603      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
604      !
605      !                       ! ============================= !
606      !                       !  create 'domcfg_out.nc' file  !
607      !                       ! ============================= !
608      !         
609      clnam = cn_domcfg_out  ! filename (configuration information)
610      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
611     
612      !
613      !                             !==  ORCA family specificities  ==!
614      IF( cn_cfg == "ORCA" ) THEN
615         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
616         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
617      ENDIF
618      !
619      !                             !==  global domain size  ==!
620      !
621      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
622      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
623      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
624      !
625      !                             !==  domain characteristics  ==!
626      !
627      !                                   ! lateral boundary of the global domain
628      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
629      !
630      !                                   ! type of vertical coordinate
631      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
632      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
633      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
634      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
635      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
636      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
637      !
638      !                                   ! ocean cavities under iceshelves
639      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
640      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
641      !
642      !                             !==  horizontal mesh  !
643      !
644      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
645      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
646      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
647      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
648      !                               
649      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
650      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
651      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
652      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
653      !                               
654      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
655      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
656      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
657      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
658      !
659      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
660      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
661      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
662      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
663      !
664      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
665      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
666      !
667      !                             !==  vertical mesh  ==!
668      !                                                     
669      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
670      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
671      !
672      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
673      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
674      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
675      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
676      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
677      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
678      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
679      !                                         
680      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
681      !
682      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
683      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
684      !
685      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
686         CALL dom_stiff( z2d )
687         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
688      ENDIF
689      !
690      IF( ll_wd ) THEN              ! wetting and drying domain
691         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
692      ENDIF
693      !
694      ! Add some global attributes ( netcdf only )
695      CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
696      CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
697      !
698      !                                ! ============================
699      !                                !        close the files
700      !                                ! ============================
701      CALL iom_close( inum )
702      !
703   END SUBROUTINE cfg_write
704
705   !!======================================================================
706END MODULE domain
Note: See TracBrowser for help on using the repository browser.