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

source: branches/2017/dev_r8600_xios_write/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 8644

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

ticket #1962 xios write functionality works

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