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

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DOM/domain.F90 @ 11949

Last change on this file since 11949 was 11949, checked in by acc, 4 years ago

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