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

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

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