New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
domain.F90 in NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM – NEMO

source: NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM/domain.F90 @ 13606

Last change on this file since 13606 was 13606, checked in by techene, 20 months ago

#2385 adapted for SWE

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