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

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

#1962 change variable names to follow NEMO coding convention

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