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

source: NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domain.F90 @ 10030

Last change on this file since 10030 was 10030, checked in by gm, 6 years ago

#1911 (ENHANCE-04): RK3 branch - step II.3 remove e3uw_$ e3vw_$, except e3.w_0 and use only after e3 in dyn/trazdf
  • Property svn:keywords set to Id
File size: 38.7 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   !!            5.0  !  2018-07  (G. Madec)  RK3: add a time-level dimension to time-varying variables
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 closea         ! closed seas
34   USE domhgr         ! domain: set the horizontal mesh
35   USE domzgr         ! domain: set the vertical mesh
36   USE dommsk         ! domain: set the mask system
37   USE domwri         ! domain: write the meshmask file
38   USE domvvl         ! variable volume
39   USE c1d            ! 1D configuration
40   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
41   USE wet_dry,  ONLY : ll_wd
42   !
43   USE in_out_manager ! I/O manager
44   USE iom            ! I/O library
45   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
46   USE lib_mpp        ! distributed memory computing library
47
48   IMPLICIT NONE
49   PRIVATE
50
51   PUBLIC   dom_nam      ! called by nemogcm.F90
52   PUBLIC   dom_init     ! called by nemogcm.F90
53   PUBLIC   domain_cfg   ! called by nemogcm.F90
54
55   !!-------------------------------------------------------------------------
56   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
57   !! $Id$
58   !! Software governed by the CeCILL licence        (./LICENSE)
59   !!-------------------------------------------------------------------------
60CONTAINS
61
62   SUBROUTINE dom_init(cdstr)
63      !!----------------------------------------------------------------------
64      !!                  ***  ROUTINE dom_init  ***
65      !!                   
66      !! ** Purpose :   Domain initialization. Call the routines that are
67      !!              required to create the arrays which define the space
68      !!              and time domain of the ocean model.
69      !!
70      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
71      !!              - dom_hgr: compute or read the horizontal grid-point position
72      !!                         and scale factors, and the coriolis factor
73      !!              - dom_zgr: define the vertical coordinate and the bathymetry
74      !!              - dom_wri: create the meshmask file (ln_meshmask=T)
75      !!              - 1D configuration, move Coriolis, u and v at T-point
76      !!----------------------------------------------------------------------
77      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
78      INTEGER ::   iconf = 0    ! local integers
79      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
80      CHARACTER (len=*), INTENT(IN) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables
81      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
82      !!----------------------------------------------------------------------
83      !
84      IF(lwp) THEN         ! Ocean domain Parameters (control print)
85         WRITE(numout,*)
86         WRITE(numout,*) 'dom_init : domain initialization'
87         WRITE(numout,*) '~~~~~~~~'
88         !
89         WRITE(numout,*)     '   Domain info'
90         WRITE(numout,*)     '      dimension of model:'
91         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
92         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
93         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
94         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
95         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
96         WRITE(numout,*)     '      mpp local domain info (mpp):'
97         WRITE(numout,*)     '              jpni    : ', jpni, '   nn_hls  : ', nn_hls
98         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
99         WRITE(numout,*)     '              jpnij   : ', jpnij
100         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
101         SELECT CASE ( jperio )
102         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
103         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
104         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. equatorial symmetric)'
105         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
106         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
107         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
108         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
109         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
110         CASE DEFAULT
111            CALL ctl_stop( 'jperio is out of range' )
112         END SELECT
113         WRITE(numout,*)     '      Ocean model configuration used:'
114         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
115      ENDIF
116      lwxios = .FALSE.
117      ln_xios_read = .FALSE.
118      !
119      !           !==  Reference coordinate system  ==!
120      !
121      CALL dom_glo                     ! global domain versus local domain
122      !
123      IF( lwxios ) THEN                ! define names for restart write and set core output (restart.F90)
124         CALL iom_set_rst_vars(rst_wfields)
125         CALL iom_set_rstw_core(cdstr)
126      ENDIF
127      IF( cdstr == 'SAS' ) THEN        ! reset namelist for SAS
128         IF(lrxios) THEN
129               IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'
130               lrxios = .FALSE.
131         ENDIF
132      ENDIF
133      !
134      CALL dom_hgr                     ! Horizontal mesh
135      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
136      CALL dom_msk( ik_top, ik_bot )   ! Masks
137      IF( ln_closea )   CALL dom_clo   ! ln_closea=T : closed seas included in the simulation
138      !                                ! Read in masks to define closed seas and lakes
139      !
140      DO jj = 1, jpj                   ! depth of the iceshelves
141         DO ji = 1, jpi
142            ik = mikt(ji,jj)
143            ht_isf(ji,jj) = gdepw_0(ji,jj,ik)
144         END DO
145      END DO
146      !
147      ht_0(:,:) = 0._wp  ! Reference water column thickness  (wet point only, i.e. without ISF thickness
148      hu_0(:,:) = 0._wp  !           ------------                                  and zero over land    )   
149      hv_0(:,:) = 0._wp
150      hf_0(:,:) = 0._wp
151      DO jk = 1, jpk
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         hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * fmask(:,:,jk)
156      END DO
157      !
158      r1_ht_0(:,:) =  ssmask(:,:) / ( ht_0(:,:) + 1._wp -  ssmask(:,:) )    ! =0 on lands
159      r1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )    ! not in ISF areas
160      r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
161      r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp - ssfmask(:,:) )
162      !
163      !           !==  time varying part of coordinate system  ==!
164      !
165      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
166         !
167         !    before         !          now          !       after         !
168         gdept_b = gdept_0   ;   gdept_n = gdept_0   !        ---          !    depth
169         gdepw_b = gdepw_0   ;   gdepw_n = gdepw_0   !        ---          !     of
170                                 gde3w_n = gde3w_0   !        ---          ! grid-points
171         !                   !                       !                     !                                             
172           e3t_b =   e3t_0   ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    !  scale
173           e3u_b =   e3u_0   ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    ! factors
174           e3v_b =   e3v_0   ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
175                                   e3f_n =   e3f_0   !        ---          !
176           e3w_b =   e3w_0   ;     e3w_n =   e3w_0   !        ---          !
177         !                   !
178                                    ht_n =    ht_0   !                     ! water column
179            hu_b =    hu_0   ;      hu_n =    hu_0   ;    hu_a =    hu_0   !  thickness
180            hv_b =    hv_0   ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
181         r1_hu_b = r1_hu_0   ;   r1_hu_n = r1_hu_0   ; r1_hu_a = r1_hu_0   ! 1 / water column
182         r1_hv_b = r1_hv_0   ;   r1_hv_n = r1_hv_0   ; r1_hv_a = r1_hv_0   !       thickness
183         !
184      ELSE                       != time varying : initialize before/now/after variables
185         !
186         IF( .NOT.l_offline )  CALL dom_vvl_init 
187         !
188      ENDIF
189      !
190      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
191      !
192      IF( ln_meshmask .AND. .NOT.ln_iscpl                      )   CALL dom_wri     ! Create a domain file
193      IF( ln_meshmask .AND.      ln_iscpl .AND. .NOT.ln_rstart )   CALL dom_wri     ! Create a domain file
194      IF(                                       .NOT.ln_rstart )   CALL dom_ctl     ! Domain control
195      !
196      IF( ln_write_cfg )   CALL cfg_write       ! create the configuration file
197      !
198      IF(lwp) THEN
199         WRITE(numout,*)
200         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization'
201         WRITE(numout,*) '~~~~~~~~'
202         WRITE(numout,*) 
203      ENDIF
204       !
205   END SUBROUTINE dom_init
206
207
208   SUBROUTINE dom_glo
209      !!----------------------------------------------------------------------
210      !!                     ***  ROUTINE dom_glo  ***
211      !!
212      !! ** Purpose :   initialization of global domain <--> local domain indices
213      !!
214      !! ** Method  :   
215      !!
216      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
217      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
218      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
219      !!----------------------------------------------------------------------
220      INTEGER ::   ji, jj   ! dummy loop argument
221      !!----------------------------------------------------------------------
222      !
223      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
224        mig(ji) = ji + nimpp - 1
225      END DO
226      DO jj = 1, jpj
227        mjg(jj) = jj + njmpp - 1
228      END DO
229      !                              ! global domain indices ==> local domain indices
230      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
231      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
232      DO ji = 1, jpiglo
233        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
234        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
235      END DO
236      DO jj = 1, jpjglo
237        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
238        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
239      END DO
240      IF(lwp) THEN                   ! control print
241         WRITE(numout,*)
242         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
243         WRITE(numout,*) '~~~~~~~ '
244         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
245         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
246         WRITE(numout,*)
247         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
248         IF( nn_print >= 1 ) THEN
249            WRITE(numout,*)
250            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
251            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
252            WRITE(numout,*)
253            WRITE(numout,*) '          conversion global ==> local  i-index domain'
254            WRITE(numout,*) '             starting index (mi0)'
255            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
256            WRITE(numout,*) '             ending index (mi1)'
257            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
258            WRITE(numout,*)
259            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
260            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
261            WRITE(numout,*)
262            WRITE(numout,*) '          conversion global ==> local  j-index domain'
263            WRITE(numout,*) '             starting index (mj0)'
264            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
265            WRITE(numout,*) '             ending index (mj1)'
266            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
267         ENDIF
268      ENDIF
269 25   FORMAT( 100(10x,19i4,/) )
270      !
271   END SUBROUTINE dom_glo
272
273
274   SUBROUTINE dom_nam
275      !!----------------------------------------------------------------------
276      !!                     ***  ROUTINE dom_nam  ***
277      !!                   
278      !! ** Purpose :   read domaine namelists and print the variables.
279      !!
280      !! ** input   : - namrun namelist
281      !!              - namdom namelist
282      !!              - namnc4 namelist   ! "key_netcdf4" only
283      !!----------------------------------------------------------------------
284      USE ioipsl
285      !!
286      INTEGER  ::   ios   ! Local integer
287      !
288      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                   &
289         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl   ,     &
290         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , ln_istate   ,     &
291         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, ln_1st_euler,     &
292         &             ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios
293      NAMELIST/namdom/ ln_RK3, ln_MLF, rn_Dt, rn_atfp, ln_linssh, rn_isfhmin, ln_crs, ln_meshmask
294#if defined key_netcdf4
295      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
296#endif
297      !!----------------------------------------------------------------------
298      !
299      IF(lwp) THEN
300         WRITE(numout,*)
301         WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
302         WRITE(numout,*) '~~~~~~~ '
303      ENDIF
304      !
305      REWIND( numnam_ref )                ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
306      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
307903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
308      REWIND( numnam_cfg )                ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
309      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
310904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
311      IF(lwm) WRITE( numond, namdom )
312      !
313      IF(lwp) THEN
314         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
315         WRITE(numout,*) '      3rd order Runge-Kutta scheme            ln_RK3      = ', ln_RK3
316         WRITE(numout,*) '      Modified Leap-Frog    scheme            ln_MLF      = ', ln_MLF
317         WRITE(numout,*) '         asselin time filter parameter           rn_atfp  = ', rn_atfp
318         WRITE(numout,*) '      ocean time step (RK3 & MLF)             rn_Dt       = ', rn_Dt
319         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
320         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
321         WRITE(numout,*) '      treshold to open the isf cavity         rn_isfhmin  = ', rn_isfhmin, ' [m]'
322         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
323         WRITE(numout,*) 
324      ENDIF
325      !
326      IF ( (      ln_RK3 .AND. .NOT.ln_MLF ) .OR.   &
327         & ( .NOT.ln_RK3 .AND.      ln_MLF ) ) THEN
328         IF( ln_RK3 .AND. lwp )   WRITE(numout,*)'   ==>>>   a RK3 time-stepping scheme is used'
329         IF( ln_MLF .AND. lwp )   WRITE(numout,*)'   ==>>>   a MLF time-stepping scheme is used'
330      ELSE
331         CALL ctl_stop( 'dom_nam: select one and only one time stepping scheme')
332      ENDIF
333      !
334      !                                   ! Set the number of time-level
335      !
336      IF    ( ln_RK3 ) THEN                  ! two-level time-stepping scheme
337         Nt = 2                                    ! number of time-level
338         Nbb = 1     ! before=now                  ! time indexes
339         Nnn = 1     ! now   (n  )
340         Naa = 2     ! after (n+1)
341         !
342      ELSEIF( ln_MLF ) THEN                  ! three-level time-stepping scheme
343         Nt = 3                                    ! number of time-level
344         Nbb = 1     ! before (n-1)
345         Nnn = 2     ! now    (n  )
346         Naa = 3     ! after  (n+1)
347      ENDIF
348      !
349      REWIND( numnam_ref )                ! Namelist namrun in reference namelist : Parameters of the run
350      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
351901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
352      REWIND( numnam_cfg )                ! Namelist namrun in configuration namelist : Parameters of the run
353      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
354902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
355      IF(lwm) WRITE ( numond, namrun )
356      !
357      IF(lwp) THEN                        ! control print
358         WRITE(numout,*)
359         WRITE(numout,*) '   Namelist : namrun   ---   run parameters'
360         WRITE(numout,*) '      Assimilation cycle              nn_no           = ', nn_no
361         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           )
362         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     )
363         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  )
364         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    )
365         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
366         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
367         WRITE(numout,*) '      start with forward time step    ln_1st_euler    = ', ln_1st_euler
368         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
369         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
370         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend
371         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0
372         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0
373         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy
374         WRITE(numout,*) '      output the initial state        ln_istate       = ', ln_istate
375         IF( ln_rst_list ) THEN
376            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist
377         ELSE
378            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock
379         ENDIF
380         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write
381         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland
382         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta
383         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
384         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
385         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl        = ', ln_iscpl
386         IF( TRIM(Agrif_CFixed()) == '0' ) THEN
387            WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
388            WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
389         ELSE
390            WRITE(numout,*) "      AGRIF: nn_wxios will be ingored. See setting for parent"
391            WRITE(numout,*) "      AGRIF: ln_xios_read will be ingored. See setting for parent"
392         ENDIF
393      ENDIF
394
395      cexper = cn_exp         ! conversion from namelist names to model names (this should disappear)
396      nrstdt = nn_rstctl
397      nit000 = nn_it000
398      nitend = nn_itend
399      ndate0 = nn_date0
400      nleapy = nn_leapy
401      nstock = nn_stock
402      nstocklist = nn_stocklist
403      nwrite = nn_write
404     
405      IF( ln_MLF ) THEN       ! Leap-Frog only
406         IF( ln_rstart ) THEN       ! restart : set 1st time-step scheme (LF or forward)
407            l_1st_euler = ln_1st_euler
408         ELSE                       ! start from rest : always an Euler scheme for the 1st time-step
409            IF(lwp) WRITE(numout,*) 
410            IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
411            IF(lwp) WRITE(numout,*)'           an Euler initial time step is used '   
412            l_1st_euler = .TRUE.
413         ENDIF
414      ENDIF
415      !                             ! control of output frequency
416      IF( nstock == 0 .OR. nstock > nitend ) THEN
417         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
418         CALL ctl_warn( ctmp1 )
419         nstock = nitend
420      ENDIF
421      IF( nwrite == 0 ) THEN
422         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
423         CALL ctl_warn( ctmp1 )
424         nwrite = nitend
425      ENDIF
426
427#if defined key_agrif
428      IF( Agrif_Root() ) THEN
429#endif
430      IF(lwp) WRITE(numout,*)
431      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
432      CASE (  1 ) 
433         CALL ioconf_calendar('gregorian')
434         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
435      CASE (  0 )
436         CALL ioconf_calendar('noleap')
437         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
438      CASE ( 30 )
439         CALL ioconf_calendar('360d')
440         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
441      END SELECT
442#if defined key_agrif
443      ENDIF
444#endif
445      !
446      IF( TRIM(Agrif_CFixed()) == '0' ) THEN    !set output file type for XIOS based on NEMO namelist
447         lrxios = ln_xios_read.AND.ln_rstart
448         IF (nn_wxios > 0) lwxios = .TRUE. 
449         nxioso = nn_wxios
450      ENDIF
451
452#if defined key_netcdf4
453      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
454      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
455      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
456907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
457      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
458      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
459908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
460      IF(lwm) WRITE( numond, namnc4 )
461
462      IF(lwp) THEN                        ! control print
463         WRITE(numout,*)
464         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
465         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i
466         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j
467         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k
468         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip
469      ENDIF
470
471      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
472      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
473      snc4set%ni   = nn_nchunks_i
474      snc4set%nj   = nn_nchunks_j
475      snc4set%nk   = nn_nchunks_k
476      snc4set%luse = ln_nc4zip
477#else
478      snc4set%luse = .FALSE.        ! No NetCDF 4 case
479#endif
480      !
481   END SUBROUTINE dom_nam
482
483
484   SUBROUTINE dom_ctl
485      !!----------------------------------------------------------------------
486      !!                     ***  ROUTINE dom_ctl  ***
487      !!
488      !! ** Purpose :   Domain control.
489      !!
490      !! ** Method  :   compute and print extrema of masked scale factors
491      !!----------------------------------------------------------------------
492      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
493      INTEGER, DIMENSION(2) ::   iloc   !
494      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
495      !!----------------------------------------------------------------------
496      !
497      IF(lk_mpp) THEN
498         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
499         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
500         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
501         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
502      ELSE
503         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
504         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
505         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
506         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
507         !
508         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
509         iimi1 = iloc(1) + nimpp - 1
510         ijmi1 = iloc(2) + njmpp - 1
511         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
512         iimi2 = iloc(1) + nimpp - 1
513         ijmi2 = iloc(2) + njmpp - 1
514         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
515         iima1 = iloc(1) + nimpp - 1
516         ijma1 = iloc(2) + njmpp - 1
517         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
518         iima2 = iloc(1) + nimpp - 1
519         ijma2 = iloc(2) + njmpp - 1
520      ENDIF
521      IF(lwp) THEN
522         WRITE(numout,*)
523         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
524         WRITE(numout,*) '~~~~~~~'
525         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
526         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
527         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
528         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
529      ENDIF
530      !
531   END SUBROUTINE dom_ctl
532
533
534   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
535      !!----------------------------------------------------------------------
536      !!                     ***  ROUTINE dom_nam  ***
537      !!                   
538      !! ** Purpose :   read the domain size in domain configuration file
539      !!
540      !! ** Method  :   read the cn_domcfg NetCDF file
541      !!----------------------------------------------------------------------
542      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
543      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
544      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
545      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
546      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
547      !
548      INTEGER ::   inum, ii   ! local integer
549      REAL(wp) ::   zorca_res                     ! local scalars
550      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
551      !!----------------------------------------------------------------------
552      !
553      ii = 1
554      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
555      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'  ;   ii = ii+1
556      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
557      !
558      CALL iom_open( cn_domcfg, inum )
559      !
560      !                                   !- ORCA family specificity
561      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
562         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
563         !
564         cd_cfg = 'ORCA'
565         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res )
566         !
567         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
568         WRITE(ldtxt(ii),*) '   ==>>>   ORCA configuration '                           ;   ii = ii+1
569         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
570         !
571      ELSE                                !- cd_cfg & k_cfg are not used
572         cd_cfg = 'UNKNOWN'
573         kk_cfg = -9999999
574                                          !- or they may be present as global attributes
575                                          !- (netcdf only) 
576         IF( iom_file(inum)%iolib == jpnf90 ) THEN
577            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
578            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
579            IF( TRIM(cd_cfg) == '!')   cd_cfg = 'UNKNOWN'
580            IF( kk_cfg == -999     )   kk_cfg = -9999999
581         ENDIF
582         !
583      ENDIF
584      !
585      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo )
586      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo )
587      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo )
588      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio )
589      CALL iom_close( inum )
590      !
591      WRITE(ldtxt(ii),*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
592      WRITE(ldtxt(ii),*) '      jpiglo = ', kpi                                              ;   ii = ii+1
593      WRITE(ldtxt(ii),*) '      jpjglo = ', kpj                                              ;   ii = ii+1
594      WRITE(ldtxt(ii),*) '      jpkglo = ', kpk                                              ;   ii = ii+1
595      WRITE(ldtxt(ii),*) '      type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
596      !       
597   END SUBROUTINE domain_cfg
598   
599   
600   SUBROUTINE cfg_write
601      !!----------------------------------------------------------------------
602      !!                  ***  ROUTINE cfg_write  ***
603      !!                   
604      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
605      !!              contains all the ocean domain informations required to
606      !!              define an ocean configuration.
607      !!
608      !! ** Method  :   Write in a file all the arrays required to set up an
609      !!              ocean configuration.
610      !!
611      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
612      !!                       mesh, Coriolis parameter, and vertical scale factors
613      !!                    NB: also contain ORCA family information
614      !!----------------------------------------------------------------------
615      INTEGER           ::   ji, jj, jk   ! dummy loop indices
616      INTEGER           ::   izco, izps, isco, icav
617      INTEGER           ::   inum     ! local units
618      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
619      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
620      !!----------------------------------------------------------------------
621      !
622      IF(lwp) WRITE(numout,*)
623      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
624      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
625      !
626      !                       ! ============================= !
627      !                       !  create 'domcfg_out.nc' file  !
628      !                       ! ============================= !
629      !         
630      clnam = cn_domcfg_out  ! filename (configuration information)
631      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
632     
633      !
634      !                             !==  ORCA family specificities  ==!
635      IF( cn_cfg == "ORCA" ) THEN
636         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
637         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
638      ENDIF
639      !
640      !                             !==  global domain size  ==!
641      !
642      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
643      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
644      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
645      !
646      !                             !==  domain characteristics  ==!
647      !
648      !                                   ! lateral boundary of the global domain
649      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
650      !
651      !                                   ! type of vertical coordinate
652      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
653      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
654      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
655      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
656      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
657      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
658      !
659      !                                   ! ocean cavities under iceshelves
660      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
661      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
662      !
663      !                             !==  horizontal mesh  !
664      !
665      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
666      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
667      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
668      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
669      !                               
670      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
671      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
672      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
673      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
674      !                               
675      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
676      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
677      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
678      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
679      !
680      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
681      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
682      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
683      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
684      !
685      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
686      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
687      !
688      !                             !==  vertical mesh  ==!
689      !                                                     
690      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
691      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
692      !
693      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
694      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
695      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
696      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
697      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
698      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
699      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
700      !                                         
701      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
702      !
703      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
704      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
705      !
706      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
707         CALL dom_stiff( z2d )
708         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
709      ENDIF
710      !
711      IF( ll_wd ) THEN              ! wetting and drying domain
712         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
713      ENDIF
714      !
715      ! Add some global attributes ( netcdf only )
716      IF( iom_file(inum)%iolib == jpnf90 ) THEN
717         CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
718         CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
719      ENDIF
720      !
721      !                                ! ============================
722      !                                !        close the files
723      !                                ! ============================
724      CALL iom_close( inum )
725      !
726   END SUBROUTINE cfg_write
727   
728   !!======================================================================
729END MODULE domain
Note: See TracBrowser for help on using the repository browser.