New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
domain.F90 in NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM – NEMO

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domain.F90 @ 12866

Last change on this file since 12866 was 12866, checked in by smasson, 4 years ago

Extra_Halo: using input files without halos, see #2366

  • Property svn:keywords set to Id
File size: 35.8 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 domhgr         ! domain: set the horizontal mesh
33   USE domzgr         ! domain: set the vertical mesh
34   USE dommsk         ! domain: set the mask system
35   USE domwri         ! domain: write the meshmask file
36   USE domvvl         ! variable volume
37   USE c1d            ! 1D configuration
38   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
39   USE wet_dry, ONLY : ll_wd
40   USE closea , ONLY : dom_clo ! closed seas
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( Kbb, Kmm, Kaa, 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          , INTENT(in) :: Kbb, Kmm, Kaa          ! ocean time level indices
76      CHARACTER (len=*), INTENT(in) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables
77      !
78      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
79      INTEGER ::   iconf = 0    ! local integers
80      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
81      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
82      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
83      !!----------------------------------------------------------------------
84      !
85      IF(lwp) THEN         ! Ocean domain Parameters (control print)
86         WRITE(numout,*)
87         WRITE(numout,*) 'dom_init : domain initialization'
88         WRITE(numout,*) '~~~~~~~~'
89         !
90         WRITE(numout,*)     '   Domain info'
91         WRITE(numout,*)     '      dimension of model:'
92         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
93         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
94         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
95         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
96         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
97         WRITE(numout,*)     '      mpp local domain info (mpp):'
98         WRITE(numout,*)     '              jpni    : ', jpni, '   nn_hls  : ', nn_hls
99         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
100         WRITE(numout,*)     '              jpnij   : ', jpnij
101         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
102         SELECT CASE ( jperio )
103         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
104         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
105         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. cyclic north-south)'
106         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
107         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
108         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
109         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
110         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
111         CASE DEFAULT
112            CALL ctl_stop( 'jperio is out of range' )
113         END SELECT
114         WRITE(numout,*)     '      Ocean model configuration used:'
115         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
116      ENDIF
117      lwxios = .FALSE.
118      ln_xios_read = .FALSE.
119      !
120      !           !==  Reference coordinate system  ==!
121      !
122      CALL dom_glo                     ! global domain versus local domain
123      CALL dom_nam                     ! read namelist ( namrun, namdom )
124      !
125      IF( lwxios ) THEN
126!define names for restart write and set core output (restart.F90)
127         CALL iom_set_rst_vars(rst_wfields)
128         CALL iom_set_rstw_core(cdstr)
129      ENDIF
130!reset namelist for SAS
131      IF(cdstr == 'SAS') THEN
132         IF(lrxios) THEN
133               IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'
134               lrxios = .FALSE.
135         ENDIF
136      ENDIF
137      !
138      CALL dom_hgr                      ! Horizontal mesh
139
140      IF( ln_closea ) CALL dom_clo      ! Read in masks to define closed seas and lakes
141
142      CALL dom_zgr( ik_top, ik_bot )    ! Vertical mesh and bathymetry
143
144      CALL dom_msk( ik_top, ik_bot )    ! Masks
145      !
146      ht_0(:,:) = 0._wp  ! Reference ocean thickness
147      hu_0(:,:) = 0._wp
148      hv_0(:,:) = 0._wp
149      DO jk = 1, jpk
150         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
151         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
152         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
153      END DO
154      !
155      !           !==  time varying part of coordinate system  ==!
156      !
157      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
158      !
159         !       before        !          now          !       after         !
160            gdept(:,:,:,Kbb) = gdept_0  ;   gdept(:,:,:,Kmm) = gdept_0   ;   gdept(:,:,:,Kaa) = gdept_0   ! depth of grid-points
161            gdepw(:,:,:,Kbb) = gdepw_0  ;   gdepw(:,:,:,Kmm) = gdepw_0   ;   gdepw(:,:,:,Kaa) = gdepw_0   !
162                                   gde3w = gde3w_0   !        ---          !
163         !                                                                 
164              e3t(:,:,:,Kbb) =   e3t_0  ;     e3t(:,:,:,Kmm) =   e3t_0   ;   e3t(:,:,:,Kaa) =  e3t_0    ! scale factors
165              e3u(:,:,:,Kbb) =   e3u_0  ;     e3u(:,:,:,Kmm) =   e3u_0   ;   e3u(:,:,:,Kaa) =  e3u_0    !
166              e3v(:,:,:,Kbb) =   e3v_0  ;     e3v(:,:,:,Kmm) =   e3v_0   ;   e3v(:,:,:,Kaa) =  e3v_0    !
167                                     e3f =   e3f_0   !        ---          !
168              e3w(:,:,:,Kbb) =   e3w_0  ;     e3w(:,:,:,Kmm) =   e3w_0   ;    e3w(:,:,:,Kaa) =   e3w_0   !
169             e3uw(:,:,:,Kbb) =  e3uw_0  ;    e3uw(:,:,:,Kmm) =  e3uw_0   ;   e3uw(:,:,:,Kaa) =  e3uw_0   
170             e3vw(:,:,:,Kbb) =  e3vw_0  ;    e3vw(:,:,:,Kmm) =  e3vw_0   ;   e3vw(:,:,:,Kaa) =  e3vw_0   !
171         !
172         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
173         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
174         !
175         !        before       !          now          !       after         !
176                                      ht =    ht_0   !                     ! water column thickness
177               hu(:,:,Kbb) =    hu_0  ;      hu(:,:,Kmm) =    hu_0   ;    hu(:,:,Kaa) =    hu_0   !
178               hv(:,:,Kbb) =    hv_0  ;      hv(:,:,Kmm) =    hv_0   ;    hv(:,:,Kaa) =    hv_0   !
179            r1_hu(:,:,Kbb) = z1_hu_0  ;   r1_hu(:,:,Kmm) = z1_hu_0   ; r1_hu(:,:,Kaa) = z1_hu_0   ! inverse of water column thickness
180            r1_hv(:,:,Kbb) = z1_hv_0  ;   r1_hv(:,:,Kmm) = z1_hv_0   ; r1_hv(:,:,Kaa) = z1_hv_0   !
181         !
182         !
183      ELSE                       != time varying : initialize before/now/after variables
184         !
185         IF( .NOT.l_offline )  CALL dom_vvl_init( Kbb, Kmm, Kaa )
186         !
187      ENDIF
188      !
189      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
190      !
191      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file
192      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
193      !
194      IF( ln_write_cfg   )   CALL cfg_write     ! create the configuration file
195      !
196      IF(lwp) THEN
197         WRITE(numout,*)
198         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization'
199         WRITE(numout,*) '~~~~~~~~'
200         WRITE(numout,*) 
201      ENDIF
202      !
203   END SUBROUTINE dom_init
204
205
206   SUBROUTINE dom_glo
207      !!----------------------------------------------------------------------
208      !!                     ***  ROUTINE dom_glo  ***
209      !!
210      !! ** Purpose :   initialization of global domain <--> local domain indices
211      !!
212      !! ** Method  :   
213      !!
214      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
215      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
216      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
217      !!----------------------------------------------------------------------
218      INTEGER ::   ji, jj   ! dummy loop argument
219      !!----------------------------------------------------------------------
220      !
221      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
222        mig(ji) = ji + nimpp - 1
223      END DO
224      DO jj = 1, jpj
225        mjg(jj) = jj + njmpp - 1
226      END DO
227      !                              ! global domain indices ==> local domain indices
228      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
229      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
230      DO ji = 1, jpiglo
231        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
232        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
233      END DO
234      DO jj = 1, jpjglo
235        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
236        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
237      END DO
238      IF(lwp) THEN                   ! control print
239         WRITE(numout,*)
240         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
241         WRITE(numout,*) '~~~~~~~ '
242         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
243         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
244         WRITE(numout,*)
245         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
246         IF( nn_print >= 1 ) THEN
247            WRITE(numout,*)
248            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
249            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
250            WRITE(numout,*)
251            WRITE(numout,*) '          conversion global ==> local  i-index domain'
252            WRITE(numout,*) '             starting index (mi0)'
253            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
254            WRITE(numout,*) '             ending index (mi1)'
255            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
256            WRITE(numout,*)
257            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
258            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
259            WRITE(numout,*)
260            WRITE(numout,*) '          conversion global ==> local  j-index domain'
261            WRITE(numout,*) '             starting index (mj0)'
262            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
263            WRITE(numout,*) '             ending index (mj1)'
264            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
265         ENDIF
266      ENDIF
267 25   FORMAT( 100(10x,19i4,/) )
268      !
269   END SUBROUTINE dom_glo
270
271
272   SUBROUTINE dom_nam
273      !!----------------------------------------------------------------------
274      !!                     ***  ROUTINE dom_nam  ***
275      !!                   
276      !! ** Purpose :   read domaine namelists and print the variables.
277      !!
278      !! ** input   : - namrun namelist
279      !!              - namdom namelist
280      !!              - namnc4 namelist   ! "key_netcdf4" only
281      !!----------------------------------------------------------------------
282      USE ioipsl
283      !!
284      INTEGER  ::   ios   ! Local integer
285      !
286      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
287         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
288         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
289         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, ln_1st_euler  , &
290         &             ln_cfmeta, ln_xios_read, nn_wxios
291      NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask
292#if defined key_netcdf4
293      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
294#endif
295      !!----------------------------------------------------------------------
296      !
297      IF(lwp) THEN
298         WRITE(numout,*)
299         WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
300         WRITE(numout,*) '~~~~~~~ '
301      ENDIF
302      !
303      !
304      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
305901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist' )
306      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
307902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' )
308      IF(lwm) WRITE ( numond, namrun )
309      !
310      IF(lwp) THEN                  ! control print
311         WRITE(numout,*) '   Namelist : namrun   ---   run parameters'
312         WRITE(numout,*) '      Assimilation cycle              nn_no           = ', nn_no
313         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           )
314         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     )
315         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  )
316         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    )
317         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
318         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
319         WRITE(numout,*) '      start with forward time step    ln_1st_euler    = ', ln_1st_euler
320         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
321         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
322         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend
323         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0
324         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0
325         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy
326         WRITE(numout,*) '      initial state output            nn_istate       = ', nn_istate
327         IF( ln_rst_list ) THEN
328            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist
329         ELSE
330            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock
331         ENDIF
332#if ! defined key_iomput
333         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write
334#endif
335         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland
336         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta
337         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
338         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
339         IF( TRIM(Agrif_CFixed()) == '0' ) THEN
340            WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
341            WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
342         ELSE
343            WRITE(numout,*) "      AGRIF: nn_wxios will be ingored. See setting for parent"
344            WRITE(numout,*) "      AGRIF: ln_xios_read will be ingored. See setting for parent"
345         ENDIF
346      ENDIF
347
348      cexper = cn_exp         ! conversion DOCTOR names into model names (this should disappear soon)
349      nrstdt = nn_rstctl
350      nit000 = nn_it000
351      nitend = nn_itend
352      ndate0 = nn_date0
353      nleapy = nn_leapy
354      ninist = nn_istate
355      l_1st_euler = ln_1st_euler
356      IF( .NOT. l_1st_euler .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 : l_1st_euler is forced to .true. '   
360         l_1st_euler = .true.
361      ENDIF
362      !                             ! control of output frequency
363      IF( .NOT. ln_rst_list ) THEN     ! we use nn_stock
364         IF( nn_stock == -1 )   CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' )
365         IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN
366            WRITE(ctmp1,*) 'nn_stock = ', nn_stock, ' it is forced to ', nitend
367            CALL ctl_warn( ctmp1 )
368            nn_stock = nitend
369         ENDIF
370      ENDIF
371#if ! defined key_iomput
372      IF( nn_write == -1 )   CALL ctl_warn( 'nn_write = -1 --> no output files will be done' )
373      IF ( nn_write == 0 ) THEN
374         WRITE(ctmp1,*) 'nn_write = ', nn_write, ' it is forced to ', nitend
375         CALL ctl_warn( ctmp1 )
376         nn_write = nitend
377      ENDIF
378#endif
379
380#if defined key_agrif
381      IF( Agrif_Root() ) THEN
382#endif
383      IF(lwp) WRITE(numout,*)
384      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
385      CASE (  1 ) 
386         CALL ioconf_calendar('gregorian')
387         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
388      CASE (  0 )
389         CALL ioconf_calendar('noleap')
390         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
391      CASE ( 30 )
392         CALL ioconf_calendar('360d')
393         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
394      END SELECT
395#if defined key_agrif
396      ENDIF
397#endif
398
399      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
400903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' )
401      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
402904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' )
403      IF(lwm) WRITE( numond, namdom )
404      !
405      IF(lwp) THEN
406         WRITE(numout,*)
407         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
408         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
409         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
410         WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt
411         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp
412         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
413      ENDIF
414      !
415      !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3
416      rDt  = 2._wp * rn_Dt
417      r1_Dt = 1._wp / rDt
418
419      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
420         lrxios = ln_xios_read.AND.ln_rstart
421!set output file type for XIOS based on NEMO namelist
422         IF (nn_wxios > 0) lwxios = .TRUE. 
423         nxioso = nn_wxios
424      ENDIF
425
426#if defined key_netcdf4
427      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
428      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
429907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
430      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
431908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
432      IF(lwm) WRITE( numond, namnc4 )
433
434      IF(lwp) THEN                        ! control print
435         WRITE(numout,*)
436         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
437         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i
438         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j
439         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k
440         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip
441      ENDIF
442
443      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
444      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
445      snc4set%ni   = nn_nchunks_i
446      snc4set%nj   = nn_nchunks_j
447      snc4set%nk   = nn_nchunks_k
448      snc4set%luse = ln_nc4zip
449#else
450      snc4set%luse = .FALSE.        ! No NetCDF 4 case
451#endif
452      !
453   END SUBROUTINE dom_nam
454
455
456   SUBROUTINE dom_ctl
457      !!----------------------------------------------------------------------
458      !!                     ***  ROUTINE dom_ctl  ***
459      !!
460      !! ** Purpose :   Domain control.
461      !!
462      !! ** Method  :   compute and print extrema of masked scale factors
463      !!----------------------------------------------------------------------
464      INTEGER, DIMENSION(2) ::   imi1, imi2, ima1, ima2
465      INTEGER, DIMENSION(2) ::   iloc   !
466      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
467      !!----------------------------------------------------------------------
468      !
469      IF(lk_mpp) THEN
470         CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 )
471         CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 )
472         CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 )
473         CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 )
474      ELSE
475         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
476         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
477         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
478         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
479         !
480         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
481         imi1(1) = iloc(1) + nimpp - 1
482         imi1(2) = iloc(2) + njmpp - 1
483         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
484         imi2(1) = iloc(1) + nimpp - 1
485         imi2(2) = iloc(2) + njmpp - 1
486         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
487         ima1(1) = iloc(1) + nimpp - 1
488         ima1(2) = iloc(2) + njmpp - 1
489         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
490         ima2(1) = iloc(1) + nimpp - 1
491         ima2(2) = iloc(2) + njmpp - 1
492      ENDIF
493      IF(lwp) THEN
494         WRITE(numout,*)
495         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
496         WRITE(numout,*) '~~~~~~~'
497         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
498         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
499         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
500         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
501      ENDIF
502      !
503   END SUBROUTINE dom_ctl
504
505
506   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
507      !!----------------------------------------------------------------------
508      !!                     ***  ROUTINE dom_nam  ***
509      !!                   
510      !! ** Purpose :   read the domain size in domain configuration file
511      !!
512      !! ** Method  :   read the cn_domcfg NetCDF file
513      !!----------------------------------------------------------------------
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   ! local integer
520      REAL(wp) ::   zorca_res                     ! local scalars
521      REAL(wp) ::   zperio                        !   -      -
522      INTEGER, DIMENSION(4) ::   idvar, idimsz    ! size   of dimensions
523      !!----------------------------------------------------------------------
524      !
525      IF(lwp) THEN
526         WRITE(numout,*) '           '
527         WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
528         WRITE(numout,*) '~~~~~~~~~~ '
529      ENDIF
530      !
531      CALL iom_open( cn_domcfg, inum )
532      !
533      !                                   !- ORCA family specificity
534      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
535         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
536         !
537         cd_cfg = 'ORCA'
538         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res )
539         !
540         IF(lwp) THEN
541            WRITE(numout,*) '   .'
542            WRITE(numout,*) '   ==>>>   ORCA configuration '
543            WRITE(numout,*) '   .'
544         ENDIF
545         !
546      ELSE                                !- cd_cfg & k_cfg are not used
547         cd_cfg = 'UNKNOWN'
548         kk_cfg = -9999999
549                                          !- or they may be present as global attributes
550                                          !- (netcdf only) 
551         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
552         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
553         IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
554         IF( kk_cfg == -999     ) kk_cfg = -9999999
555         !
556      ENDIF
557       !
558      idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz )   ! use e3t_0, that must exist, to get jp(ijk)glo
559      kpi = idimsz(1)
560      kpj = idimsz(2)
561      kpk = idimsz(3)
562      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio )
563      CALL iom_close( inum )
564      !
565      IF(lwp) THEN
566         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg
567         WRITE(numout,*) '      Ni0glo = ', kpi
568         WRITE(numout,*) '      Nj0glo = ', kpj
569         WRITE(numout,*) '      jpkglo = ', kpk
570         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio
571      ENDIF
572      !       
573   END SUBROUTINE domain_cfg
574   
575   
576   SUBROUTINE cfg_write
577      !!----------------------------------------------------------------------
578      !!                  ***  ROUTINE cfg_write  ***
579      !!                   
580      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
581      !!              contains all the ocean domain informations required to
582      !!              define an ocean configuration.
583      !!
584      !! ** Method  :   Write in a file all the arrays required to set up an
585      !!              ocean configuration.
586      !!
587      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
588      !!                       mesh, Coriolis parameter, and vertical scale factors
589      !!                    NB: also contain ORCA family information
590      !!----------------------------------------------------------------------
591      INTEGER           ::   ji, jj, jk   ! dummy loop indices
592      INTEGER           ::   izco, izps, isco, icav
593      INTEGER           ::   inum     ! local units
594      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
595      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
596      !!----------------------------------------------------------------------
597      !
598      IF(lwp) WRITE(numout,*)
599      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
600      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
601      !
602      !                       ! ============================= !
603      !                       !  create 'domcfg_out.nc' file  !
604      !                       ! ============================= !
605      !         
606      clnam = cn_domcfg_out  ! filename (configuration information)
607      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
608     
609      !
610      !                             !==  ORCA family specificities  ==!
611      IF( cn_cfg == "ORCA" ) THEN
612         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
613         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
614      ENDIF
615      !
616      !                             !==  global domain size  ==!
617      !
618      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
619      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
620      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
621      !
622      !                             !==  domain characteristics  ==!
623      !
624      !                                   ! lateral boundary of the global domain
625      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
626      !
627      !                                   ! type of vertical coordinate
628      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
629      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
630      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
631      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
632      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
633      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
634      !
635      !                                   ! ocean cavities under iceshelves
636      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
637      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
638      !
639      !                             !==  horizontal mesh  !
640      !
641      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
642      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
643      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
644      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
645      !                               
646      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
647      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
648      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
649      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
650      !                               
651      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
652      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
653      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
654      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
655      !
656      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
657      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
658      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
659      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
660      !
661      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
662      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
663      !
664      !                             !==  vertical mesh  ==!
665      !                                                     
666      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
667      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
668      !
669      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
670      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
671      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
672      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
673      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
674      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
675      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
676      !                                         
677      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
678      !
679      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
680      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
681      !
682      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
683         CALL dom_stiff( z2d )
684         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
685      ENDIF
686      !
687      IF( ll_wd ) THEN              ! wetting and drying domain
688         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
689      ENDIF
690      !
691      ! Add some global attributes ( netcdf only )
692      CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
693      CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
694      !
695      !                                ! ============================
696      !                                !        close the files
697      !                                ! ============================
698      CALL iom_close( inum )
699      !
700   END SUBROUTINE cfg_write
701
702   !!======================================================================
703END MODULE domain
Note: See TracBrowser for help on using the repository browser.