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/r14118_ticket2377/src/OCE/DOM – NEMO

source: NEMO/branches/2020/r14118_ticket2377/src/OCE/DOM/domain.F90 @ 14129

Last change on this file since 14129 was 14129, checked in by smueller, 4 years ago

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