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

source: branches/UKMO/dev_merge_2017_restart_datestamp_GO6_mixing/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 9497

Last change on this file since 9497 was 9497, checked in by davestorkey, 6 years ago

branches/UKMO/dev_merge_2017_restart_datestamp_GO6_mixing : recommit science changes.

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