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/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM – NEMO

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domain.F90 @ 13229

Last change on this file since 13229 was 13229, checked in by francesca, 4 years ago

dev_r12558_HPC-08_epico_Extra_Halo: merge with trunk@13218, see #2366
  • Property svn:keywords set to Id
File size: 36.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 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   domain_cfg   ! called by nemogcm.F90
52
53   !!-------------------------------------------------------------------------
54   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
55   !! $Id$
56   !! Software governed by the CeCILL license (see ./LICENSE)
57   !!-------------------------------------------------------------------------
58CONTAINS
59
60   SUBROUTINE dom_init( Kbb, Kmm, Kaa, 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          , INTENT(in) :: Kbb, Kmm, Kaa          ! ocean time level indices
76      CHARACTER (len=*), INTENT(in) :: cdstr                  ! model: NEMO or SAS. Determines core restart variables
77      !
78      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
79      INTEGER ::   iconf = 0    ! local integers
80      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
81      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
82      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
83      !!----------------------------------------------------------------------
84      !
85      IF(lwp) THEN         ! Ocean domain Parameters (control print)
86         WRITE(numout,*)
87         WRITE(numout,*) 'dom_init : domain initialization'
88         WRITE(numout,*) '~~~~~~~~'
89         !
90         WRITE(numout,*)     '   Domain info'
91         WRITE(numout,*)     '      dimension of model:'
92         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
93         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
94         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
95         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
96         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
97         WRITE(numout,*)     '      mpp local domain info (mpp):'
98         WRITE(numout,*)     '              jpni    : ', jpni, '   nn_hls  : ', nn_hls
99         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
100         WRITE(numout,*)     '              jpnij   : ', jpnij
101         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
102         SELECT CASE ( jperio )
103         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
104         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
105         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. cyclic north-south)'
106         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
107         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
108         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
109         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
110         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
111         CASE DEFAULT
112            CALL ctl_stop( 'jperio is out of range' )
113         END SELECT
114         WRITE(numout,*)     '      Ocean model configuration used:'
115         WRITE(numout,*)     '         cn_cfg = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
116      ENDIF
117      lwxios = .FALSE.
118      ln_xios_read = .FALSE.
119      !
120      !           !==  Reference coordinate system  ==!
121      !
122      CALL dom_glo                     ! global domain versus local domain
123      CALL dom_nam                     ! read namelist ( namrun, namdom )
124      !
125      IF( lwxios ) THEN
126!define names for restart write and set core output (restart.F90)
127         CALL iom_set_rst_vars(rst_wfields)
128         CALL iom_set_rstw_core(cdstr)
129      ENDIF
130!reset namelist for SAS
131      IF(cdstr == 'SAS') THEN
132         IF(lrxios) THEN
133               IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'
134               lrxios = .FALSE.
135         ENDIF
136      ENDIF
137      !
138      CALL dom_hgr                      ! Horizontal mesh
139
140      IF( ln_closea ) CALL dom_clo      ! Read in masks to define closed seas and lakes
141
142      CALL dom_zgr( ik_top, ik_bot )    ! Vertical mesh and bathymetry
143
144      CALL dom_msk( ik_top, ik_bot )    ! Masks
145      !
146      ht_0(:,:) = 0._wp  ! Reference ocean thickness
147      hu_0(:,:) = 0._wp
148      hv_0(:,:) = 0._wp
149      DO jk = 1, jpk
150         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
151         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
152         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
153      END DO
154      !
155      !           !==  time varying part of coordinate system  ==!
156      !
157      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
158      !
159         !       before        !          now          !       after         !
160            gdept(:,:,:,Kbb) = gdept_0  ;   gdept(:,:,:,Kmm) = gdept_0   ;   gdept(:,:,:,Kaa) = gdept_0   ! depth of grid-points
161            gdepw(:,:,:,Kbb) = gdepw_0  ;   gdepw(:,:,:,Kmm) = gdepw_0   ;   gdepw(:,:,:,Kaa) = gdepw_0   !
162                                   gde3w = gde3w_0   !        ---          !
163         !                                                                 
164              e3t(:,:,:,Kbb) =   e3t_0  ;     e3t(:,:,:,Kmm) =   e3t_0   ;   e3t(:,:,:,Kaa) =  e3t_0    ! scale factors
165              e3u(:,:,:,Kbb) =   e3u_0  ;     e3u(:,:,:,Kmm) =   e3u_0   ;   e3u(:,:,:,Kaa) =  e3u_0    !
166              e3v(:,:,:,Kbb) =   e3v_0  ;     e3v(:,:,:,Kmm) =   e3v_0   ;   e3v(:,:,:,Kaa) =  e3v_0    !
167                                     e3f =   e3f_0   !        ---          !
168              e3w(:,:,:,Kbb) =   e3w_0  ;     e3w(:,:,:,Kmm) =   e3w_0   ;    e3w(:,:,:,Kaa) =   e3w_0   !
169             e3uw(:,:,:,Kbb) =  e3uw_0  ;    e3uw(:,:,:,Kmm) =  e3uw_0   ;   e3uw(:,:,:,Kaa) =  e3uw_0   ! 
170             e3vw(:,:,:,Kbb) =  e3vw_0  ;    e3vw(:,:,:,Kmm) =  e3vw_0   ;   e3vw(:,:,:,Kaa) =  e3vw_0   !
171         !
172         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
173         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
174         !
175         !        before       !          now          !       after         !
176                                      ht =    ht_0   !                     ! water column thickness
177               hu(:,:,Kbb) =    hu_0  ;      hu(:,:,Kmm) =    hu_0   ;    hu(:,:,Kaa) =    hu_0   !
178               hv(:,:,Kbb) =    hv_0  ;      hv(:,:,Kmm) =    hv_0   ;    hv(:,:,Kaa) =    hv_0   !
179            r1_hu(:,:,Kbb) = z1_hu_0  ;   r1_hu(:,:,Kmm) = z1_hu_0   ; r1_hu(:,:,Kaa) = z1_hu_0   ! inverse of water column thickness
180            r1_hv(:,:,Kbb) = z1_hv_0  ;   r1_hv(:,:,Kmm) = z1_hv_0   ; r1_hv(:,:,Kaa) = z1_hv_0   !
181         !
182         !
183      ELSE                       != time varying : initialize before/now/after variables
184         !
185         IF( .NOT.l_offline )  CALL dom_vvl_init( Kbb, Kmm, Kaa )
186         !
187      ENDIF
188      !
189
190      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
191      !
192
193#if defined key_agrif
194      IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa )
195#endif
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, including halos, indices
220      !!              - mig0, mjg0: local  domain indices ==> global domain, excluding halos, indices
221      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
222      !!              - mj0 , mj1   (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
223      !!----------------------------------------------------------------------
224      INTEGER ::   ji, jj   ! dummy loop argument
225      !!----------------------------------------------------------------------
226      !
227      DO ji = 1, jpi                 ! local domain indices ==> global domain, including halos, indices
228        mig(ji) = ji + nimpp - 1
229      END DO
230      DO jj = 1, jpj
231        mjg(jj) = jj + njmpp - 1
232      END DO
233      !                              ! local domain indices ==> global domain, excluding halos, indices
234      !
235      mig0(:) = mig(:) - nn_hls
236      mjg0(:) = mjg(:) - nn_hls 
237      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,
238      ! we must define mig0 and mjg0 as bellow.
239      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as:
240      mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) )
241      mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) )
242      !
243      !                              ! global domain, including halos, indices ==> local domain indices
244      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
245      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
246      DO ji = 1, jpiglo
247        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
248        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
249      END DO
250      DO jj = 1, jpjglo
251        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
252        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
253      END DO
254      IF(lwp) THEN                   ! control print
255         WRITE(numout,*)
256         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
257         WRITE(numout,*) '~~~~~~~ '
258         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
259         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
260         WRITE(numout,*)
261      ENDIF
262      !
263   END SUBROUTINE dom_glo
264
265
266   SUBROUTINE dom_nam
267      !!----------------------------------------------------------------------
268      !!                     ***  ROUTINE dom_nam  ***
269      !!                   
270      !! ** Purpose :   read domaine namelists and print the variables.
271      !!
272      !! ** input   : - namrun namelist
273      !!              - namdom namelist
274      !!              - namnc4 namelist   ! "key_netcdf4" only
275      !!----------------------------------------------------------------------
276      USE ioipsl
277      !!
278      INTEGER  ::   ios   ! Local integer
279      !
280      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
281         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
282         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
283         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, ln_1st_euler  , &
284         &             ln_cfmeta, ln_xios_read, nn_wxios
285      NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask
286#if defined key_netcdf4
287      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
288#endif
289      !!----------------------------------------------------------------------
290      !
291      IF(lwp) THEN
292         WRITE(numout,*)
293         WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
294         WRITE(numout,*) '~~~~~~~ '
295      ENDIF
296      !
297      !
298      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
299901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist' )
300      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
301902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist' )
302      IF(lwm) WRITE ( numond, namrun )
303
304#if defined key_agrif
305      IF( .NOT. Agrif_Root() ) THEN
306            nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1
307            nn_itend =  Agrif_Parent(nn_itend)   *Agrif_IRhot()
308      ENDIF
309#endif
310      !
311      IF(lwp) THEN                  ! control print
312         WRITE(numout,*) '   Namelist : namrun   ---   run parameters'
313         WRITE(numout,*) '      Assimilation cycle              nn_no           = ', nn_no
314         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           )
315         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     )
316         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  )
317         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    )
318         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
319         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
320         WRITE(numout,*) '      start with forward time step    ln_1st_euler    = ', ln_1st_euler
321         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
322         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
323         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend
324         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0
325         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0
326         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy
327         WRITE(numout,*) '      initial state output            nn_istate       = ', nn_istate
328         IF( ln_rst_list ) THEN
329            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist
330         ELSE
331            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock
332         ENDIF
333#if ! defined key_iomput
334         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write
335#endif
336         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland
337         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta
338         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
339         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
340         IF( TRIM(Agrif_CFixed()) == '0' ) THEN
341            WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
342            WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios
343         ELSE
344            WRITE(numout,*) "      AGRIF: nn_wxios will be ingored. See setting for parent"
345            WRITE(numout,*) "      AGRIF: ln_xios_read will be ingored. See setting for parent"
346         ENDIF
347      ENDIF
348
349      cexper = cn_exp         ! conversion DOCTOR names into model names (this should disappear soon)
350      nrstdt = nn_rstctl
351      nit000 = nn_it000
352      nitend = nn_itend
353      ndate0 = nn_date0
354      nleapy = nn_leapy
355      ninist = nn_istate
356      l_1st_euler = ln_1st_euler
357      IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN
358         IF(lwp) WRITE(numout,*) 
359         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
360         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : l_1st_euler is forced to .true. '   
361         l_1st_euler = .true.
362      ENDIF
363      !                             ! control of output frequency
364      IF( .NOT. ln_rst_list ) THEN     ! we use nn_stock
365         IF( nn_stock == -1 )   CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' )
366         IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN
367            WRITE(ctmp1,*) 'nn_stock = ', nn_stock, ' it is forced to ', nitend
368            CALL ctl_warn( ctmp1 )
369            nn_stock = nitend
370         ENDIF
371      ENDIF
372#if ! defined key_iomput
373      IF( nn_write == -1 )   CALL ctl_warn( 'nn_write = -1 --> no output files will be done' )
374      IF ( nn_write == 0 ) THEN
375         WRITE(ctmp1,*) 'nn_write = ', nn_write, ' it is forced to ', nitend
376         CALL ctl_warn( ctmp1 )
377         nn_write = nitend
378      ENDIF
379#endif
380
381      IF( Agrif_Root() ) THEN
382         IF(lwp) WRITE(numout,*)
383         SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
384         CASE (  1 ) 
385            CALL ioconf_calendar('gregorian')
386            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
387         CASE (  0 )
388            CALL ioconf_calendar('noleap')
389            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
390         CASE ( 30 )
391            CALL ioconf_calendar('360d')
392            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
393         END SELECT
394      ENDIF
395
396      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
397903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist' )
398      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
399904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist' )
400      IF(lwm) WRITE( numond, namdom )
401      !
402#if defined key_agrif
403      IF( .NOT. Agrif_Root() ) THEN
404            rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot()
405      ENDIF
406#endif
407      !
408      IF(lwp) THEN
409         WRITE(numout,*)
410         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
411         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
412         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
413         WRITE(numout,*) '      ocean time step                         rn_Dt       = ', rn_Dt
414         WRITE(numout,*) '      asselin time filter parameter           rn_atfp     = ', rn_atfp
415         WRITE(numout,*) '      online coarsening of dynamical fields   ln_crs      = ', ln_crs
416      ENDIF
417      !
418      !! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3
419      rDt  = 2._wp * rn_Dt
420      r1_Dt = 1._wp / rDt
421
422      IF( TRIM(Agrif_CFixed()) == '0' ) THEN
423         lrxios = ln_xios_read.AND.ln_rstart
424!set output file type for XIOS based on NEMO namelist
425         IF (nn_wxios > 0) lwxios = .TRUE. 
426         nxioso = nn_wxios
427      ENDIF
428
429#if defined key_netcdf4
430      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
431      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
432907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
433      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
434908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
435      IF(lwm) WRITE( numond, namnc4 )
436
437      IF(lwp) THEN                        ! control print
438         WRITE(numout,*)
439         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
440         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i
441         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j
442         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k
443         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip
444      ENDIF
445
446      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
447      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
448      snc4set%ni   = nn_nchunks_i
449      snc4set%nj   = nn_nchunks_j
450      snc4set%nk   = nn_nchunks_k
451      snc4set%luse = ln_nc4zip
452#else
453      snc4set%luse = .FALSE.        ! No NetCDF 4 case
454#endif
455      !
456   END SUBROUTINE dom_nam
457
458
459   SUBROUTINE dom_ctl
460      !!----------------------------------------------------------------------
461      !!                     ***  ROUTINE dom_ctl  ***
462      !!
463      !! ** Purpose :   Domain control.
464      !!
465      !! ** Method  :   compute and print extrema of masked scale factors
466      !!----------------------------------------------------------------------
467      LOGICAL, DIMENSION(jpi,jpj) ::   llmsk
468      INTEGER, DIMENSION(2)       ::   imil, imip, imi1, imi2, imal, imap, ima1, ima2
469      REAL(wp)                    ::   zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max
470      !!----------------------------------------------------------------------
471      !
472      IF(lk_mpp) THEN
473         CALL mpp_minloc( 'domain', glamt(:,:), tmask_i(:,:), zglmin, imil )
474         CALL mpp_minloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmin, imip )
475         CALL mpp_minloc( 'domain',   e1t(:,:), tmask_i(:,:), ze1min, imi1 )
476         CALL mpp_minloc( 'domain',   e2t(:,:), tmask_i(:,:), ze2min, imi2 )
477         CALL mpp_maxloc( 'domain', glamt(:,:), tmask_i(:,:), zglmax, imal )
478         CALL mpp_maxloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmax, imap )
479         CALL mpp_maxloc( 'domain',   e1t(:,:), tmask_i(:,:), ze1max, ima1 )
480         CALL mpp_maxloc( 'domain',   e2t(:,:), tmask_i(:,:), ze2max, ima2 )
481      ELSE
482         llmsk = tmask_i(:,:) == 1._wp
483         zglmin = MINVAL( glamt(:,:), mask = llmsk )   
484         zgpmin = MINVAL( gphit(:,:), mask = llmsk )   
485         ze1min = MINVAL(   e1t(:,:), mask = llmsk )   
486         ze2min = MINVAL(   e2t(:,:), mask = llmsk )   
487         zglmin = MAXVAL( glamt(:,:), mask = llmsk )   
488         zgpmin = MAXVAL( gphit(:,:), mask = llmsk )   
489         ze1max = MAXVAL(   e1t(:,:), mask = llmsk )   
490         ze2max = MAXVAL(   e2t(:,:), mask = llmsk )   
491         !
492         imil   = MINLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
493         imip   = MINLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
494         imi1   = MINLOC(   e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
495         imi2   = MINLOC(   e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
496         imal   = MAXLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
497         imap   = MAXLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
498         ima1   = MAXLOC(   e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
499         ima2   = MAXLOC(   e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
500      ENDIF
501      !
502      IF(lwp) THEN
503         WRITE(numout,*)
504         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
505         WRITE(numout,*) '~~~~~~~'
506         WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2)
507         WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2)
508         WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2)
509         WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2)
510         WRITE(numout,"(14x,'  e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
511         WRITE(numout,"(14x,'  e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
512         WRITE(numout,"(14x,'  e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
513         WRITE(numout,"(14x,'  e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
514      ENDIF
515      !
516   END SUBROUTINE dom_ctl
517
518
519   SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
520      !!----------------------------------------------------------------------
521      !!                     ***  ROUTINE dom_nam  ***
522      !!                   
523      !! ** Purpose :   read the domain size in domain configuration file
524      !!
525      !! ** Method  :   read the cn_domcfg NetCDF file
526      !!----------------------------------------------------------------------
527      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
528      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
529      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
530      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
531      !
532      INTEGER ::   inum   ! local integer
533      REAL(wp) ::   zorca_res                     ! local scalars
534      REAL(wp) ::   zperio                        !   -      -
535      INTEGER, DIMENSION(4) ::   idvar, idimsz    ! size   of dimensions
536      !!----------------------------------------------------------------------
537      !
538      IF(lwp) THEN
539         WRITE(numout,*) '           '
540         WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
541         WRITE(numout,*) '~~~~~~~~~~ '
542      ENDIF
543      !
544      CALL iom_open( cn_domcfg, inum )
545      !
546      !                                   !- ORCA family specificity
547      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
548         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
549         !
550         cd_cfg = 'ORCA'
551         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = NINT( zorca_res )
552         !
553         IF(lwp) THEN
554            WRITE(numout,*) '   .'
555            WRITE(numout,*) '   ==>>>   ORCA configuration '
556            WRITE(numout,*) '   .'
557         ENDIF
558         !
559      ELSE                                !- cd_cfg & k_cfg are not used
560         cd_cfg = 'UNKNOWN'
561         kk_cfg = -9999999
562                                          !- or they may be present as global attributes
563                                          !- (netcdf only) 
564         CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
565         CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
566         IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
567         IF( kk_cfg == -999     ) kk_cfg = -9999999
568         !
569      ENDIF
570       !
571      idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz )   ! use e3t_0, that must exist, to get jp(ijk)glo
572      kpi = idimsz(1)
573      kpj = idimsz(2)
574      kpk = idimsz(3)
575      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = NINT( zperio )
576      CALL iom_close( inum )
577      !
578      IF(lwp) THEN
579         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg
580         WRITE(numout,*) '      Ni0glo = ', kpi
581         WRITE(numout,*) '      Nj0glo = ', kpj
582         WRITE(numout,*) '      jpkglo = ', kpk
583         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio
584      ENDIF
585      !       
586   END SUBROUTINE domain_cfg
587   
588   
589   SUBROUTINE cfg_write
590      !!----------------------------------------------------------------------
591      !!                  ***  ROUTINE cfg_write  ***
592      !!                   
593      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
594      !!              contains all the ocean domain informations required to
595      !!              define an ocean configuration.
596      !!
597      !! ** Method  :   Write in a file all the arrays required to set up an
598      !!              ocean configuration.
599      !!
600      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
601      !!                       mesh, Coriolis parameter, and vertical scale factors
602      !!                    NB: also contain ORCA family information
603      !!----------------------------------------------------------------------
604      INTEGER           ::   ji, jj, jk   ! dummy loop indices
605      INTEGER           ::   inum     ! local units
606      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
607      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
608      !!----------------------------------------------------------------------
609      !
610      IF(lwp) WRITE(numout,*)
611      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
612      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
613      !
614      !                       ! ============================= !
615      !                       !  create 'domcfg_out.nc' file  !
616      !                       ! ============================= !
617      !         
618      clnam = cn_domcfg_out  ! filename (configuration information)
619      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )     
620      !
621      !                             !==  ORCA family specificities  ==!
622      IF( cn_cfg == "ORCA" ) THEN
623         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
624         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
625      ENDIF
626      !
627      !                             !==  domain characteristics  ==!
628      !
629      !                                   ! lateral boundary of the global domain
630      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
631      !
632      !                                   ! type of vertical coordinate
633      CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 )
634      CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 )
635      CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 )
636      !
637      !                                   ! ocean cavities under iceshelves
638      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 )
639      !
640      !                             !==  horizontal mesh  !
641      !
642      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
643      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
644      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
645      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
646      !                               
647      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
648      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
649      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
650      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
651      !                               
652      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
653      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
654      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
655      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
656      !
657      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
658      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
659      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
660      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
661      !
662      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
663      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
664      !
665      !                             !==  vertical mesh  ==!
666      !                                                     
667      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
668      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
669      !
670      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
671      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
672      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
673      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
674      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
675      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
676      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
677      !                                         
678      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
679      !
680      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
681      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
682      !
683      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
684         CALL dom_stiff( z2d )
685         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
686      ENDIF
687      !
688      IF( ll_wd ) THEN              ! wetting and drying domain
689         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
690      ENDIF
691      !
692      ! Add some global attributes ( netcdf only )
693      CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
694      CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
695      !
696      !                                ! ============================
697      !                                !        close the files
698      !                                ! ============================
699      CALL iom_close( inum )
700      !
701   END SUBROUTINE cfg_write
702
703   !!======================================================================
704END MODULE domain
Note: See TracBrowser for help on using the repository browser.