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_r12973_AGRIF_CMEMS/src/OCE/DOM – NEMO

source: NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/OCE/DOM/domain.F90 @ 13026

Last change on this file since 13026 was 13026, checked in by rblod, 4 years ago

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