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

source: NEMO/branches/2019/UKMO_MERGE_2019/src/OCE/DOM/domain.F90 @ 12077

Last change on this file since 12077 was 12068, checked in by davestorkey, 4 years ago

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