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 @ 13998

Last change on this file since 13998 was 13998, checked in by techene, 3 years ago

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