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 NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src/OCE/DOM – NEMO

source: NEMO/branches/2018/dev_r10057_ENHANCE03_ZTILDE/src/OCE/DOM/domain.F90 @ 10126

Last change on this file since 10126 was 10126, checked in by jchanut, 6 years ago

Merge with trunk
  • Property svn:keywords set to Id
File size: 37.3 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 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 dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
40   USE wet_dry,  ONLY : ll_wd
41   !
42   USE in_out_manager ! I/O manager
43   USE iom            ! I/O library
44   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
45   USE lib_mpp        ! distributed memory computing library
46
47   IMPLICIT NONE
48   PRIVATE
49
50   PUBLIC   dom_init     ! called by nemogcm.F90
51   PUBLIC   domain_cfg   ! called by nemogcm.F90
52
53   !!-------------------------------------------------------------------------
54   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
55   !! $Id$
56   !! Software governed by the CeCILL license (see ./LICENSE)
57   !!-------------------------------------------------------------------------
58CONTAINS
59
60   SUBROUTINE dom_init(cdstr)
61      !!----------------------------------------------------------------------
62      !!                  ***  ROUTINE dom_init  ***
63      !!                   
64      !! ** Purpose :   Domain initialization. Call the routines that are
65      !!              required to create the arrays which define the space
66      !!              and time domain of the ocean model.
67      !!
68      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
69      !!              - dom_hgr: compute or read the horizontal grid-point position
70      !!                         and scale factors, and the coriolis factor
71      !!              - dom_zgr: define the vertical coordinate and the bathymetry
72      !!              - dom_wri: create the meshmask file (ln_meshmask=T)
73      !!              - 1D configuration, move Coriolis, u and v at T-point
74      !!----------------------------------------------------------------------
75      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
76      INTEGER ::   iconf = 0    ! local integers
77      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
78      CHARACTER (len=*), INTENT(IN) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables
79      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
80      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
81      !!----------------------------------------------------------------------
82      !
83      IF(lwp) THEN         ! Ocean domain Parameters (control print)
84         WRITE(numout,*)
85         WRITE(numout,*) 'dom_init : domain initialization'
86         WRITE(numout,*) '~~~~~~~~'
87         !
88         WRITE(numout,*)     '   Domain info'
89         WRITE(numout,*)     '      dimension of model:'
90         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
91         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
92         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
93         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
94         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
95         WRITE(numout,*)     '      mpp local domain info (mpp):'
96         WRITE(numout,*)     '              jpni    : ', jpni, '   nn_hls  : ', nn_hls
97         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
98         WRITE(numout,*)     '              jpnij   : ', jpnij
99         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
100         SELECT CASE ( jperio )
101         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
102         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
103         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. equatorial symmetric)'
104         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
105         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
106         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
107         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
108         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
109         CASE DEFAULT
110            CALL ctl_stop( 'jperio is out of range' )
111         END SELECT
112         WRITE(numout,*)     '      Ocean model configuration used:'
113         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
114      ENDIF
115      lwxios = .FALSE.
116      ln_xios_read = .FALSE.
117      !
118      !           !==  Reference coordinate system  ==!
119      !
120      CALL dom_glo                     ! global domain versus local domain
121      CALL dom_nam                     ! read namelist ( namrun, namdom )
122      !
123      IF( lwxios ) THEN
124!define names for restart write and set core output (restart.F90)
125         CALL iom_set_rst_vars(rst_wfields)
126         CALL iom_set_rstw_core(cdstr)
127      ENDIF
128!reset namelist for SAS
129      IF(cdstr == 'SAS') THEN
130         IF(lrxios) THEN
131               IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'
132               lrxios = .FALSE.
133         ENDIF
134      ENDIF
135      !
136      CALL dom_hgr                     ! Horizontal mesh
137      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
138      CALL dom_msk( ik_top, ik_bot )   ! Masks
139      IF( ln_closea )   CALL dom_clo   ! ln_closea=T : closed seas included in the simulation
140                                       ! Read in masks to define closed seas and lakes
141      !
142      DO jj = 1, jpj                   ! depth of the iceshelves
143         DO ji = 1, jpi
144            ik = mikt(ji,jj)
145            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
146         END DO
147      END DO
148      !
149      ht_0(:,:) = 0._wp  ! Reference ocean thickness
150      hu_0(:,:) = 0._wp
151      hv_0(:,:) = 0._wp
152      hf_0(:,:) = 0._wp
153      DO jk = 1, jpk
154         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
155         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
156         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
157      END DO
158      !
159      DO jj=1, jpjm1
160         DO jk = 1, jpk
161            hf_0(:,jj) = hf_0(:,jj) + e3f_0(:,jj,jk) * umask(:,jj,jk)*umask(:,jj+1,jk)
162         END DO
163      END DO
164      CALL lbc_lnk( hf_0, 'F', 1._wp )
165      !
166      !           !==  time varying part of coordinate system  ==!
167      !
168      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
169      !
170         !       before        !          now          !       after         !
171            gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
172            gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
173                                   gde3w_n = gde3w_0   !        ---          !
174         !                                                                 
175              e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
176              e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
177              e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
178                                     e3f_n =   e3f_0   !        ---          !
179              e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
180             e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
181             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
182         !
183         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
184         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
185         !
186         !        before       !          now          !       after         !
187                                      ht_n =    ht_0   !                     ! water column thickness
188               hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !
189               hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
190            r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
191            r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
192         !
193         !
194      ELSE                       != time varying : initialize before/now/after variables
195         !
196         IF( .NOT.l_offline )  CALL dom_vvl_init 
197         !
198      ENDIF
199      !
200      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
201      !
202      IF( ln_meshmask .AND. .NOT.ln_iscpl )                        CALL dom_wri     ! Create a domain file
203      IF( ln_meshmask .AND.      ln_iscpl .AND. .NOT.ln_rstart )   CALL dom_wri     ! Create a domain file
204      IF(                                       .NOT.ln_rstart )   CALL dom_ctl     ! Domain control
205      !
206      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file
207      !
208      IF(lwp) THEN
209         WRITE(numout,*)
210         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization'
211         WRITE(numout,*) '~~~~~~~~'
212         WRITE(numout,*) 
213      ENDIF
214      !
215   END SUBROUTINE dom_init
216
217
218   SUBROUTINE dom_glo
219      !!----------------------------------------------------------------------
220      !!                     ***  ROUTINE dom_glo  ***
221      !!
222      !! ** Purpose :   initialization of global domain <--> local domain indices
223      !!
224      !! ** Method  :   
225      !!
226      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
227      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
228      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
229      !!----------------------------------------------------------------------
230      INTEGER ::   ji, jj   ! dummy loop argument
231      !!----------------------------------------------------------------------
232      !
233      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
234        mig(ji) = ji + nimpp - 1
235      END DO
236      DO jj = 1, jpj
237        mjg(jj) = jj + njmpp - 1
238      END DO
239      !                              ! global domain indices ==> local domain indices
240      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
241      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
242      DO ji = 1, jpiglo
243        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
244        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
245      END DO
246      DO jj = 1, jpjglo
247        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
248        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
249      END DO
250      IF(lwp) THEN                   ! control print
251         WRITE(numout,*)
252         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
253         WRITE(numout,*) '~~~~~~~ '
254         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
255         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
256         WRITE(numout,*)
257         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
258         IF( nn_print >= 1 ) THEN
259            WRITE(numout,*)
260            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
261            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
262            WRITE(numout,*)
263            WRITE(numout,*) '          conversion global ==> local  i-index domain'
264            WRITE(numout,*) '             starting index (mi0)'
265            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
266            WRITE(numout,*) '             ending index (mi1)'
267            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
268            WRITE(numout,*)
269            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
270            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
271            WRITE(numout,*)
272            WRITE(numout,*) '          conversion global ==> local  j-index domain'
273            WRITE(numout,*) '             starting index (mj0)'
274            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
275            WRITE(numout,*) '             ending index (mj1)'
276            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
277         ENDIF
278      ENDIF
279 25   FORMAT( 100(10x,19i4,/) )
280      !
281   END SUBROUTINE dom_glo
282
283
284   SUBROUTINE dom_nam
285      !!----------------------------------------------------------------------
286      !!                     ***  ROUTINE dom_nam  ***
287      !!                   
288      !! ** Purpose :   read domaine namelists and print the variables.
289      !!
290      !! ** input   : - namrun namelist
291      !!              - namdom namelist
292      !!              - namnc4 namelist   ! "key_netcdf4" only
293      !!----------------------------------------------------------------------
294      USE ioipsl
295      !!
296      INTEGER  ::   ios   ! Local integer
297      !
298      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
299         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
300         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
301         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
302         &             ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios
303      NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask
304#if defined key_netcdf4
305      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
306#endif
307      !!----------------------------------------------------------------------
308      !
309      IF(lwp) THEN
310         WRITE(numout,*)
311         WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
312         WRITE(numout,*) '~~~~~~~ '
313      ENDIF
314      !
315      !
316      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
317      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
318901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
319      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
320      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
321902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
322      IF(lwm) WRITE ( numond, namrun )
323      !
324      IF(lwp) THEN                  ! control print
325         WRITE(numout,*) '   Namelist : namrun   ---   run parameters'
326         WRITE(numout,*) '      Assimilation cycle              nn_no           = ', nn_no
327         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           )
328         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     )
329         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  )
330         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    )
331         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
332         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
333         WRITE(numout,*) '      start with forward time step    nn_euler        = ', nn_euler
334         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
335         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
336         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend
337         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0
338         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0
339         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy
340         WRITE(numout,*) '      initial state output            nn_istate       = ', nn_istate
341         IF( ln_rst_list ) THEN
342            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist
343         ELSE
344            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock
345         ENDIF
346         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write
347         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland
348         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta
349         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
350         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
351         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl        = ', ln_iscpl
352         IF( TRIM(Agrif_CFixed()) == '0' ) THEN
353            WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
354            WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
355         ELSE
356            WRITE(numout,*) "      AGRIF: nn_wxios will be ingored. See setting for parent"
357            WRITE(numout,*) "      AGRIF: ln_xios_read will be ingored. See setting for parent"
358         ENDIF
359      ENDIF
360
361      cexper = cn_exp         ! conversion DOCTOR names into model names (this should disappear soon)
362      nrstdt = nn_rstctl
363      nit000 = nn_it000
364      nitend = nn_itend
365      ndate0 = nn_date0
366      nleapy = nn_leapy
367      ninist = nn_istate
368      nstock = nn_stock
369      nstocklist = nn_stocklist
370      nwrite = nn_write
371      neuler = nn_euler
372      IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN
373         IF(lwp) WRITE(numout,*) 
374         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
375         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : nn_euler is forced to 0 '   
376         neuler = 0
377      ENDIF
378      !                             ! control of output frequency
379      IF( nstock == 0 .OR. nstock > nitend ) THEN
380         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
381         CALL ctl_warn( ctmp1 )
382         nstock = nitend
383      ENDIF
384      IF ( nwrite == 0 ) THEN
385         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
386         CALL ctl_warn( ctmp1 )
387         nwrite = nitend
388      ENDIF
389
390#if defined key_agrif
391      IF( Agrif_Root() ) THEN
392#endif
393      IF(lwp) WRITE(numout,*)
394      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
395      CASE (  1 ) 
396         CALL ioconf_calendar('gregorian')
397         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
398      CASE (  0 )
399         CALL ioconf_calendar('noleap')
400         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
401      CASE ( 30 )
402         CALL ioconf_calendar('360d')
403         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
404      END SELECT
405#if defined key_agrif
406      ENDIF
407#endif
408
409      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
410      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
411903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
412      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
413      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
414904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
415      IF(lwm) WRITE( numond, namdom )
416      !
417      IF(lwp) THEN
418         WRITE(numout,*)
419         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
420         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
421         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
422         WRITE(numout,*) '      treshold to open the isf cavity         rn_isfhmin  = ', rn_isfhmin, ' [m]'
423         WRITE(numout,*) '      ocean time step                         rn_rdt      = ', rn_rdt
424         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp
425         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
426      ENDIF
427      !
428      !          ! conversion DOCTOR names into model names (this should disappear soon)
429      atfp = rn_atfp
430      rdt  = rn_rdt
431
432      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
433         lrxios = ln_xios_read.AND.ln_rstart
434!set output file type for XIOS based on NEMO namelist
435         IF (nn_wxios > 0) lwxios = .TRUE. 
436         nxioso = nn_wxios
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      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  :   read the cn_domcfg NetCDF file
528      !!----------------------------------------------------------------------
529      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
530      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
531      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
532      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
533      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
534      !
535      INTEGER ::   inum, ii   ! local integer
536      REAL(wp) ::   zorca_res                     ! local scalars
537      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
538      !!----------------------------------------------------------------------
539      !
540      ii = 1
541      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
542      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'  ;   ii = ii+1
543      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
544      !
545      CALL iom_open( cn_domcfg, inum )
546      !
547      !                                   !- ORCA family specificity
548      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
549         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
550         !
551         cd_cfg = 'ORCA'
552         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res )
553         !
554         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
555         WRITE(ldtxt(ii),*) '   ==>>>   ORCA configuration '                           ;   ii = ii+1
556         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
557         !
558      ELSE                                !- cd_cfg & k_cfg are not used
559         cd_cfg = 'UNKNOWN'
560         kk_cfg = -9999999
561                                          !- or they may be present as global attributes
562                                          !- (netcdf only) 
563         IF( iom_file(inum)%iolib == jpnf90 ) THEN
564            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
565            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
566            IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
567            IF( kk_cfg == -999     ) kk_cfg = -9999999
568         ENDIF
569         !
570      ENDIF
571      !
572      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = NINT( ziglo )
573      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = NINT( zjglo )
574      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = NINT( zkglo )
575      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio )
576      CALL iom_close( inum )
577      !
578      WRITE(ldtxt(ii),*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
579      WRITE(ldtxt(ii),*) '      jpiglo = ', kpi                                              ;   ii = ii+1
580      WRITE(ldtxt(ii),*) '      jpjglo = ', kpj                                              ;   ii = ii+1
581      WRITE(ldtxt(ii),*) '      jpkglo = ', kpk                                              ;   ii = ii+1
582      WRITE(ldtxt(ii),*) '      type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
583      !       
584   END SUBROUTINE domain_cfg
585   
586   
587   SUBROUTINE cfg_write
588      !!----------------------------------------------------------------------
589      !!                  ***  ROUTINE cfg_write  ***
590      !!                   
591      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
592      !!              contains all the ocean domain informations required to
593      !!              define an ocean configuration.
594      !!
595      !! ** Method  :   Write in a file all the arrays required to set up an
596      !!              ocean configuration.
597      !!
598      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
599      !!                       mesh, Coriolis parameter, and vertical scale factors
600      !!                    NB: also contain ORCA family information
601      !!----------------------------------------------------------------------
602      INTEGER           ::   ji, jj, jk   ! dummy loop indices
603      INTEGER           ::   izco, izps, isco, icav
604      INTEGER           ::   inum     ! local units
605      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
606      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
607      !!----------------------------------------------------------------------
608      !
609      IF(lwp) WRITE(numout,*)
610      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
611      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
612      !
613      !                       ! ============================= !
614      !                       !  create 'domcfg_out.nc' file  !
615      !                       ! ============================= !
616      !         
617      clnam = cn_domcfg_out  ! filename (configuration information)
618      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
619     
620      !
621      !                             !==  ORCA family specificities  ==!
622      IF( cn_cfg == "ORCA" ) THEN
623         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
624         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
625      ENDIF
626      !
627      !                             !==  global domain size  ==!
628      !
629      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
630      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
631      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
632      !
633      !                             !==  domain characteristics  ==!
634      !
635      !                                   ! lateral boundary of the global domain
636      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
637      !
638      !                                   ! type of vertical coordinate
639      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
640      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
641      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
642      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
643      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
644      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
645      !
646      !                                   ! ocean cavities under iceshelves
647      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
648      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
649      !
650      !                             !==  horizontal mesh  !
651      !
652      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
653      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
654      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
655      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
656      !                               
657      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
658      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
659      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
660      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
661      !                               
662      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
663      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
664      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
665      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
666      !
667      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
668      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
669      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
670      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
671      !
672      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
673      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
674      !
675      !                             !==  vertical mesh  ==!
676      !                                                     
677      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
678      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
679      !
680      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
681      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
682      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
683      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
684      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
685      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
686      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
687      !                                         
688      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
689      !
690      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
691      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
692      !
693      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
694         CALL dom_stiff( z2d )
695         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
696      ENDIF
697      !
698      IF( ll_wd ) THEN              ! wetting and drying domain
699         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , 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.