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

Last change on this file since 12680 was 12680, checked in by techene, 8 months ago

dynatfQCO.F90, stepLF.F90 : fixed (remove pe3. from dyn_atf_qco input arguments), all : remove e3. tables and include gurvan's feedbacks

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