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/2019/ENHANCE-02_ISF_nemo/src/OCE/DOM – NEMO

source: NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/DOM/domain.F90 @ 11553

Last change on this file since 11553 was 11553, checked in by mathiot, 5 years ago

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