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_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM – NEMO

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domain.F90 @ 13065

Last change on this file since 13065 was 13065, checked in by smasson, 4 years ago

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