New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
domain.F90 in branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 9168

Last change on this file since 9168 was 9168, checked in by gm, 6 years ago

dev_merge_2017: OPA_SRC & CONFIG: remove useless warning when reading namelist_cfg

  • Property svn:keywords set to Id
File size: 35.8 KB
Line 
1MODULE domain
2   !!==============================================================================
3   !!                       ***  MODULE domain   ***
4   !! Ocean initialization : domain initialization
5   !!==============================================================================
6   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
7   !!                 !  1992-01  (M. Imbard) insert time step initialization
8   !!                 !  1996-06  (G. Madec) generalized vertical coordinate
9   !!                 !  1997-02  (G. Madec) creation of domwri.F
10   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
11   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
12   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
13   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
14   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
15   !!            3.7  !  2015-11  (G. Madec, A. Coward)  time varying zgr by default
16   !!            4.0  !  2016-10  (G. Madec, S. Flavoni)  domain configuration / user defined interface
17   !!----------------------------------------------------------------------
18   
19   !!----------------------------------------------------------------------
20   !!   dom_init      : initialize the space and time domain
21   !!   dom_glo       : initialize global domain <--> local domain indices
22   !!   dom_nam       : read and contral domain namelists
23   !!   dom_ctl       : control print for the ocean domain
24   !!   domain_cfg    : read the global domain size in domain configuration file
25   !!   cfg_write     : create the domain configuration file
26   !!----------------------------------------------------------------------
27   USE oce            ! ocean variables
28   USE dom_oce        ! domain: ocean
29   USE sbc_oce        ! surface boundary condition: ocean
30   USE trc_oce        ! shared ocean & passive tracers variab
31   USE phycst         ! physical constants
32   USE closea         ! closed seas
33   USE domhgr         ! domain: set the horizontal mesh
34   USE domzgr         ! domain: set the vertical mesh
35   USE dommsk         ! domain: set the mask system
36   USE domwri         ! domain: write the meshmask file
37   USE domvvl         ! variable volume
38   USE c1d            ! 1D configuration
39   USE dyncor_c1d     ! 1D configuration: Coriolis term    (cor_c1d routine)
40   USE wet_dry,  ONLY : ll_wd
41   !
42   USE in_out_manager ! I/O manager
43   USE iom            ! I/O library
44   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
45   USE lib_mpp        ! distributed memory computing library
46
47   IMPLICIT NONE
48   PRIVATE
49
50   PUBLIC   dom_init     ! called by nemogcm.F90
51   PUBLIC   domain_cfg   ! called by nemogcm.F90
52
53   !!-------------------------------------------------------------------------
54   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
55   !! $Id$
56   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
57   !!-------------------------------------------------------------------------
58CONTAINS
59
60   SUBROUTINE dom_init
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 if nn_msh=1
73      !!              - 1D configuration, move Coriolis, u and v at T-point
74      !!----------------------------------------------------------------------
75      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
76      INTEGER ::   iconf = 0    ! local integers
77      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
78      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
79      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
80      !!----------------------------------------------------------------------
81      !
82      IF(lwp) THEN         ! Ocean domain Parameters (control print)
83         WRITE(numout,*)
84         WRITE(numout,*) 'dom_init : domain initialization'
85         WRITE(numout,*) '~~~~~~~~'
86         !
87         WRITE(numout,*)     '   Domain info'
88         WRITE(numout,*)     '      dimension of model:'
89         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
90         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
91         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
92         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
93         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
94         WRITE(numout,*)     '      mpp local domain info (mpp):'
95         WRITE(numout,*)     '              jpni    : ', jpni, '   nn_hls  : ', nn_hls
96         WRITE(numout,*)     '              jpnj    : ', jpnj, '   nn_hls  : ', nn_hls
97         WRITE(numout,*)     '              jpnij   : ', jpnij
98         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
99         SELECT CASE ( jperio )
100         CASE( 0 )   ;   WRITE(numout,*) '         (i.e. closed)'
101         CASE( 1 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west)'
102         CASE( 2 )   ;   WRITE(numout,*) '         (i.e. equatorial symmetric)'
103         CASE( 3 )   ;   WRITE(numout,*) '         (i.e. north fold with T-point pivot)'
104         CASE( 4 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with T-point pivot)'
105         CASE( 5 )   ;   WRITE(numout,*) '         (i.e. north fold with F-point pivot)'
106         CASE( 6 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north fold with F-point pivot)'
107         CASE( 7 )   ;   WRITE(numout,*) '         (i.e. cyclic east-west and north-south)'
108         CASE DEFAULT
109            CALL ctl_stop( 'jperio is out of range' )
110         END SELECT
111         WRITE(numout,*)     '      Ocean model configuration used:'
112         WRITE(numout,*)     '              cn_cfg = ', cn_cfg
113         WRITE(numout,*)     '              nn_cfg = ', nn_cfg
114      ENDIF
115      !
116      !           !==  Reference coordinate system  ==!
117      !
118      CALL dom_glo                     ! global domain versus local domain
119      CALL dom_nam                     ! read namelist ( namrun, namdom )
120      CALL dom_hgr                     ! Horizontal mesh
121      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
122      CALL dom_msk( ik_top, ik_bot )   ! Masks
123      IF( ln_closea ) CALL dom_clo     ! ln_closea=T : closed seas included in the simulation
124                                       ! Read in masks to define closed seas and lakes
125      !
126      DO jj = 1, jpj                   ! depth of the iceshelves
127         DO ji = 1, jpi
128            ik = mikt(ji,jj)
129            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
130         END DO
131      END DO
132      !
133      ht_0(:,:) = 0._wp  ! Reference ocean thickness
134      hu_0(:,:) = 0._wp
135      hv_0(:,:) = 0._wp
136      DO jk = 1, jpk
137         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
138         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
139         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
140      END DO
141      !
142      !           !==  time varying part of coordinate system  ==!
143      !
144      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
145      !
146         !       before        !          now          !       after         !
147            gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
148            gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
149                                   gde3w_n = gde3w_0   !        ---          !
150         !                                                                 
151              e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
152              e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
153              e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
154                                     e3f_n =   e3f_0   !        ---          !
155              e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
156             e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
157             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
158         !
159         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
160         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
161         !
162         !        before       !          now          !       after         !
163                                      ht_n =    ht_0   !                     ! water column thickness
164               hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !
165               hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
166            r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
167            r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
168         !
169         !
170      ELSE                       != time varying : initialize before/now/after variables
171         !
172         IF( .NOT.l_offline )  CALL dom_vvl_init 
173         !
174      ENDIF
175      !
176      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
177      !
178      IF( nn_msh > 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file
179      IF( nn_msh > 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file
180      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
181      !
182     
183      IF(lwp) THEN
184         WRITE(numout,*)
185         WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh
186         WRITE(numout,*) 
187      ENDIF
188      !
189      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file
190      !
191   END SUBROUTINE dom_init
192
193
194   SUBROUTINE dom_glo
195      !!----------------------------------------------------------------------
196      !!                     ***  ROUTINE dom_glo  ***
197      !!
198      !! ** Purpose :   initialization of global domain <--> local domain indices
199      !!
200      !! ** Method  :   
201      !!
202      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
203      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
204      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
205      !!----------------------------------------------------------------------
206      INTEGER ::   ji, jj   ! dummy loop argument
207      !!----------------------------------------------------------------------
208      !
209      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
210        mig(ji) = ji + nimpp - 1
211      END DO
212      DO jj = 1, jpj
213        mjg(jj) = jj + njmpp - 1
214      END DO
215      !                              ! global domain indices ==> local domain indices
216      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
217      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
218      DO ji = 1, jpiglo
219        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
220        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
221      END DO
222      DO jj = 1, jpjglo
223        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
224        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
225      END DO
226      IF(lwp) THEN                   ! control print
227         WRITE(numout,*)
228         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
229         WRITE(numout,*) '~~~~~~~ '
230         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
231         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
232         WRITE(numout,*)
233         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
234         IF( nn_print >= 1 ) THEN
235            WRITE(numout,*)
236            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
237            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
238            WRITE(numout,*)
239            WRITE(numout,*) '          conversion global ==> local  i-index domain'
240            WRITE(numout,*) '             starting index (mi0)'
241            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
242            WRITE(numout,*) '             ending index (mi1)'
243            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
244            WRITE(numout,*)
245            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
246            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
247            WRITE(numout,*)
248            WRITE(numout,*) '          conversion global ==> local  j-index domain'
249            WRITE(numout,*) '             starting index (mj0)'
250            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
251            WRITE(numout,*) '             ending index (mj1)'
252            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
253         ENDIF
254      ENDIF
255 25   FORMAT( 100(10x,19i4,/) )
256      !
257   END SUBROUTINE dom_glo
258
259
260   SUBROUTINE dom_nam
261      !!----------------------------------------------------------------------
262      !!                     ***  ROUTINE dom_nam  ***
263      !!                   
264      !! ** Purpose :   read domaine namelists and print the variables.
265      !!
266      !! ** input   : - namrun namelist
267      !!              - namdom namelist
268      !!              - namnc4 namelist   ! "key_netcdf4" only
269      !!----------------------------------------------------------------------
270      USE ioipsl
271      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
272         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
273         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
274         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
275         &             ln_cfmeta, ln_iscpl
276      NAMELIST/namdom/ ln_linssh, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs
277#if defined key_netcdf4
278      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
279#endif
280      INTEGER  ::   ios                 ! Local integer output status for namelist read
281      !!----------------------------------------------------------------------
282      !
283      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
284      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
285901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
286      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
287      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
288902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
289      IF(lwm) WRITE ( numond, namrun )
290      !
291      IF(lwp) THEN                  ! control print
292         WRITE(numout,*)
293         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
294         WRITE(numout,*) '~~~~~~~ '
295         WRITE(numout,*) '   Namelist namrun'
296         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
297         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
298         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
299         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
300         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
301         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
302         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
303         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
304         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
305         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
306         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
307         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
308         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
309         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
310         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
311         IF( ln_rst_list ) THEN
312            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
313         ELSE
314            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
315         ENDIF
316         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
317         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
318         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
319         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
320         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
321         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
322      ENDIF
323
324      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
325      cexper = cn_exp
326      nrstdt = nn_rstctl
327      nit000 = nn_it000
328      nitend = nn_itend
329      ndate0 = nn_date0
330      nleapy = nn_leapy
331      ninist = nn_istate
332      nstock = nn_stock
333      nstocklist = nn_stocklist
334      nwrite = nn_write
335      neuler = nn_euler
336      IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN
337         IF(lwp) WRITE(numout,*) 
338         IF(lwp) WRITE(numout,*)'   Start from rest (ln_rstart=F) ==>>> an Euler initial time step is used,'
339         IF(lwp) WRITE(numout,*)'                                       nn_euler is forced to 0 '   
340         neuler = 0
341      ENDIF
342      !                             ! control of output frequency
343      IF ( nstock == 0 .OR. nstock > nitend ) THEN
344         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
345         CALL ctl_warn( ctmp1 )
346         nstock = nitend
347      ENDIF
348      IF ( nwrite == 0 ) THEN
349         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
350         CALL ctl_warn( ctmp1 )
351         nwrite = nitend
352      ENDIF
353
354#if defined key_agrif
355      IF( Agrif_Root() ) THEN
356#endif
357      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
358      CASE (  1 ) 
359         CALL ioconf_calendar('gregorian')
360         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
361      CASE (  0 )
362         CALL ioconf_calendar('noleap')
363         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
364      CASE ( 30 )
365         CALL ioconf_calendar('360d')
366         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
367      END SELECT
368#if defined key_agrif
369      ENDIF
370#endif
371
372      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
373      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
374903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
375      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
376      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
377904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
378      IF(lwm) WRITE ( numond, namdom )
379      !
380      IF(lwp) THEN
381         WRITE(numout,*)
382         WRITE(numout,*) '   Namelist namdom : space & time domain'
383         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh
384         WRITE(numout,*) '      create mesh/mask file(s)              nn_msh     = ', nn_msh
385         WRITE(numout,*) '           = 0   no file created           '
386         WRITE(numout,*) '           = 1   mesh_mask                 '
387         WRITE(numout,*) '           = 2   mesh and mask             '
388         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
389         WRITE(numout,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)'
390         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt
391         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp
392         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs
393      ENDIF
394     
395      call flush( numout )
396      !
397!     !          ! conversion DOCTOR names into model names (this should disappear soon)
398      atfp      = rn_atfp
399      rdt       = rn_rdt
400
401#if defined key_netcdf4
402      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
403      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
404      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
405907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
406      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
407      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
408908   IF( ios >  0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
409      IF(lwm) WRITE( numond, namnc4 )
410
411      IF(lwp) THEN                        ! control print
412         WRITE(numout,*)
413         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
414         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
415         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
416         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
417         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
418      ENDIF
419
420      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
421      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
422      snc4set%ni   = nn_nchunks_i
423      snc4set%nj   = nn_nchunks_j
424      snc4set%nk   = nn_nchunks_k
425      snc4set%luse = ln_nc4zip
426#else
427      snc4set%luse = .FALSE.        ! No NetCDF 4 case
428#endif
429      !
430   END SUBROUTINE dom_nam
431
432
433   SUBROUTINE dom_ctl
434      !!----------------------------------------------------------------------
435      !!                     ***  ROUTINE dom_ctl  ***
436      !!
437      !! ** Purpose :   Domain control.
438      !!
439      !! ** Method  :   compute and print extrema of masked scale factors
440      !!----------------------------------------------------------------------
441      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
442      INTEGER, DIMENSION(2) ::   iloc   !
443      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
444      !!----------------------------------------------------------------------
445      !
446      IF(lk_mpp) THEN
447         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
448         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
449         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
450         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
451      ELSE
452         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
453         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
454         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
455         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
456         !
457         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
458         iimi1 = iloc(1) + nimpp - 1
459         ijmi1 = iloc(2) + njmpp - 1
460         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
461         iimi2 = iloc(1) + nimpp - 1
462         ijmi2 = iloc(2) + njmpp - 1
463         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
464         iima1 = iloc(1) + nimpp - 1
465         ijma1 = iloc(2) + njmpp - 1
466         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
467         iima2 = iloc(1) + nimpp - 1
468         ijma2 = iloc(2) + njmpp - 1
469      ENDIF
470      IF(lwp) THEN
471         WRITE(numout,*)
472         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
473         WRITE(numout,*) '~~~~~~~'
474         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
475         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
476         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
477         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
478      ENDIF
479      !
480   END SUBROUTINE dom_ctl
481
482
483   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
484      !!----------------------------------------------------------------------
485      !!                     ***  ROUTINE dom_nam  ***
486      !!                   
487      !! ** Purpose :   read the domain size in domain configuration file
488      !!
489      !! ** Method  :   
490      !!
491      !!----------------------------------------------------------------------
492      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
493      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
494      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
495      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
496      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
497      !
498      INTEGER ::   inum, ii   ! local integer
499      REAL(wp) ::   zorca_res                     ! local scalars
500      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
501      !!----------------------------------------------------------------------
502      !
503      ii = 1
504      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
505      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'   ;   ii = ii+1
506      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
507      !
508      CALL iom_open( cn_domcfg, inum )
509      !
510      !                                   !- ORCA family specificity
511      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
512         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
513         !
514         cd_cfg = 'ORCA'
515         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res )
516         !
517         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
518         WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                         ;   ii = ii+1
519         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
520         !
521      ELSE                                !- cd_cfg & k_cfg are not used
522         cd_cfg = 'UNKNOWN'
523         kk_cfg = -9999999
524                                          !- or they may be present as global attributes
525                                          !- (netcdf only) 
526         IF( iom_file(inum)%iolib == jpnf90 ) THEN
527            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
528            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
529            IF( TRIM(cd_cfg) .EQ. '!') cd_cfg = 'UNKNOWN'
530            IF( kk_cfg .EQ. -999     ) kk_cfg = -9999999
531         ENDIF
532         !
533      ENDIF
534      !
535      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo )
536      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo )
537      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo )
538      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio )
539      CALL iom_close( inum )
540      !
541      WRITE(ldtxt(ii),*) '   cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
542      WRITE(ldtxt(ii),*) '   jpiglo = ', kpi                                              ;   ii = ii+1
543      WRITE(ldtxt(ii),*) '   jpjglo = ', kpj                                              ;   ii = ii+1
544      WRITE(ldtxt(ii),*) '   jpkglo = ', kpk                                              ;   ii = ii+1
545      WRITE(ldtxt(ii),*) '   type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
546      !       
547   END SUBROUTINE domain_cfg
548   
549   
550   SUBROUTINE cfg_write
551      !!----------------------------------------------------------------------
552      !!                  ***  ROUTINE cfg_write  ***
553      !!                   
554      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
555      !!              contains all the ocean domain informations required to
556      !!              define an ocean configuration.
557      !!
558      !! ** Method  :   Write in a file all the arrays required to set up an
559      !!              ocean configuration.
560      !!
561      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
562      !!                       mesh, Coriolis parameter, and vertical scale factors
563      !!                    NB: also contain ORCA family information
564      !!----------------------------------------------------------------------
565      INTEGER           ::   ji, jj, jk   ! dummy loop indices
566      INTEGER           ::   izco, izps, isco, icav
567      INTEGER           ::   inum     ! local units
568      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
569      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
570      !!----------------------------------------------------------------------
571      !
572      IF(lwp) WRITE(numout,*)
573      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
574      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
575      !
576      !                       ! ============================= !
577      !                       !  create 'domcfg_out.nc' file  !
578      !                       ! ============================= !
579      !         
580      clnam = cn_domcfg_out  ! filename (configuration information)
581      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
582     
583      !
584      !                             !==  ORCA family specificities  ==!
585      IF( cn_cfg == "ORCA" ) THEN
586         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
587         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
588      ENDIF
589      !
590      !                             !==  global domain size  ==!
591      !
592      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
593      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
594      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
595      !
596      !                             !==  domain characteristics  ==!
597      !
598      !                                   ! lateral boundary of the global domain
599      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
600      !
601      !                                   ! type of vertical coordinate
602      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
603      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
604      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
605      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
606      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
607      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
608      !
609      !                                   ! ocean cavities under iceshelves
610      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
611      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
612      !
613      !                             !==  horizontal mesh  !
614      !
615      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
616      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
617      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
618      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
619      !                               
620      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
621      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
622      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
623      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
624      !                               
625      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
626      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
627      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
628      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
629      !
630      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
631      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
632      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
633      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
634      !
635      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
636      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
637      !
638      !                             !==  vertical mesh  ==!
639      !                                                     
640      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
641      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
642      !
643      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
644      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
645      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
646      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
647      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
648      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
649      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
650      !                                         
651      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
652      !
653      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
654      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
655      !
656      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
657         CALL dom_stiff( z2d )
658         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
659      ENDIF
660      !
661      IF( ll_wd ) THEN              ! wetting and drying domain
662         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
663      ENDIF
664      !
665      ! Add some global attributes ( netcdf only )
666      IF( iom_file(inum)%iolib == jpnf90 ) THEN
667         CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
668         CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
669      ENDIF
670      !
671      !                                ! ============================
672      !                                !        close the files
673      !                                ! ============================
674      CALL iom_close( inum )
675      !
676   END SUBROUTINE cfg_write
677
678   !!======================================================================
679END MODULE domain
Note: See TracBrowser for help on using the repository browser.