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_v2/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

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

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

#1953 and #1962 handle together setting XIOS restart read and write flags
  • Property svn:keywords set to Id
File size: 37.8 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         WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
353         IF( TRIM(Agrif_CFixed()) /= '0') &
354     &       WRITE(numout,*) '      READ restart for a single file using XIOS WILL not use AGRIF setting.'
355         IF( TRIM(Agrif_CFixed()) == '0' ) &
356     &      WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
357      ENDIF
358
359      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
360      cexper = cn_exp
361      nrstdt = nn_rstctl
362      nit000 = nn_it000
363      nitend = nn_itend
364      ndate0 = nn_date0
365      nleapy = nn_leapy
366      ninist = nn_istate
367      nstock = nn_stock
368      nstocklist = nn_stocklist
369      nwrite = nn_write
370      neuler = nn_euler
371      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
372         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
373         CALL ctl_warn( ctmp1 )
374         neuler = 0
375      ENDIF
376      !                             ! control of output frequency
377      IF ( nstock == 0 .OR. nstock > nitend ) THEN
378         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
379         CALL ctl_warn( ctmp1 )
380         nstock = nitend
381      ENDIF
382      IF ( nwrite == 0 ) THEN
383         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
384         CALL ctl_warn( ctmp1 )
385         nwrite = nitend
386      ENDIF
387
388#if defined key_agrif
389      IF( Agrif_Root() ) THEN
390#endif
391      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
392      CASE (  1 ) 
393         CALL ioconf_calendar('gregorian')
394         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
395      CASE (  0 )
396         CALL ioconf_calendar('noleap')
397         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
398      CASE ( 30 )
399         CALL ioconf_calendar('360d')
400         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
401      END SELECT
402#if defined key_agrif
403      ENDIF
404#endif
405
406      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
407      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
408903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
409      !
410      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
411      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
412904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
413      IF(lwm) WRITE ( numond, namdom )
414      !
415      IF(lwp) THEN
416         WRITE(numout,*)
417         WRITE(numout,*) '   Namelist namdom : space & time domain'
418         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh
419         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea  = ', nn_closea
420         WRITE(numout,*) '      create mesh/mask file(s)              nn_msh     = ', nn_msh
421         WRITE(numout,*) '           = 0   no file created           '
422         WRITE(numout,*) '           = 1   mesh_mask                 '
423         WRITE(numout,*) '           = 2   mesh and mask             '
424         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
425         WRITE(numout,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)'
426         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt
427         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp
428         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs
429      ENDIF
430     
431      call flush( numout )
432      !
433!     !          ! conversion DOCTOR names into model names (this should disappear soon)
434      atfp      = rn_atfp
435      rdt       = rn_rdt
436
437      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
438         lrxios = ln_xios_read.AND.ln_rstart
439!set output file type for XIOS based on NEMO namelist
440         IF (nn_wxios > 0) lwxios = .TRUE. 
441         nxioso = nn_wxios
442      ELSE
443         IF(lwp) THEN
444            write(numout,*)
445            write(numout,*) "AGRIF: nn_wxios will be ingored. See setting for parent" 
446            write(numout,*) "AGRIF: ln_xios_read will be ingored. See setting for parent"
447            write(numout,*)
448         ENDIF
449      ENDIF
450
451#if defined key_netcdf4
452      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
453      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
454      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
455907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
456      !
457      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
458      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
459908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
460      IF(lwm) WRITE( numond, namnc4 )
461
462      IF(lwp) THEN                        ! control print
463         WRITE(numout,*)
464         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
465         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
466         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
467         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
468         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
469      ENDIF
470
471      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
472      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
473      snc4set%ni   = nn_nchunks_i
474      snc4set%nj   = nn_nchunks_j
475      snc4set%nk   = nn_nchunks_k
476      snc4set%luse = ln_nc4zip
477#else
478      snc4set%luse = .FALSE.        ! No NetCDF 4 case
479#endif
480      !
481   END SUBROUTINE dom_nam
482
483
484   SUBROUTINE dom_ctl
485      !!----------------------------------------------------------------------
486      !!                     ***  ROUTINE dom_ctl  ***
487      !!
488      !! ** Purpose :   Domain control.
489      !!
490      !! ** Method  :   compute and print extrema of masked scale factors
491      !!----------------------------------------------------------------------
492      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
493      INTEGER, DIMENSION(2) ::   iloc   !
494      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
495      !!----------------------------------------------------------------------
496      !
497      IF(lk_mpp) THEN
498         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
499         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
500         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
501         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
502      ELSE
503         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
504         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
505         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
506         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
507         !
508         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
509         iimi1 = iloc(1) + nimpp - 1
510         ijmi1 = iloc(2) + njmpp - 1
511         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
512         iimi2 = iloc(1) + nimpp - 1
513         ijmi2 = iloc(2) + njmpp - 1
514         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
515         iima1 = iloc(1) + nimpp - 1
516         ijma1 = iloc(2) + njmpp - 1
517         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
518         iima2 = iloc(1) + nimpp - 1
519         ijma2 = iloc(2) + njmpp - 1
520      ENDIF
521      IF(lwp) THEN
522         WRITE(numout,*)
523         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
524         WRITE(numout,*) '~~~~~~~'
525         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
526         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
527         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
528         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
529      ENDIF
530      !
531   END SUBROUTINE dom_ctl
532
533
534   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
535      !!----------------------------------------------------------------------
536      !!                     ***  ROUTINE dom_nam  ***
537      !!                   
538      !! ** Purpose :   read the domain size in domain configuration file
539      !!
540      !! ** Method  :   
541      !!
542      !!----------------------------------------------------------------------
543      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
544      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
545      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
546      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
547      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
548      !
549      INTEGER ::   inum, ii   ! local integer
550      REAL(wp) ::   zorca_res                     ! local scalars
551      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
552      !!----------------------------------------------------------------------
553      !
554      ii = 1
555      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
556      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'   ;   ii = ii+1
557      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
558      !
559      CALL iom_open( cn_domcfg, inum )
560      !
561      !                                   !- ORCA family specificity
562      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
563         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
564         !
565         cd_cfg = 'ORCA'
566         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res )
567         !
568         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
569         WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                         ;   ii = ii+1
570         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
571         !
572      ELSE                                !- cd_cfg & k_cfg are not used
573         cd_cfg = 'UNKNOWN'
574         kk_cfg = -9999999
575                                          !- or they may be present as global attributes
576                                          !- (netcdf only) 
577         IF( iom_file(inum)%iolib == jpnf90 ) THEN
578            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
579            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
580            IF( TRIM(cd_cfg) .EQ. '!') cd_cfg = 'UNKNOWN'
581            IF( kk_cfg .EQ. -999     ) kk_cfg = -9999999
582         ENDIF
583         !
584      ENDIF
585      !
586      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo )
587      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo )
588      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo )
589      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio )
590      CALL iom_close( inum )
591      !
592      WRITE(ldtxt(ii),*) '   cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
593      WRITE(ldtxt(ii),*) '   jpiglo = ', kpi                                              ;   ii = ii+1
594      WRITE(ldtxt(ii),*) '   jpjglo = ', kpj                                              ;   ii = ii+1
595      WRITE(ldtxt(ii),*) '   jpkglo = ', kpk                                              ;   ii = ii+1
596      WRITE(ldtxt(ii),*) '   type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
597      !       
598   END SUBROUTINE domain_cfg
599   
600   
601   SUBROUTINE cfg_write
602      !!----------------------------------------------------------------------
603      !!                  ***  ROUTINE cfg_write  ***
604      !!                   
605      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
606      !!              contains all the ocean domain informations required to
607      !!              define an ocean configuration.
608      !!
609      !! ** Method  :   Write in a file all the arrays required to set up an
610      !!              ocean configuration.
611      !!
612      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
613      !!                       mesh, Coriolis parameter, and vertical scale factors
614      !!                    NB: also contain ORCA family information
615      !!----------------------------------------------------------------------
616      INTEGER           ::   ji, jj, jk   ! dummy loop indices
617      INTEGER           ::   izco, izps, isco, icav
618      INTEGER           ::   inum     ! local units
619      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
620      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
621      !!----------------------------------------------------------------------
622      !
623      IF(lwp) WRITE(numout,*)
624      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
625      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
626      !
627      !                       ! ============================= !
628      !                       !  create 'domcfg_out.nc' file  !
629      !                       ! ============================= !
630      !         
631      clnam = 'domcfg_out'  ! filename (configuration information)
632      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
633     
634      !
635      !                             !==  ORCA family specificities  ==!
636      IF( cn_cfg == "ORCA" ) THEN
637         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
638         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
639      ENDIF
640      !
641      !                             !==  global domain size  ==!
642      !
643      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
644      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
645      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
646      !
647      !                             !==  domain characteristics  ==!
648      !
649      !                                   ! lateral boundary of the global domain
650      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
651      !
652      !                                   ! type of vertical coordinate
653      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
654      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
655      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
656      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
657      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
658      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
659      !
660      !                                   ! ocean cavities under iceshelves
661      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
662      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
663      !
664      !                             !==  horizontal mesh  !
665      !
666      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
667      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
668      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
669      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
670      !                               
671      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
672      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
673      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
674      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
675      !                               
676      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
677      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
678      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
679      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
680      !
681      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
682      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
683      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
684      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
685      !
686      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
687      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
688      !
689      !                             !==  vertical mesh  ==!
690      !                                                     
691      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
692      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
693      !
694      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
695      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
696      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
697      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
698      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
699      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
700      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
701      !                                         
702      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
703      !
704      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
705      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
706      !
707      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
708         CALL dom_stiff( z2d )
709         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
710      ENDIF
711      !
712      IF( ln_wd ) THEN              ! wetting and drying domain
713         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
714         CALL iom_rstput( 0, 0, inum, 'ht_wd'  , ht_wd  , ktype = jp_r8 )
715      ENDIF
716      !
717      ! Add some global attributes ( netcdf only )
718      IF( iom_file(inum)%iolib == jpnf90 ) THEN
719         CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
720         CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
721      ENDIF
722      !
723      !                                ! ============================
724      !                                !        close the files
725      !                                ! ============================
726      CALL iom_close( inum )
727      !
728   END SUBROUTINE cfg_write
729
730   !!======================================================================
731END MODULE domain
Note: See TracBrowser for help on using the repository browser.