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

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

ENHANCE-02_ISF: fix issue with ice sheet coupling and conservation + other minor changes (ticket #2142)
  • Property svn:keywords set to Id
File size: 36.4 KB
Line 
1MODULE domain
2   !!==============================================================================
3   !!                       ***  MODULE domain   ***
4   !! Ocean initialization : domain initialization
5   !!==============================================================================
6   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
7   !!                 !  1992-01  (M. Imbard) insert time step initialization
8   !!                 !  1996-06  (G. Madec) generalized vertical coordinate
9   !!                 !  1997-02  (G. Madec) creation of domwri.F
10   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
11   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
12   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
13   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
14   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
15   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
16   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
17   !!----------------------------------------------------------------------
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    )   CALL dom_wri       ! Create a domain file
188      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
189      !
190      IF( ln_write_cfg   )   CALL cfg_write     ! create the configuration file
191      !
192      IF(lwp) THEN
193         WRITE(numout,*)
194         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization'
195         WRITE(numout,*) '~~~~~~~~'
196         WRITE(numout,*) 
197      ENDIF
198      !
199   END SUBROUTINE dom_init
200
201
202   SUBROUTINE dom_glo
203      !!----------------------------------------------------------------------
204      !!                     ***  ROUTINE dom_glo  ***
205      !!
206      !! ** Purpose :   initialization of global domain <--> local domain indices
207      !!
208      !! ** Method  :   
209      !!
210      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
211      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
212      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
213      !!----------------------------------------------------------------------
214      INTEGER ::   ji, jj   ! dummy loop argument
215      !!----------------------------------------------------------------------
216      !
217      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
218        mig(ji) = ji + nimpp - 1
219      END DO
220      DO jj = 1, jpj
221        mjg(jj) = jj + njmpp - 1
222      END DO
223      !                              ! global domain indices ==> local domain indices
224      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
225      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
226      DO ji = 1, jpiglo
227        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
228        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
229      END DO
230      DO jj = 1, jpjglo
231        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
232        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
233      END DO
234      IF(lwp) THEN                   ! control print
235         WRITE(numout,*)
236         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
237         WRITE(numout,*) '~~~~~~~ '
238         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
239         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
240         WRITE(numout,*)
241         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
242         IF( nn_print >= 1 ) THEN
243            WRITE(numout,*)
244            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
245            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
246            WRITE(numout,*)
247            WRITE(numout,*) '          conversion global ==> local  i-index domain'
248            WRITE(numout,*) '             starting index (mi0)'
249            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
250            WRITE(numout,*) '             ending index (mi1)'
251            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
252            WRITE(numout,*)
253            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
254            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
255            WRITE(numout,*)
256            WRITE(numout,*) '          conversion global ==> local  j-index domain'
257            WRITE(numout,*) '             starting index (mj0)'
258            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
259            WRITE(numout,*) '             ending index (mj1)'
260            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
261         ENDIF
262      ENDIF
263 25   FORMAT( 100(10x,19i4,/) )
264      !
265   END SUBROUTINE dom_glo
266
267
268   SUBROUTINE dom_nam
269      !!----------------------------------------------------------------------
270      !!                     ***  ROUTINE dom_nam  ***
271      !!                   
272      !! ** Purpose :   read domaine namelists and print the variables.
273      !!
274      !! ** input   : - namrun namelist
275      !!              - namdom namelist
276      !!              - namnc4 namelist   ! "key_netcdf4" only
277      !!----------------------------------------------------------------------
278      USE ioipsl
279      !!
280      INTEGER  ::   ios   ! Local integer
281      !
282      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
283         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
284         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
285         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
286         &             ln_cfmeta, ln_xios_read, nn_wxios
287      NAMELIST/namdom/ ln_linssh, rn_rdt, rn_atfp, ln_crs, ln_meshmask
288#if defined key_netcdf4
289      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
290#endif
291      !!----------------------------------------------------------------------
292      !
293      IF(lwp) THEN
294         WRITE(numout,*)
295         WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
296         WRITE(numout,*) '~~~~~~~ '
297      ENDIF
298      !
299      !
300      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
301      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
302901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
303      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
304      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
305902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
306      IF(lwm) WRITE ( numond, namrun )
307      !
308      IF(lwp) THEN                  ! control print
309         WRITE(numout,*) '   Namelist : namrun   ---   run parameters'
310         WRITE(numout,*) '      Assimilation cycle              nn_no           = ', nn_no
311         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           )
312         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     )
313         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  )
314         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    )
315         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
316         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
317         WRITE(numout,*) '      start with forward time step    nn_euler        = ', nn_euler
318         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
319         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
320         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend
321         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0
322         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0
323         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy
324         WRITE(numout,*) '      initial state output            nn_istate       = ', nn_istate
325         IF( ln_rst_list ) THEN
326            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist
327         ELSE
328            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock
329         ENDIF
330         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write
331         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland
332         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta
333         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
334         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
335         IF( TRIM(Agrif_CFixed()) == '0' ) THEN
336            WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
337            WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
338         ELSE
339            WRITE(numout,*) "      AGRIF: nn_wxios will be ingored. See setting for parent"
340            WRITE(numout,*) "      AGRIF: ln_xios_read will be ingored. See setting for parent"
341         ENDIF
342      ENDIF
343
344      cexper = cn_exp         ! conversion DOCTOR names into model names (this should disappear soon)
345      nrstdt = nn_rstctl
346      nit000 = nn_it000
347      nitend = nn_itend
348      ndate0 = nn_date0
349      nleapy = nn_leapy
350      ninist = nn_istate
351      nstock = nn_stock
352      nstocklist = nn_stocklist
353      nwrite = nn_write
354      neuler = nn_euler
355      IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN
356         IF(lwp) WRITE(numout,*) 
357         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
358         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : nn_euler is forced to 0 '   
359         neuler = 0
360      ENDIF
361      !                             ! control of output frequency
362      IF( nstock == 0 .OR. nstock > nitend ) THEN
363         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
364         CALL ctl_warn( ctmp1 )
365         nstock = nitend
366      ENDIF
367      IF ( nwrite == 0 ) THEN
368         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
369         CALL ctl_warn( ctmp1 )
370         nwrite = nitend
371      ENDIF
372
373#if defined key_agrif
374      IF( Agrif_Root() ) THEN
375#endif
376      IF(lwp) WRITE(numout,*)
377      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
378      CASE (  1 ) 
379         CALL ioconf_calendar('gregorian')
380         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
381      CASE (  0 )
382         CALL ioconf_calendar('noleap')
383         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
384      CASE ( 30 )
385         CALL ioconf_calendar('360d')
386         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
387      END SELECT
388#if defined key_agrif
389      ENDIF
390#endif
391
392      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
393      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
394903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
395      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
396      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
397904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
398      IF(lwm) WRITE( numond, namdom )
399      !
400      IF(lwp) THEN
401         WRITE(numout,*)
402         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
403         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
404         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
405         WRITE(numout,*) '      ocean time step                         rn_rdt      = ', rn_rdt
406         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp
407         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
408      ENDIF
409      !
410      !          ! conversion DOCTOR names into model names (this should disappear soon)
411      atfp = rn_atfp
412      rdt  = rn_rdt
413
414      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
415         lrxios = ln_xios_read.AND.ln_rstart
416!set output file type for XIOS based on NEMO namelist
417         IF (nn_wxios > 0) lwxios = .TRUE. 
418         nxioso = nn_wxios
419      ENDIF
420
421#if defined key_netcdf4
422      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
423      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
424      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
425907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
426      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
427      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
428908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
429      IF(lwm) WRITE( numond, namnc4 )
430
431      IF(lwp) THEN                        ! control print
432         WRITE(numout,*)
433         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
434         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i
435         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j
436         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k
437         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip
438      ENDIF
439
440      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
441      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
442      snc4set%ni   = nn_nchunks_i
443      snc4set%nj   = nn_nchunks_j
444      snc4set%nk   = nn_nchunks_k
445      snc4set%luse = ln_nc4zip
446#else
447      snc4set%luse = .FALSE.        ! No NetCDF 4 case
448#endif
449      !
450   END SUBROUTINE dom_nam
451
452
453   SUBROUTINE dom_ctl
454      !!----------------------------------------------------------------------
455      !!                     ***  ROUTINE dom_ctl  ***
456      !!
457      !! ** Purpose :   Domain control.
458      !!
459      !! ** Method  :   compute and print extrema of masked scale factors
460      !!----------------------------------------------------------------------
461      INTEGER, DIMENSION(2) ::   imi1, imi2, ima1, ima2
462      INTEGER, DIMENSION(2) ::   iloc   !
463      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
464      !!----------------------------------------------------------------------
465      !
466      IF(lk_mpp) THEN
467         CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 )
468         CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 )
469         CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 )
470         CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 )
471      ELSE
472         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
473         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
474         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
475         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
476         !
477         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
478         imi1(1) = iloc(1) + nimpp - 1
479         imi1(2) = iloc(2) + njmpp - 1
480         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
481         imi2(1) = iloc(1) + nimpp - 1
482         imi2(2) = iloc(2) + njmpp - 1
483         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
484         ima1(1) = iloc(1) + nimpp - 1
485         ima1(2) = iloc(2) + njmpp - 1
486         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
487         ima2(1) = iloc(1) + nimpp - 1
488         ima2(2) = iloc(2) + njmpp - 1
489      ENDIF
490      IF(lwp) THEN
491         WRITE(numout,*)
492         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
493         WRITE(numout,*) '~~~~~~~'
494         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
495         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
496         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
497         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
498      ENDIF
499      !
500   END SUBROUTINE dom_ctl
501
502
503   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
504      !!----------------------------------------------------------------------
505      !!                     ***  ROUTINE dom_nam  ***
506      !!                   
507      !! ** Purpose :   read the domain size in domain configuration file
508      !!
509      !! ** Method  :   read the cn_domcfg NetCDF file
510      !!----------------------------------------------------------------------
511      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
512      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
513      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
514      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
515      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
516      !
517      INTEGER ::   inum, ii   ! local integer
518      REAL(wp) ::   zorca_res                     ! local scalars
519      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
520      !!----------------------------------------------------------------------
521      !
522      ii = 1
523      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
524      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'  ;   ii = ii+1
525      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
526      !
527      CALL iom_open( cn_domcfg, inum )
528      !
529      !                                   !- ORCA family specificity
530      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
531         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
532         !
533         cd_cfg = 'ORCA'
534         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res )
535         !
536         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
537         WRITE(ldtxt(ii),*) '   ==>>>   ORCA configuration '                           ;   ii = ii+1
538         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
539         !
540      ELSE                                !- cd_cfg & k_cfg are not used
541         cd_cfg = 'UNKNOWN'
542         kk_cfg = -9999999
543                                          !- or they may be present as global attributes
544                                          !- (netcdf only) 
545         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
546         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
547         IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
548         IF( kk_cfg == -999     ) kk_cfg = -9999999
549         !
550      ENDIF
551      !
552      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = NINT( ziglo )
553      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = NINT( zjglo )
554      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = NINT( zkglo )
555      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio )
556      CALL iom_close( inum )
557      !
558      WRITE(ldtxt(ii),*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
559      WRITE(ldtxt(ii),*) '      jpiglo = ', kpi                                              ;   ii = ii+1
560      WRITE(ldtxt(ii),*) '      jpjglo = ', kpj                                              ;   ii = ii+1
561      WRITE(ldtxt(ii),*) '      jpkglo = ', kpk                                              ;   ii = ii+1
562      WRITE(ldtxt(ii),*) '      type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
563      !       
564   END SUBROUTINE domain_cfg
565   
566   
567   SUBROUTINE cfg_write
568      !!----------------------------------------------------------------------
569      !!                  ***  ROUTINE cfg_write  ***
570      !!                   
571      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
572      !!              contains all the ocean domain informations required to
573      !!              define an ocean configuration.
574      !!
575      !! ** Method  :   Write in a file all the arrays required to set up an
576      !!              ocean configuration.
577      !!
578      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
579      !!                       mesh, Coriolis parameter, and vertical scale factors
580      !!                    NB: also contain ORCA family information
581      !!----------------------------------------------------------------------
582      INTEGER           ::   ji, jj, jk   ! dummy loop indices
583      INTEGER           ::   izco, izps, isco, icav
584      INTEGER           ::   inum     ! local units
585      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
586      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
587      !!----------------------------------------------------------------------
588      !
589      IF(lwp) WRITE(numout,*)
590      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
591      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
592      !
593      !                       ! ============================= !
594      !                       !  create 'domcfg_out.nc' file  !
595      !                       ! ============================= !
596      !         
597      clnam = cn_domcfg_out  ! filename (configuration information)
598      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
599     
600      !
601      !                             !==  ORCA family specificities  ==!
602      IF( cn_cfg == "ORCA" ) THEN
603         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
604         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
605      ENDIF
606      !
607      !                             !==  global domain size  ==!
608      !
609      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
610      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
611      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
612      !
613      !                             !==  domain characteristics  ==!
614      !
615      !                                   ! lateral boundary of the global domain
616      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
617      !
618      !                                   ! type of vertical coordinate
619      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
620      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
621      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
622      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
623      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
624      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
625      !
626      !                                   ! ocean cavities under iceshelves
627      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
628      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
629      !
630      !                             !==  horizontal mesh  !
631      !
632      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
633      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
634      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
635      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
636      !                               
637      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
638      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
639      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
640      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
641      !                               
642      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
643      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
644      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
645      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
646      !
647      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
648      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
649      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
650      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
651      !
652      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
653      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
654      !
655      !                             !==  vertical mesh  ==!
656      !                                                     
657      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
658      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
659      !
660      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
661      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
662      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
663      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
664      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
665      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
666      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
667      !                                         
668      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
669      !
670      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
671      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
672      !
673      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
674         CALL dom_stiff( z2d )
675         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
676      ENDIF
677      !
678      IF( ll_wd ) THEN              ! wetting and drying domain
679         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
680      ENDIF
681      !
682      ! Add some global attributes ( netcdf only )
683      CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
684      CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
685      !
686      !                                ! ============================
687      !                                !        close the files
688      !                                ! ============================
689      CALL iom_close( inum )
690      !
691   END SUBROUTINE cfg_write
692
693   !!======================================================================
694END MODULE domain
Note: See TracBrowser for help on using the repository browser.