source: branches/2017/dev_r8600_xios_read_write_v2/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 8858

Last change on this file since 8858 was 8858, checked in by andmirek, 3 years ago

#1953 and #1962 tidy up prints for previous commit

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