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

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

trunk: Mid-year merge, merge back KERNEL-06_techene_e3

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