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/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/DOM – NEMO

source: NEMO/branches/UKMO/dev_r12745_HPC-02_Daley_Tiling_trial_public/src/OCE/DOM/domain.F90 @ 12765

Last change on this file since 12765 was 12765, checked in by hadcv, 4 years ago

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