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

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

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