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

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

ENHANCE-02_ISF_nemo : Initial commit isf simplification (add ISF directory, moved isf routine in and split isf cavity and isf parametrisation, ...) (ticket #2142)
  • Property svn:keywords set to Id
File size: 36.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   !!----------------------------------------------------------------------
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 dom_oce        ! domain: ocean
29   USE sbc_oce        ! surface boundary condition: ocean
30   USE trc_oce        ! shared ocean & passive tracers variab
31   USE phycst         ! physical constants
32   USE closea         ! closed seas
33   USE domhgr         ! domain: set the horizontal mesh
34   USE domzgr         ! domain: set the vertical mesh
35   USE dommsk         ! domain: set the mask system
36   USE domwri         ! domain: write the meshmask file
37   USE domvvl         ! variable volume
38   USE c1d            ! 1D configuration
39   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
40   USE wet_dry,  ONLY : ll_wd
41   !
42   USE in_out_manager ! I/O manager
43   USE iom            ! I/O library
44   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
45   USE lib_mpp        ! distributed memory computing library
46
47   IMPLICIT NONE
48   PRIVATE
49
50   PUBLIC   dom_init     ! called by nemogcm.F90
51   PUBLIC   domain_cfg   ! called by nemogcm.F90
52
53   !!-------------------------------------------------------------------------
54   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
55   !! $Id$
56   !! Software governed by the CeCILL license (see ./LICENSE)
57   !!-------------------------------------------------------------------------
58CONTAINS
59
60   SUBROUTINE dom_init(cdstr)
61      !!----------------------------------------------------------------------
62      !!                  ***  ROUTINE dom_init  ***
63      !!                   
64      !! ** Purpose :   Domain initialization. Call the routines that are
65      !!              required to create the arrays which define the space
66      !!              and time domain of the ocean model.
67      !!
68      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
69      !!              - dom_hgr: compute or read the horizontal grid-point position
70      !!                         and scale factors, and the coriolis factor
71      !!              - dom_zgr: define the vertical coordinate and the bathymetry
72      !!              - dom_wri: create the meshmask file (ln_meshmask=T)
73      !!              - 1D configuration, move Coriolis, u and v at T-point
74      !!----------------------------------------------------------------------
75      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
76      INTEGER ::   iconf = 0    ! local integers
77      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
78      CHARACTER (len=*), INTENT(IN) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables
79      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
80      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
81      !!----------------------------------------------------------------------
82      !
83      IF(lwp) THEN         ! Ocean domain Parameters (control print)
84         WRITE(numout,*)
85         WRITE(numout,*) 'dom_init : domain initialization'
86         WRITE(numout,*) '~~~~~~~~'
87         !
88         WRITE(numout,*)     '   Domain info'
89         WRITE(numout,*)     '      dimension of model:'
90         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
91         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
92         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
93         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
94         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
95         WRITE(numout,*)     '      mpp local domain info (mpp):'
96         WRITE(numout,*)     '              jpni    : ', jpni, '   nn_hls  : ', nn_hls
97         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
98         WRITE(numout,*)     '              jpnij   : ', jpnij
99         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
100         SELECT CASE ( jperio )
101         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
102         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
103         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. equatorial symmetric)'
104         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
105         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
106         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
107         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
108         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
109         CASE DEFAULT
110            CALL ctl_stop( 'jperio is out of range' )
111         END SELECT
112         WRITE(numout,*)     '      Ocean model configuration used:'
113         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
114      ENDIF
115      lwxios = .FALSE.
116      ln_xios_read = .FALSE.
117      !
118      !           !==  Reference coordinate system  ==!
119      !
120      CALL dom_glo                     ! global domain versus local domain
121      CALL dom_nam                     ! read namelist ( namrun, namdom )
122      !
123      IF( lwxios ) THEN
124!define names for restart write and set core output (restart.F90)
125         CALL iom_set_rst_vars(rst_wfields)
126         CALL iom_set_rstw_core(cdstr)
127      ENDIF
128!reset namelist for SAS
129      IF(cdstr == 'SAS') THEN
130         IF(lrxios) THEN
131               IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'
132               lrxios = .FALSE.
133         ENDIF
134      ENDIF
135      !
136      CALL dom_hgr                     ! Horizontal mesh
137      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
138      CALL dom_msk( ik_top, ik_bot )   ! Masks
139      IF( ln_closea )   CALL dom_clo   ! ln_closea=T : closed seas included in the simulation
140                                       ! Read in masks to define closed seas and lakes
141      !
142      ht_0(:,:) = 0._wp  ! Reference ocean thickness
143      hu_0(:,:) = 0._wp
144      hv_0(:,:) = 0._wp
145      DO jk = 1, jpk
146         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
147         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
148         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
149      END DO
150      !
151      !           !==  time varying part of coordinate system  ==!
152      !
153      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
154      !
155         !       before        !          now          !       after         !
156            gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
157            gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
158                                   gde3w_n = gde3w_0   !        ---          !
159         !                                                                 
160              e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
161              e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
162              e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
163                                     e3f_n =   e3f_0   !        ---          !
164              e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
165             e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
166             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
167         !
168         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
169         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
170         !
171         !        before       !          now          !       after         !
172                                      ht_n =    ht_0   !                     ! water column thickness
173               hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !
174               hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
175            r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
176            r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
177         !
178         !
179      ELSE                       != time varying : initialize before/now/after variables
180         !
181         IF( .NOT.l_offline )  CALL dom_vvl_init 
182         !
183      ENDIF
184      !
185      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
186      !
187      IF( ln_meshmask .AND. .NOT.ln_iscpl )                        CALL dom_wri     ! Create a domain file
188      IF( ln_meshmask .AND.      ln_iscpl .AND. .NOT.ln_rstart )   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_iscpl, 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         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl        = ', ln_iscpl
337         IF( TRIM(Agrif_CFixed()) == '0' ) THEN
338            WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
339            WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
340         ELSE
341            WRITE(numout,*) "      AGRIF: nn_wxios will be ingored. See setting for parent"
342            WRITE(numout,*) "      AGRIF: ln_xios_read will be ingored. See setting for parent"
343         ENDIF
344      ENDIF
345
346      cexper = cn_exp         ! conversion DOCTOR names into model names (this should disappear soon)
347      nrstdt = nn_rstctl
348      nit000 = nn_it000
349      nitend = nn_itend
350      ndate0 = nn_date0
351      nleapy = nn_leapy
352      ninist = nn_istate
353      nstock = nn_stock
354      nstocklist = nn_stocklist
355      nwrite = nn_write
356      neuler = nn_euler
357      IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN
358         IF(lwp) WRITE(numout,*) 
359         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
360         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : nn_euler is forced to 0 '   
361         neuler = 0
362      ENDIF
363      !                             ! control of output frequency
364      IF( nstock == 0 .OR. nstock > nitend ) THEN
365         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
366         CALL ctl_warn( ctmp1 )
367         nstock = nitend
368      ENDIF
369      IF ( nwrite == 0 ) THEN
370         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
371         CALL ctl_warn( ctmp1 )
372         nwrite = nitend
373      ENDIF
374
375#if defined key_agrif
376      IF( Agrif_Root() ) THEN
377#endif
378      IF(lwp) WRITE(numout,*)
379      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
380      CASE (  1 ) 
381         CALL ioconf_calendar('gregorian')
382         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
383      CASE (  0 )
384         CALL ioconf_calendar('noleap')
385         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
386      CASE ( 30 )
387         CALL ioconf_calendar('360d')
388         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
389      END SELECT
390#if defined key_agrif
391      ENDIF
392#endif
393
394      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
395      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
396903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
397      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
398      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
399904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
400      IF(lwm) WRITE( numond, namdom )
401      !
402      IF(lwp) THEN
403         WRITE(numout,*)
404         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
405         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
406         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
407         WRITE(numout,*) '      ocean time step                         rn_rdt      = ', rn_rdt
408         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp
409         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
410      ENDIF
411      !
412      !          ! conversion DOCTOR names into model names (this should disappear soon)
413      atfp = rn_atfp
414      rdt  = rn_rdt
415
416      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
417         lrxios = ln_xios_read.AND.ln_rstart
418!set output file type for XIOS based on NEMO namelist
419         IF (nn_wxios > 0) lwxios = .TRUE. 
420         nxioso = nn_wxios
421      ENDIF
422
423#if defined key_netcdf4
424      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
425      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
426      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
427907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
428      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
429      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
430908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
431      IF(lwm) WRITE( numond, namnc4 )
432
433      IF(lwp) THEN                        ! control print
434         WRITE(numout,*)
435         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
436         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i
437         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j
438         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k
439         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip
440      ENDIF
441
442      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
443      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
444      snc4set%ni   = nn_nchunks_i
445      snc4set%nj   = nn_nchunks_j
446      snc4set%nk   = nn_nchunks_k
447      snc4set%luse = ln_nc4zip
448#else
449      snc4set%luse = .FALSE.        ! No NetCDF 4 case
450#endif
451      !
452   END SUBROUTINE dom_nam
453
454
455   SUBROUTINE dom_ctl
456      !!----------------------------------------------------------------------
457      !!                     ***  ROUTINE dom_ctl  ***
458      !!
459      !! ** Purpose :   Domain control.
460      !!
461      !! ** Method  :   compute and print extrema of masked scale factors
462      !!----------------------------------------------------------------------
463      INTEGER, DIMENSION(2) ::   imi1, imi2, ima1, ima2
464      INTEGER, DIMENSION(2) ::   iloc   !
465      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
466      !!----------------------------------------------------------------------
467      !
468      IF(lk_mpp) THEN
469         CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 )
470         CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 )
471         CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 )
472         CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 )
473      ELSE
474         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
475         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
476         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
477         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
478         !
479         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
480         imi1(1) = iloc(1) + nimpp - 1
481         imi1(2) = iloc(2) + njmpp - 1
482         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
483         imi2(1) = iloc(1) + nimpp - 1
484         imi2(2) = iloc(2) + njmpp - 1
485         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
486         ima1(1) = iloc(1) + nimpp - 1
487         ima1(2) = iloc(2) + njmpp - 1
488         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
489         ima2(1) = iloc(1) + nimpp - 1
490         ima2(2) = iloc(2) + njmpp - 1
491      ENDIF
492      IF(lwp) THEN
493         WRITE(numout,*)
494         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
495         WRITE(numout,*) '~~~~~~~'
496         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
497         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
498         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
499         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
500      ENDIF
501      !
502   END SUBROUTINE dom_ctl
503
504
505   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
506      !!----------------------------------------------------------------------
507      !!                     ***  ROUTINE dom_nam  ***
508      !!                   
509      !! ** Purpose :   read the domain size in domain configuration file
510      !!
511      !! ** Method  :   read the cn_domcfg NetCDF file
512      !!----------------------------------------------------------------------
513      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
514      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
515      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
516      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
517      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
518      !
519      INTEGER ::   inum, ii   ! local integer
520      REAL(wp) ::   zorca_res                     ! local scalars
521      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
522      !!----------------------------------------------------------------------
523      !
524      ii = 1
525      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
526      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'  ;   ii = ii+1
527      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
528      !
529      CALL iom_open( cn_domcfg, inum )
530      !
531      !                                   !- ORCA family specificity
532      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
533         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
534         !
535         cd_cfg = 'ORCA'
536         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res )
537         !
538         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
539         WRITE(ldtxt(ii),*) '   ==>>>   ORCA configuration '                           ;   ii = ii+1
540         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
541         !
542      ELSE                                !- cd_cfg & k_cfg are not used
543         cd_cfg = 'UNKNOWN'
544         kk_cfg = -9999999
545                                          !- or they may be present as global attributes
546                                          !- (netcdf only) 
547         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
548         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
549         IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
550         IF( kk_cfg == -999     ) kk_cfg = -9999999
551         !
552      ENDIF
553      !
554      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = NINT( ziglo )
555      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = NINT( zjglo )
556      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = NINT( zkglo )
557      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio )
558      CALL iom_close( inum )
559      !
560      WRITE(ldtxt(ii),*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
561      WRITE(ldtxt(ii),*) '      jpiglo = ', kpi                                              ;   ii = ii+1
562      WRITE(ldtxt(ii),*) '      jpjglo = ', kpj                                              ;   ii = ii+1
563      WRITE(ldtxt(ii),*) '      jpkglo = ', kpk                                              ;   ii = ii+1
564      WRITE(ldtxt(ii),*) '      type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
565      !       
566   END SUBROUTINE domain_cfg
567   
568   
569   SUBROUTINE cfg_write
570      !!----------------------------------------------------------------------
571      !!                  ***  ROUTINE cfg_write  ***
572      !!                   
573      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
574      !!              contains all the ocean domain informations required to
575      !!              define an ocean configuration.
576      !!
577      !! ** Method  :   Write in a file all the arrays required to set up an
578      !!              ocean configuration.
579      !!
580      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
581      !!                       mesh, Coriolis parameter, and vertical scale factors
582      !!                    NB: also contain ORCA family information
583      !!----------------------------------------------------------------------
584      INTEGER           ::   ji, jj, jk   ! dummy loop indices
585      INTEGER           ::   izco, izps, isco, icav
586      INTEGER           ::   inum     ! local units
587      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
588      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
589      !!----------------------------------------------------------------------
590      !
591      IF(lwp) WRITE(numout,*)
592      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
593      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
594      !
595      !                       ! ============================= !
596      !                       !  create 'domcfg_out.nc' file  !
597      !                       ! ============================= !
598      !         
599      clnam = cn_domcfg_out  ! filename (configuration information)
600      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
601     
602      !
603      !                             !==  ORCA family specificities  ==!
604      IF( cn_cfg == "ORCA" ) THEN
605         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
606         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
607      ENDIF
608      !
609      !                             !==  global domain size  ==!
610      !
611      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
612      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
613      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
614      !
615      !                             !==  domain characteristics  ==!
616      !
617      !                                   ! lateral boundary of the global domain
618      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
619      !
620      !                                   ! type of vertical coordinate
621      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
622      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
623      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
624      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
625      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
626      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
627      !
628      !                                   ! ocean cavities under iceshelves
629      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
630      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
631      !
632      !                             !==  horizontal mesh  !
633      !
634      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
635      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
636      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
637      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
638      !                               
639      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
640      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
641      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
642      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
643      !                               
644      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
645      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
646      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
647      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
648      !
649      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
650      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
651      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
652      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
653      !
654      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
655      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
656      !
657      !                             !==  vertical mesh  ==!
658      !                                                     
659      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
660      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
661      !
662      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
663      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
664      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
665      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
666      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
667      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
668      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
669      !                                         
670      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
671      !
672      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
673      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
674      !
675      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
676         CALL dom_stiff( z2d )
677         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
678      ENDIF
679      !
680      IF( ll_wd ) THEN              ! wetting and drying domain
681         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
682      ENDIF
683      !
684      ! Add some global attributes ( netcdf only )
685      CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
686      CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
687      !
688      !                                ! ============================
689      !                                !        close the files
690      !                                ! ============================
691      CALL iom_close( inum )
692      !
693   END SUBROUTINE cfg_write
694
695   !!======================================================================
696END MODULE domain
Note: See TracBrowser for help on using the repository browser.