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 branches/2017/dev_r8600_xios_read_write/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2017/dev_r8600_xios_read_write/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 8793

Last change on this file since 8793 was 8793, checked in by andmirek, 6 years ago

#1953 and #1962 change lxios_read to lrxios to be consistent with write branch

  • Property svn:keywords set to Id
File size: 37.6 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 usrdef_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 domc1d         ! 1D configuration: column location
40   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
41   USE wet_dry        ! wetting and drying
42   !
43   USE in_out_manager ! I/O manager
44   USE iom            ! I/O library
45   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
46   USE lib_mpp        ! distributed memory computing library
47   USE wrk_nemo       ! Memory Allocation
48   USE timing         ! Timing
49   USE iom_def, ONLY:lwxios, nxioso, rst_wfields ! write restart flag and output type
50   USE iom, ONLY : iom_set_rst_vars, iom_set_rstw_core
51   USE iom_def, ONLY : lrxios
52
53   IMPLICIT NONE
54   PRIVATE
55
56   PUBLIC   dom_init     ! called by nemogcm.F90
57   PUBLIC   domain_cfg   ! called by nemogcm.F90
58
59   !!-------------------------------------------------------------------------
60   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
61   !! $Id$
62   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
63   !!-------------------------------------------------------------------------
64CONTAINS
65
66   SUBROUTINE dom_init
67      !!----------------------------------------------------------------------
68      !!                  ***  ROUTINE dom_init  ***
69      !!                   
70      !! ** Purpose :   Domain initialization. Call the routines that are
71      !!              required to create the arrays which define the space
72      !!              and time domain of the ocean model.
73      !!
74      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
75      !!              - dom_hgr: compute or read the horizontal grid-point position
76      !!                         and scale factors, and the coriolis factor
77      !!              - dom_zgr: define the vertical coordinate and the bathymetry
78      !!              - dom_wri: create the meshmask file if nn_msh=1
79      !!              - 1D configuration, move Coriolis, u and v at T-point
80      !!----------------------------------------------------------------------
81      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
82      INTEGER ::   iconf = 0    ! local integers
83      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
84      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
85      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
86      !!----------------------------------------------------------------------
87      !
88      IF( nn_timing == 1 )   CALL timing_start('dom_init')
89      !
90      IF(lwp) THEN         ! Ocean domain Parameters (control print)
91         WRITE(numout,*)
92         WRITE(numout,*) 'dom_init : domain initialization'
93         WRITE(numout,*) '~~~~~~~~'
94         !
95         WRITE(numout,*)     '   Domain info'
96         WRITE(numout,*)     '      dimension of model:'
97         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
98         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
99         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
100         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
101         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
102         WRITE(numout,*)     '      mpp local domain info (mpp):'
103         WRITE(numout,*)     '              jpni    : ', jpni, '   jpreci  : ', jpreci
104         WRITE(numout,*)     '              jpnj    : ', jpnj, '   jprecj  : ', jprecj
105         WRITE(numout,*)     '              jpnij   : ', jpnij
106         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
107         SELECT CASE ( jperio )
108         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
109         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
110         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. equatorial symmetric)'
111         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
112         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
113         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
114         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
115         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
116         CASE DEFAULT
117            CALL ctl_stop( 'jperio is out of range' )
118         END SELECT
119         WRITE(numout,*)     '      Ocean model configuration used:'
120         WRITE(numout,*)     '              cn_cfg = ', cn_cfg
121         WRITE(numout,*)     '              nn_cfg = ', nn_cfg
122      ENDIF
123      !
124      !     
125!!gm  This should be removed with the new configuration interface
126      IF( lk_c1d .AND. ln_c1d_locpt )  CALL dom_c1d( rn_lat1d, rn_lon1d )
127!!gm end
128      !
129      !           !==  Reference coordinate system  ==!
130      !
131      CALL dom_glo                     ! global domain versus local domain
132      CALL dom_nam                     ! read namelist ( namrun, namdom )
133      !
134      IF( lwxios ) THEN
135!define names for restart write and set core output (restart.F90)
136         CALL iom_set_rst_vars(rst_wfields)
137         CALL iom_set_rstw_core()
138      ENDIF
139      !
140      CALL dom_clo( cn_cfg, nn_cfg )   ! Closed seas and lake
141      CALL dom_hgr                     ! Horizontal mesh
142      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
143      IF( nn_closea == 0 )   CALL clo_bat( ik_top, ik_bot )    !==  remove closed seas or lakes  ==!
144      CALL dom_msk( ik_top, ik_bot )   ! Masks
145      !
146      DO jj = 1, jpj                   ! depth of the iceshelves
147         DO ji = 1, jpi
148            ik = mikt(ji,jj)
149            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
150         END DO
151      END DO
152      !
153      ht_0(:,:) = 0._wp  ! Reference ocean thickness
154      hu_0(:,:) = 0._wp
155      hv_0(:,:) = 0._wp
156      DO jk = 1, jpk
157         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
158         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
159         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
160      END DO
161      !
162      !           !==  time varying part of coordinate system  ==!
163      !
164      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
165      !
166         !       before        !          now          !       after         !
167            gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
168            gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
169                                   gde3w_n = gde3w_0   !        ---          !
170         !                                                                 
171              e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
172              e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
173              e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
174                                     e3f_n =   e3f_0   !        ---          !
175              e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
176             e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
177             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
178         !
179         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
180         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
181         !
182         !        before       !          now          !       after         !
183                                      ht_n =    ht_0   !                     ! water column thickness
184               hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !
185               hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
186            r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
187            r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
188         !
189         !
190      ELSE                       != time varying : initialize before/now/after variables
191         !
192         IF( .NOT.l_offline )  CALL dom_vvl_init 
193         !
194      ENDIF
195      !
196      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
197      !
198      IF( nn_msh > 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file
199      IF( nn_msh > 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file
200      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
201      !
202     
203      IF(lwp) THEN
204         WRITE(numout,*)
205         WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh
206         WRITE(numout,*) 
207      ENDIF
208      !
209      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file
210      !
211      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
212      !
213   END SUBROUTINE dom_init
214
215
216   SUBROUTINE dom_glo
217      !!----------------------------------------------------------------------
218      !!                     ***  ROUTINE dom_glo  ***
219      !!
220      !! ** Purpose :   initialization of global domain <--> local domain indices
221      !!
222      !! ** Method  :   
223      !!
224      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
225      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
226      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
227      !!----------------------------------------------------------------------
228      INTEGER ::   ji, jj   ! dummy loop argument
229      !!----------------------------------------------------------------------
230      !
231      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
232        mig(ji) = ji + nimpp - 1
233      END DO
234      DO jj = 1, jpj
235        mjg(jj) = jj + njmpp - 1
236      END DO
237      !                              ! global domain indices ==> local domain indices
238      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
239      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
240      DO ji = 1, jpiglo
241        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
242        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
243      END DO
244      DO jj = 1, jpjglo
245        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
246        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
247      END DO
248      IF(lwp) THEN                   ! control print
249         WRITE(numout,*)
250         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
251         WRITE(numout,*) '~~~~~~~ '
252         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
253         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
254         WRITE(numout,*)
255         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
256         IF( nn_print >= 1 ) THEN
257            WRITE(numout,*)
258            WRITE(numout,*) '          conversion local  ==> global i-index domain'
259            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
260            WRITE(numout,*)
261            WRITE(numout,*) '          conversion global ==> local  i-index domain'
262            WRITE(numout,*) '             starting index'
263            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
264            WRITE(numout,*) '             ending index'
265            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
266            WRITE(numout,*)
267            WRITE(numout,*) '          conversion local  ==> global j-index domain'
268            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
269            WRITE(numout,*)
270            WRITE(numout,*) '          conversion global ==> local  j-index domain'
271            WRITE(numout,*) '             starting index'
272            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
273            WRITE(numout,*) '             ending index'
274            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
275         ENDIF
276      ENDIF
277 25   FORMAT( 100(10x,19i4,/) )
278      !
279   END SUBROUTINE dom_glo
280
281
282   SUBROUTINE dom_nam
283      !!----------------------------------------------------------------------
284      !!                     ***  ROUTINE dom_nam  ***
285      !!                   
286      !! ** Purpose :   read domaine namelists and print the variables.
287      !!
288      !! ** input   : - namrun namelist
289      !!              - namdom namelist
290      !!              - namnc4 namelist   ! "key_netcdf4" only
291      !!----------------------------------------------------------------------
292      USE ioipsl
293      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
294         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
295         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
296         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
297         &             ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios
298      NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs
299#if defined key_netcdf4
300      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
301#endif
302      INTEGER  ::   ios                 ! Local integer output status for namelist read
303      !!----------------------------------------------------------------------
304      !
305      ln_xios_read = .false.            ! set in case ln_xios_read is not in namelist
306      nn_wxios = 0
307      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
308      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
309901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
310      !
311      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
312      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
313902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
314      IF(lwm) WRITE ( numond, namrun )
315      !
316      IF(lwp) THEN                  ! control print
317         WRITE(numout,*)
318         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
319         WRITE(numout,*) '~~~~~~~ '
320         WRITE(numout,*) '   Namelist namrun'
321         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
322         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
323         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
324         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
325         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
326         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
327         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
328         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
329         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
330         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
331         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
332         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
333         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
334         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
335         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
336         IF( ln_rst_list ) THEN
337            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
338         ELSE
339            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
340         ENDIF
341         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
342         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
343         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
344         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
345         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
346         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
347         WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
348         IF( TRIM(Agrif_CFixed()) /= '0') &
349     &       WRITE(numout,*) '      READ restart for a single file using XIOS WILL not use AGRIF setting.'
350         IF( TRIM(Agrif_CFixed()) == '0' ) &
351     &      WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
352      ENDIF
353
354      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
355      cexper = cn_exp
356      nrstdt = nn_rstctl
357      nit000 = nn_it000
358      nitend = nn_itend
359      ndate0 = nn_date0
360      nleapy = nn_leapy
361      ninist = nn_istate
362      nstock = nn_stock
363      nstocklist = nn_stocklist
364      nwrite = nn_write
365      neuler = nn_euler
366      IF( TRIM(Agrif_CFixed()) == '0') THEN
367       lrxios = ln_xios_read.AND.ln_rstart
368      ENDIF
369      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
370         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
371         CALL ctl_warn( ctmp1 )
372         neuler = 0
373      ENDIF
374      !                             ! control of output frequency
375      IF ( nstock == 0 .OR. nstock > nitend ) THEN
376         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
377         CALL ctl_warn( ctmp1 )
378         nstock = nitend
379      ENDIF
380      IF ( nwrite == 0 ) THEN
381         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
382         CALL ctl_warn( ctmp1 )
383         nwrite = nitend
384      ENDIF
385
386#if defined key_agrif
387      IF( Agrif_Root() ) THEN
388#endif
389      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
390      CASE (  1 ) 
391         CALL ioconf_calendar('gregorian')
392         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
393      CASE (  0 )
394         CALL ioconf_calendar('noleap')
395         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
396      CASE ( 30 )
397         CALL ioconf_calendar('360d')
398         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
399      END SELECT
400#if defined key_agrif
401      ENDIF
402#endif
403
404      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
405      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
406903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
407      !
408      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
409      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
410904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
411      IF(lwm) WRITE ( numond, namdom )
412      !
413      IF(lwp) THEN
414         WRITE(numout,*)
415         WRITE(numout,*) '   Namelist namdom : space & time domain'
416         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh
417         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea  = ', nn_closea
418         WRITE(numout,*) '      create mesh/mask file(s)              nn_msh     = ', nn_msh
419         WRITE(numout,*) '           = 0   no file created           '
420         WRITE(numout,*) '           = 1   mesh_mask                 '
421         WRITE(numout,*) '           = 2   mesh and mask             '
422         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
423         WRITE(numout,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)'
424         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt
425         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp
426         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs
427      ENDIF
428     
429      call flush( numout )
430      !
431!     !          ! conversion DOCTOR names into model names (this should disappear soon)
432      atfp      = rn_atfp
433      rdt       = rn_rdt
434
435      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
436!set output file type for XIOS based on NEMO namelist
437         if (nn_wxios > 0) lwxios = .TRUE. 
438         nxioso = nn_wxios
439      ELSE
440         IF(lwp) THEN
441            write(numout,*)
442            write(numout,*) "AGRIF: nn_wxios will be ingored. See setting for NEMO" 
443            write(numout,*)
444         ENDIF
445      ENDIF
446
447#if defined key_netcdf4
448      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
449      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
450      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
451907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
452      !
453      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
454      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
455908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
456      IF(lwm) WRITE( numond, namnc4 )
457
458      IF(lwp) THEN                        ! control print
459         WRITE(numout,*)
460         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
461         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
462         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
463         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
464         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
465      ENDIF
466
467      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
468      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
469      snc4set%ni   = nn_nchunks_i
470      snc4set%nj   = nn_nchunks_j
471      snc4set%nk   = nn_nchunks_k
472      snc4set%luse = ln_nc4zip
473#else
474      snc4set%luse = .FALSE.        ! No NetCDF 4 case
475#endif
476      !
477   END SUBROUTINE dom_nam
478
479
480   SUBROUTINE dom_ctl
481      !!----------------------------------------------------------------------
482      !!                     ***  ROUTINE dom_ctl  ***
483      !!
484      !! ** Purpose :   Domain control.
485      !!
486      !! ** Method  :   compute and print extrema of masked scale factors
487      !!----------------------------------------------------------------------
488      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
489      INTEGER, DIMENSION(2) ::   iloc   !
490      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
491      !!----------------------------------------------------------------------
492      !
493      IF(lk_mpp) THEN
494         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
495         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
496         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
497         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
498      ELSE
499         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
500         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
501         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
502         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
503         !
504         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
505         iimi1 = iloc(1) + nimpp - 1
506         ijmi1 = iloc(2) + njmpp - 1
507         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
508         iimi2 = iloc(1) + nimpp - 1
509         ijmi2 = iloc(2) + njmpp - 1
510         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
511         iima1 = iloc(1) + nimpp - 1
512         ijma1 = iloc(2) + njmpp - 1
513         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
514         iima2 = iloc(1) + nimpp - 1
515         ijma2 = iloc(2) + njmpp - 1
516      ENDIF
517      IF(lwp) THEN
518         WRITE(numout,*)
519         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
520         WRITE(numout,*) '~~~~~~~'
521         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
522         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
523         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
524         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
525      ENDIF
526      !
527   END SUBROUTINE dom_ctl
528
529
530   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
531      !!----------------------------------------------------------------------
532      !!                     ***  ROUTINE dom_nam  ***
533      !!                   
534      !! ** Purpose :   read the domain size in domain configuration file
535      !!
536      !! ** Method  :   
537      !!
538      !!----------------------------------------------------------------------
539      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
540      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
541      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
542      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
543      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
544      !
545      INTEGER ::   inum, ii   ! local integer
546      REAL(wp) ::   zorca_res                     ! local scalars
547      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
548      !!----------------------------------------------------------------------
549      !
550      ii = 1
551      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
552      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'   ;   ii = ii+1
553      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
554      !
555      CALL iom_open( cn_domcfg, inum )
556      !
557      !                                   !- ORCA family specificity
558      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
559         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
560         !
561         cd_cfg = 'ORCA'
562         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res )
563         !
564         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
565         WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                         ;   ii = ii+1
566         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
567         !
568      ELSE                                !- cd_cfg & k_cfg are not used
569         cd_cfg = 'UNKNOWN'
570         kk_cfg = -9999999
571                                          !- or they may be present as global attributes
572                                          !- (netcdf only) 
573         IF( iom_file(inum)%iolib == jpnf90 ) THEN
574            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
575            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
576            IF( TRIM(cd_cfg) .EQ. '!') cd_cfg = 'UNKNOWN'
577            IF( kk_cfg .EQ. -999     ) kk_cfg = -9999999
578         ENDIF
579         !
580      ENDIF
581      !
582      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo )
583      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo )
584      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo )
585      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio )
586      CALL iom_close( inum )
587      !
588      WRITE(ldtxt(ii),*) '   cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
589      WRITE(ldtxt(ii),*) '   jpiglo = ', kpi                                              ;   ii = ii+1
590      WRITE(ldtxt(ii),*) '   jpjglo = ', kpj                                              ;   ii = ii+1
591      WRITE(ldtxt(ii),*) '   jpkglo = ', kpk                                              ;   ii = ii+1
592      WRITE(ldtxt(ii),*) '   type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
593      !       
594   END SUBROUTINE domain_cfg
595   
596   
597   SUBROUTINE cfg_write
598      !!----------------------------------------------------------------------
599      !!                  ***  ROUTINE cfg_write  ***
600      !!                   
601      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
602      !!              contains all the ocean domain informations required to
603      !!              define an ocean configuration.
604      !!
605      !! ** Method  :   Write in a file all the arrays required to set up an
606      !!              ocean configuration.
607      !!
608      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
609      !!                       mesh, Coriolis parameter, and vertical scale factors
610      !!                    NB: also contain ORCA family information
611      !!----------------------------------------------------------------------
612      INTEGER           ::   ji, jj, jk   ! dummy loop indices
613      INTEGER           ::   izco, izps, isco, icav
614      INTEGER           ::   inum     ! local units
615      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
616      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
617      !!----------------------------------------------------------------------
618      !
619      IF(lwp) WRITE(numout,*)
620      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
621      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
622      !
623      !                       ! ============================= !
624      !                       !  create 'domcfg_out.nc' file  !
625      !                       ! ============================= !
626      !         
627      clnam = 'domcfg_out'  ! filename (configuration information)
628      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
629     
630      !
631      !                             !==  ORCA family specificities  ==!
632      IF( cn_cfg == "ORCA" ) THEN
633         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
634         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
635      ENDIF
636      !
637      !                             !==  global domain size  ==!
638      !
639      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
640      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
641      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
642      !
643      !                             !==  domain characteristics  ==!
644      !
645      !                                   ! lateral boundary of the global domain
646      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
647      !
648      !                                   ! type of vertical coordinate
649      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
650      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
651      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
652      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
653      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
654      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
655      !
656      !                                   ! ocean cavities under iceshelves
657      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
658      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
659      !
660      !                             !==  horizontal mesh  !
661      !
662      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
663      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
664      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
665      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
666      !                               
667      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
668      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
669      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
670      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
671      !                               
672      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
673      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
674      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
675      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
676      !
677      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
678      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
679      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
680      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
681      !
682      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
683      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
684      !
685      !                             !==  vertical mesh  ==!
686      !                                                     
687      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
688      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
689      !
690      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
691      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
692      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
693      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
694      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
695      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
696      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
697      !                                         
698      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
699      !
700      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
701      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
702      !
703      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
704         CALL dom_stiff( z2d )
705         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
706      ENDIF
707      !
708      IF( ln_wd ) THEN              ! wetting and drying domain
709         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
710         CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
711      ENDIF
712      !
713      ! Add some global attributes ( netcdf only )
714      IF( iom_file(inum)%iolib == jpnf90 ) THEN
715         CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
716         CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
717      ENDIF
718      !
719      !                                ! ============================
720      !                                !        close the files
721      !                                ! ============================
722      CALL iom_close( inum )
723      !
724   END SUBROUTINE cfg_write
725
726   !!======================================================================
727END MODULE domain
Note: See TracBrowser for help on using the repository browser.