source: NEMO/trunk/src/OCE/DOM/domain.F90 @ 13286

Last change on this file since 13286 was 13286, checked in by smasson, 3 months ago

trunk: merge extra halos branch in trunk, see #2366

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