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/2020/SI3_martin_ponds/src/OCE/DOM – NEMO

source: NEMO/branches/2020/SI3_martin_ponds/src/OCE/DOM/domain.F90 @ 13985

Last change on this file since 13985 was 13985, checked in by clem, 4 years ago

merge with trunk at r13983

  • Property svn:keywords set to Id
File size: 39.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   !!            4.x  ! 2020-02  (G. Madec, S. Techene) introduce ssh to h0 ratio
18   !!----------------------------------------------------------------------
19   
20   !!----------------------------------------------------------------------
21   !!   dom_init      : initialize the space and time domain
22   !!   dom_glo       : initialize global domain <--> local domain indices
23   !!   dom_nam       : read and contral domain namelists
24   !!   dom_ctl       : control print for the ocean domain
25   !!   domain_cfg    : read the global domain size in domain configuration file
26   !!   cfg_write     : create the domain configuration file
27   !!----------------------------------------------------------------------
28   USE oce            ! ocean variables
29   USE dom_oce        ! domain: ocean
30   USE sbc_oce        ! surface boundary condition: ocean
31   USE trc_oce        ! shared ocean & passive tracers variab
32   USE phycst         ! physical constants
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#if ! defined key_qco
38   USE domvvl         ! variable volume
39#else
40   USE domqco          ! variable volume
41#endif
42   USE c1d            ! 1D configuration
43   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
44   USE wet_dry, ONLY : ll_wd
45   USE closea , ONLY : dom_clo ! closed seas
46   !
47   USE prtctl         ! Print control (prt_ctl_info routine)
48   USE in_out_manager ! I/O manager
49   USE iom            ! I/O library
50   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
51   USE lib_mpp        ! distributed memory computing library
52
53   IMPLICIT NONE
54   PRIVATE
55
56   PUBLIC   dom_init     ! called by nemogcm.F90
57   PUBLIC   domain_cfg   ! called by nemogcm.F90
58   PUBLIC   dom_tile     ! called by step.F90
59
60   !!-------------------------------------------------------------------------
61   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
62   !! $Id$
63   !! Software governed by the CeCILL license (see ./LICENSE)
64   !!-------------------------------------------------------------------------
65CONTAINS
66
67   SUBROUTINE dom_init( Kbb, Kmm, Kaa )
68      !!----------------------------------------------------------------------
69      !!                  ***  ROUTINE dom_init  ***
70      !!                   
71      !! ** Purpose :   Domain initialization. Call the routines that are
72      !!              required to create the arrays which define the space
73      !!              and time domain of the ocean model.
74      !!
75      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
76      !!              - dom_hgr: compute or read the horizontal grid-point position
77      !!                         and scale factors, and the coriolis factor
78      !!              - dom_zgr: define the vertical coordinate and the bathymetry
79      !!              - dom_wri: create the meshmask file (ln_meshmask=T)
80      !!              - 1D configuration, move Coriolis, u and v at T-point
81      !!----------------------------------------------------------------------
82      INTEGER          , INTENT(in) :: Kbb, Kmm, Kaa          ! ocean time level indices
83      !
84      INTEGER ::   ji, jj, jk, jt   ! dummy loop indices
85      INTEGER ::   iconf = 0    ! local integers
86      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
87      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
88      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
89      !!----------------------------------------------------------------------
90      !
91      IF(lwp) THEN         ! Ocean domain Parameters (control print)
92         WRITE(numout,*)
93         WRITE(numout,*) 'dom_init : domain initialization'
94         WRITE(numout,*) '~~~~~~~~'
95         !
96         WRITE(numout,*)     '   Domain info'
97         WRITE(numout,*)     '      dimension of model:'
98         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
99         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
100         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
101         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
102         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
103         WRITE(numout,*)     '      mpp local domain info (mpp):'
104         WRITE(numout,*)     '              jpni    : ', jpni, '   nn_hls  : ', nn_hls
105         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
106         WRITE(numout,*)     '              jpnij   : ', jpnij
107         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
108         SELECT CASE ( jperio )
109         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
110         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
111         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. cyclic north-south)'
112         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
113         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
114         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
115         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
116         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
117         CASE DEFAULT
118            CALL ctl_stop( 'dom_init:   jperio is out of range' )
119         END SELECT
120         WRITE(numout,*)     '      Ocean model configuration used:'
121         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
122      ENDIF
123      nn_wxios = 0
124      ln_xios_read = .FALSE.
125      !
126      !           !==  Reference coordinate system  ==!
127      !
128      CALL dom_glo                            ! global domain versus local domain
129      CALL dom_nam                            ! read namelist ( namrun, namdom )
130      CALL dom_tile( ntsi, ntsj, ntei, ntej ) ! Tile domain
131
132      !
133      CALL dom_hgr                      ! Horizontal mesh
134
135      IF( ln_closea ) CALL dom_clo      ! Read in masks to define closed seas and lakes
136
137      CALL dom_zgr( ik_top, ik_bot )    ! Vertical mesh and bathymetry (return top and bottom ocean t-level indices)
138
139      CALL dom_msk( ik_top, ik_bot )    ! Masks
140      !
141      ht_0(:,:) = 0._wp  ! Reference ocean thickness
142      hu_0(:,:) = 0._wp
143      hv_0(:,:) = 0._wp
144      hf_0(:,:) = 0._wp
145      DO jk = 1, jpk
146         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
147         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
148         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
149         hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * fmask(:,:,jk)
150      END DO
151      !
152      r1_ht_0(:,:) = ssmask (:,:) / ( ht_0(:,:) + 1._wp -  ssmask (:,:) )
153      r1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp -  ssumask(:,:) )
154      r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp -  ssvmask(:,:) )
155      r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp -  ssfmask(:,:) )
156
157      !
158#if defined key_qco
159      !           !==  initialisation of time varying coordinate  ==!   Quasi-Euerian coordinate case
160      !
161      IF( .NOT.l_offline )   CALL dom_qco_init( Kbb, Kmm, Kaa )
162      !
163      IF( ln_linssh )        CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible')
164      !
165#else
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         DO jt = 1, jpt                         ! depth of t- and w-grid-points
171            gdept(:,:,:,jt) = gdept_0(:,:,:)
172            gdepw(:,:,:,jt) = gdepw_0(:,:,:)
173         END DO
174            gde3w(:,:,:)    = gde3w_0(:,:,:)    ! = gdept as the sum of e3t
175         !
176         DO jt = 1, jpt                         ! vertical scale factors
177            e3t(:,:,:,jt) =  e3t_0(:,:,:)
178            e3u(:,:,:,jt) =  e3u_0(:,:,:)
179            e3v(:,:,:,jt) =  e3v_0(:,:,:)
180            e3w(:,:,:,jt) =  e3w_0(:,:,:)
181            e3uw(:,:,:,jt) = e3uw_0(:,:,:)
182            e3vw(:,:,:,jt) = e3vw_0(:,:,:)
183         END DO
184            e3f(:,:,:)    =  e3f_0(:,:,:)
185         !
186         DO jt = 1, jpt                         ! water column thickness and its inverse
187            hu(:,:,jt)    =    hu_0(:,:)
188            hv(:,:,jt)    =    hv_0(:,:)
189            r1_hu(:,:,jt) = r1_hu_0(:,:)
190            r1_hv(:,:,jt) = r1_hv_0(:,:)
191         END DO
192            ht(:,:) =    ht_0(:,:)
193         !
194      ELSE                       != time varying : initialize before/now/after variables
195         !
196         IF( .NOT.l_offline )   CALL dom_vvl_init( Kbb, Kmm, Kaa )
197         !
198      ENDIF
199#endif
200
201      !
202
203      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
204      !
205
206#if defined key_agrif
207      IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa )
208#endif
209      IF( ln_meshmask    )   CALL dom_wri       ! Create a domain file
210      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
211      !
212      IF( ln_write_cfg   )   CALL cfg_write     ! create the configuration file
213      !
214      IF(lwp) THEN
215         WRITE(numout,*)
216         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization'
217         WRITE(numout,*) '~~~~~~~~'
218         WRITE(numout,*) 
219      ENDIF
220      !
221   END SUBROUTINE dom_init
222
223
224   SUBROUTINE dom_glo
225      !!----------------------------------------------------------------------
226      !!                     ***  ROUTINE dom_glo  ***
227      !!
228      !! ** Purpose :   initialization of global domain <--> local domain indices
229      !!
230      !! ** Method  :   
231      !!
232      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices
233      !!              - mig0, mjg0: local  domain indices ==> global domain, excluding halos, indices
234      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
235      !!              - mj0 , mj1   (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
236      !!----------------------------------------------------------------------
237      INTEGER ::   ji, jj   ! dummy loop argument
238      !!----------------------------------------------------------------------
239      !
240      DO ji = 1, jpi                 ! local domain indices ==> global domain indices, including halos
241        mig(ji) = ji + nimpp - 1
242      END DO
243      DO jj = 1, jpj
244        mjg(jj) = jj + njmpp - 1
245      END DO
246      !                              ! local domain indices ==> global domain indices, excluding halos
247      !
248      mig0(:) = mig(:) - nn_hls
249      mjg0(:) = mjg(:) - nn_hls 
250      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,
251      ! we must define mig0 and mjg0 as bellow.
252      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as:
253      mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) )
254      mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) )
255      !
256      !                              ! global domain, including halos, indices ==> local domain indices
257      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
258      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
259      DO ji = 1, jpiglo
260        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
261        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
262      END DO
263      DO jj = 1, jpjglo
264        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
265        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
266      END DO
267      IF(lwp) THEN                   ! control print
268         WRITE(numout,*)
269         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
270         WRITE(numout,*) '~~~~~~~ '
271         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
272         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
273         WRITE(numout,*)
274      ENDIF
275      !
276   END SUBROUTINE dom_glo
277
278
279   SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile )
280      !!----------------------------------------------------------------------
281      !!                     ***  ROUTINE dom_tile  ***
282      !!
283      !! ** Purpose :   Set tile domain variables
284      !!
285      !! ** Action  : - ktsi, ktsj     : start of internal part of domain
286      !!              - ktei, ktej     : end of internal part of domain
287      !!              - ntile          : current tile number
288      !!              - nijtile        : total number of tiles
289      !!----------------------------------------------------------------------
290      INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej      ! Tile domain indices
291      INTEGER, INTENT(in), OPTIONAL :: ktile              ! Tile number
292      INTEGER ::   jt                                     ! dummy loop argument
293      INTEGER ::   iitile, ijtile                         ! Local integers
294      CHARACTER (len=11) ::   charout
295      !!----------------------------------------------------------------------
296      IF( PRESENT(ktile) .AND. ln_tile ) THEN
297         ntile = ktile                 ! Set domain indices for tile
298         ktsi = ntsi_a(ktile)
299         ktsj = ntsj_a(ktile)
300         ktei = ntei_a(ktile)
301         ktej = ntej_a(ktile)
302
303         IF(sn_cfctl%l_prtctl) THEN
304            WRITE(charout, FMT="('ntile =', I4)") ktile
305            CALL prt_ctl_info( charout )
306         ENDIF
307      ELSE
308         ntile = 0                     ! Initialise to full domain
309         nijtile = 1
310         ktsi = Nis0
311         ktsj = Njs0
312         ktei = Nie0
313         ktej = Nje0
314
315         IF( ln_tile ) THEN            ! Calculate tile domain indices
316            iitile = Ni_0 / nn_ltile_i       ! Number of tiles
317            ijtile = Nj_0 / nn_ltile_j
318            IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1
319            IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1
320
321            nijtile = iitile * ijtile
322            ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile) )
323
324            ntsi_a(0) = ktsi                 ! Full domain
325            ntsj_a(0) = ktsj
326            ntei_a(0) = ktei
327            ntej_a(0) = ktej
328
329            DO jt = 1, nijtile               ! Tile domains
330               ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile)
331               ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile)
332               ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0)
333               ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0)
334            ENDDO
335         ENDIF
336
337         IF(lwp) THEN                  ! control print
338            WRITE(numout,*)
339            WRITE(numout,*) 'dom_tile : Domain tiling decomposition'
340            WRITE(numout,*) '~~~~~~~~'
341            IF( ln_tile ) THEN
342               WRITE(numout,*) iitile, 'tiles in i'
343               WRITE(numout,*) '    Starting indices'
344               WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile)
345               WRITE(numout,*) '    Ending indices'
346               WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile)
347               WRITE(numout,*) ijtile, 'tiles in j'
348               WRITE(numout,*) '    Starting indices'
349               WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile)
350               WRITE(numout,*) '    Ending indices'
351               WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile)
352            ELSE
353               WRITE(numout,*) 'No domain tiling'
354               WRITE(numout,*) '    i indices =', ktsi, ':', ktei
355               WRITE(numout,*) '    j indices =', ktsj, ':', ktej
356            ENDIF
357         ENDIF
358      ENDIF
359   END SUBROUTINE dom_tile
360
361
362   SUBROUTINE dom_nam
363      !!----------------------------------------------------------------------
364      !!                     ***  ROUTINE dom_nam  ***
365      !!                   
366      !! ** Purpose :   read domaine namelists and print the variables.
367      !!
368      !! ** input   : - namrun namelist
369      !!              - namdom namelist
370      !!              - namtile namelist
371      !!              - namnc4 namelist   ! "key_netcdf4" only
372      !!----------------------------------------------------------------------
373      USE ioipsl
374      !!
375      INTEGER  ::   ios   ! Local integer
376      !
377      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
378         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
379         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
380         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, ln_1st_euler  , &
381         &             ln_cfmeta, ln_xios_read, nn_wxios
382      NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask
383      NAMELIST/namtile/ ln_tile, nn_ltile_i, nn_ltile_j
384#if defined key_netcdf4
385      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
386#endif
387      !!----------------------------------------------------------------------
388      !
389      IF(lwp) THEN
390         WRITE(numout,*)
391         WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
392         WRITE(numout,*) '~~~~~~~ '
393      ENDIF
394      !
395      !
396      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
397901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist' )
398      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
399902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' )
400      IF(lwm) WRITE ( numond, namrun )
401
402#if defined key_agrif
403      IF( .NOT. Agrif_Root() ) THEN
404            nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1
405            nn_itend =  Agrif_Parent(nn_itend)   *Agrif_IRhot()
406      ENDIF
407#endif
408      !
409      IF(lwp) THEN                  ! control print
410         WRITE(numout,*) '   Namelist : namrun   ---   run parameters'
411         WRITE(numout,*) '      Assimilation cycle              nn_no           = ', nn_no
412         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           )
413         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     )
414         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  )
415         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    )
416         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
417         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
418         WRITE(numout,*) '      start with forward time step    ln_1st_euler    = ', ln_1st_euler
419         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
420         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
421         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend
422         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0
423         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0
424         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy
425         WRITE(numout,*) '      initial state output            nn_istate       = ', nn_istate
426         IF( ln_rst_list ) THEN
427            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist
428         ELSE
429            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock
430         ENDIF
431#if ! defined key_iomput
432         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write
433#endif
434         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland
435         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta
436         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
437         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
438         IF( TRIM(Agrif_CFixed()) == '0' ) THEN
439            WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
440            WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
441         ELSE
442            WRITE(numout,*) "      AGRIF: nn_wxios will be ingored. See setting for parent"
443            WRITE(numout,*) "      AGRIF: ln_xios_read will be ingored. See setting for parent"
444         ENDIF
445      ENDIF
446
447      cexper = cn_exp         ! conversion DOCTOR names into model names (this should disappear soon)
448      nrstdt = nn_rstctl
449      nit000 = nn_it000
450      nitend = nn_itend
451      ndate0 = nn_date0
452      nleapy = nn_leapy
453      ninist = nn_istate
454      l_1st_euler = ln_1st_euler
455      IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN
456         IF(lwp) WRITE(numout,*) 
457         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
458         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. '   
459         l_1st_euler = .true.
460      ENDIF
461      !                             ! control of output frequency
462      IF( .NOT. ln_rst_list ) THEN     ! we use nn_stock
463         IF( nn_stock == -1 )   CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' )
464         IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN
465            WRITE(ctmp1,*) 'nn_stock = ', nn_stock, ' it is forced to ', nitend
466            CALL ctl_warn( ctmp1 )
467            nn_stock = nitend
468         ENDIF
469      ENDIF
470#if ! defined key_iomput
471      IF( nn_write == -1 )   CALL ctl_warn( 'nn_write = -1 --> no output files will be done' )
472      IF ( nn_write == 0 ) THEN
473         WRITE(ctmp1,*) 'nn_write = ', nn_write, ' it is forced to ', nitend
474         CALL ctl_warn( ctmp1 )
475         nn_write = nitend
476      ENDIF
477#endif
478
479      IF( Agrif_Root() ) THEN
480         IF(lwp) WRITE(numout,*)
481         SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
482         CASE (  1 ) 
483            CALL ioconf_calendar('gregorian')
484            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
485         CASE (  0 )
486            CALL ioconf_calendar('noleap')
487            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
488         CASE ( 30 )
489            CALL ioconf_calendar('360d')
490            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
491         END SELECT
492      ENDIF
493
494      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
495903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' )
496      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
497904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' )
498      IF(lwm) WRITE( numond, namdom )
499      !
500#if defined key_agrif
501      IF( .NOT. Agrif_Root() ) THEN
502            rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot()
503      ENDIF
504#endif
505      !
506      IF(lwp) THEN
507         WRITE(numout,*)
508         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
509         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
510         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
511         WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt
512         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp
513         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
514      ENDIF
515      !
516      !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3
517      rDt  = 2._wp * rn_Dt
518      r1_Dt = 1._wp / rDt
519
520      READ  ( numnam_ref, namtile, IOSTAT = ios, ERR = 905 )
521905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtile in reference namelist' )
522      READ  ( numnam_cfg, namtile, IOSTAT = ios, ERR = 906 )
523906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtile in configuration namelist' )
524      IF(lwm) WRITE( numond, namtile )
525
526      IF(lwp) THEN
527         WRITE(numout,*)
528         WRITE(numout,*)    '   Namelist : namtile   ---   Domain tiling decomposition'
529         WRITE(numout,*)    '      Tiling (T) or not (F)                ln_tile    = ', ln_tile
530         WRITE(numout,*)    '      Length of tile in i                  nn_ltile_i = ', nn_ltile_i
531         WRITE(numout,*)    '      Length of tile in j                  nn_ltile_j = ', nn_ltile_j
532         WRITE(numout,*)
533         IF( ln_tile ) THEN
534            WRITE(numout,*) '      The domain will be decomposed into tiles of size', nn_ltile_i, 'x', nn_ltile_j
535         ELSE
536            WRITE(numout,*) '      Domain tiling will NOT be used'
537         ENDIF
538      ENDIF
539
540      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
541         lrxios = ln_xios_read.AND.ln_rstart
542!set output file type for XIOS based on NEMO namelist
543         IF (nn_wxios > 0) lwxios = .TRUE. 
544         nxioso = nn_wxios
545      ENDIF
546
547#if defined key_netcdf4
548      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
549      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
550907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
551      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
552908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
553      IF(lwm) WRITE( numond, namnc4 )
554
555      IF(lwp) THEN                        ! control print
556         WRITE(numout,*)
557         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
558         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i
559         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j
560         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k
561         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip
562      ENDIF
563
564      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
565      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
566      snc4set%ni   = nn_nchunks_i
567      snc4set%nj   = nn_nchunks_j
568      snc4set%nk   = nn_nchunks_k
569      snc4set%luse = ln_nc4zip
570#else
571      snc4set%luse = .FALSE.        ! No NetCDF 4 case
572#endif
573      !
574   END SUBROUTINE dom_nam
575
576
577   SUBROUTINE dom_ctl
578      !!----------------------------------------------------------------------
579      !!                     ***  ROUTINE dom_ctl  ***
580      !!
581      !! ** Purpose :   Domain control.
582      !!
583      !! ** Method  :   compute and print extrema of masked scale factors
584      !!----------------------------------------------------------------------
585      LOGICAL, DIMENSION(jpi,jpj) ::   llmsk
586      INTEGER, DIMENSION(2)       ::   imil, imip, imi1, imi2, imal, imap, ima1, ima2
587      REAL(wp)                    ::   zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max
588      !!----------------------------------------------------------------------
589      !
590      llmsk = tmask_h(:,:) == 1._wp
591      !
592      CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil )
593      CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip )
594      CALL mpp_minloc( 'domain',   e1t(:,:), llmsk, ze1min, imi1 )
595      CALL mpp_minloc( 'domain',   e2t(:,:), llmsk, ze2min, imi2 )
596      CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal )
597      CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap )
598      CALL mpp_maxloc( 'domain',   e1t(:,:), llmsk, ze1max, ima1 )
599      CALL mpp_maxloc( 'domain',   e2t(:,:), llmsk, ze2max, ima2 )
600      !
601      IF(lwp) THEN
602         WRITE(numout,*)
603         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
604         WRITE(numout,*) '~~~~~~~'
605         WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2)
606         WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2)
607         WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2)
608         WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2)
609         WRITE(numout,"(14x,'  e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
610         WRITE(numout,"(14x,'  e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
611         WRITE(numout,"(14x,'  e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
612         WRITE(numout,"(14x,'  e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
613      ENDIF
614      !
615   END SUBROUTINE dom_ctl
616
617
618   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
619      !!----------------------------------------------------------------------
620      !!                     ***  ROUTINE dom_nam  ***
621      !!                   
622      !! ** Purpose :   read the domain size in domain configuration file
623      !!
624      !! ** Method  :   read the cn_domcfg NetCDF file
625      !!----------------------------------------------------------------------
626      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
627      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
628      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
629      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
630      !
631      INTEGER ::   inum   ! local integer
632      REAL(wp) ::   zorca_res                     ! local scalars
633      REAL(wp) ::   zperio                        !   -      -
634      INTEGER, DIMENSION(4) ::   idvar, idimsz    ! size   of dimensions
635      !!----------------------------------------------------------------------
636      !
637      IF(lwp) THEN
638         WRITE(numout,*) '           '
639         WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
640         WRITE(numout,*) '~~~~~~~~~~ '
641      ENDIF
642      !
643      CALL iom_open( cn_domcfg, inum )
644      !
645      !                                   !- ORCA family specificity
646      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
647         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
648         !
649         cd_cfg = 'ORCA'
650         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res )
651         !
652         IF(lwp) THEN
653            WRITE(numout,*) '   .'
654            WRITE(numout,*) '   ==>>>   ORCA configuration '
655            WRITE(numout,*) '   .'
656         ENDIF
657         !
658      ELSE                                !- cd_cfg & k_cfg are not used
659         cd_cfg = 'UNKNOWN'
660         kk_cfg = -9999999
661                                          !- or they may be present as global attributes
662                                          !- (netcdf only) 
663         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
664         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
665         IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
666         IF( kk_cfg == -999     ) kk_cfg = -9999999
667         !
668      ENDIF
669       !
670      idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz )   ! use e3t_0, that must exist, to get jp(ijk)glo
671      kpi = idimsz(1)
672      kpj = idimsz(2)
673      kpk = idimsz(3)
674      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio )
675      CALL iom_close( inum )
676      !
677      IF(lwp) THEN
678         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg
679         WRITE(numout,*) '      Ni0glo = ', kpi
680         WRITE(numout,*) '      Nj0glo = ', kpj
681         WRITE(numout,*) '      jpkglo = ', kpk
682         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio
683      ENDIF
684      !       
685   END SUBROUTINE domain_cfg
686   
687   
688   SUBROUTINE cfg_write
689      !!----------------------------------------------------------------------
690      !!                  ***  ROUTINE cfg_write  ***
691      !!                   
692      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
693      !!              contains all the ocean domain informations required to
694      !!              define an ocean configuration.
695      !!
696      !! ** Method  :   Write in a file all the arrays required to set up an
697      !!              ocean configuration.
698      !!
699      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
700      !!                       mesh, Coriolis parameter, and vertical scale factors
701      !!                    NB: also contain ORCA family information
702      !!----------------------------------------------------------------------
703      INTEGER           ::   ji, jj, jk   ! dummy loop indices
704      INTEGER           ::   inum     ! local units
705      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
706      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
707      !!----------------------------------------------------------------------
708      !
709      IF(lwp) WRITE(numout,*)
710      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
711      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
712      !
713      !                       ! ============================= !
714      !                       !  create 'domcfg_out.nc' file  !
715      !                       ! ============================= !
716      !         
717      clnam = cn_domcfg_out  ! filename (configuration information)
718      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )     
719      !
720      !                             !==  ORCA family specificities  ==!
721      IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN
722         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
723         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
724      ENDIF
725      !
726      !                             !==  domain characteristics  ==!
727      !
728      !                                   ! lateral boundary of the global domain
729      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
730      !
731      !                                   ! type of vertical coordinate
732      CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 )
733      CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 )
734      CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 )
735      !
736      !                                   ! ocean cavities under iceshelves
737      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 )
738      !
739      !                             !==  horizontal mesh  !
740      !
741      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
742      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
743      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
744      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
745      !                               
746      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
747      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
748      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
749      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
750      !                               
751      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
752      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
753      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
754      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
755      !
756      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
757      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
758      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
759      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
760      !
761      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
762      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
763      !
764      !                             !==  vertical mesh  ==!
765      !                                                     
766      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
767      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
768      !
769      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
770      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
771      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
772      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
773      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
774      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
775      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
776      !                                         
777      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
778      !
779      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
780      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
781      !
782      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
783         CALL dom_stiff( z2d )
784         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
785      ENDIF
786      !
787      IF( ll_wd ) THEN              ! wetting and drying domain
788         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
789      ENDIF
790      !
791      ! Add some global attributes ( netcdf only )
792      CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
793      CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
794      !
795      !                                ! ============================
796      !                                !        close the files
797      !                                ! ============================
798      CALL iom_close( inum )
799      !
800   END SUBROUTINE cfg_write
801
802   !!======================================================================
803END MODULE domain
Note: See TracBrowser for help on using the repository browser.