source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domain.F90 @ 12732

Last change on this file since 12732 was 12732, checked in by techene, 5 months ago

some cleaning and proper module/routine name, mini bug introduced and corrected in sbcice_cice

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