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

source: NEMO/branches/2020/dev_12905_xios_restart/src/OCE/DOM/domain.F90 @ 12950

Last change on this file since 12950 was 12950, checked in by andmirek, 4 years ago

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