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 @ 9161

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

Reformulation of closea module.
See ticket #2000
https://forge.ipsl.jussieu.fr/nemo/wiki/2017WP/ROBUST-14_Dave_Storkey-Closed_Seas_rewrite
  • Property svn:keywords set to Id
File size: 35.7 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      !
287      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
288      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
289902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
290      IF(lwm) WRITE ( numond, namrun )
291      !
292      IF(lwp) THEN                  ! control print
293         WRITE(numout,*)
294         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
295         WRITE(numout,*) '~~~~~~~ '
296         WRITE(numout,*) '   Namelist namrun'
297         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
298         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
299         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
300         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
301         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
302         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
303         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
304         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
305         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
306         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
307         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
308         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
309         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
310         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
311         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
312         IF( ln_rst_list ) THEN
313            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
314         ELSE
315            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
316         ENDIF
317         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
318         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
319         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
320         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
321         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
322         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
323      ENDIF
324
325      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
326      cexper = cn_exp
327      nrstdt = nn_rstctl
328      nit000 = nn_it000
329      nitend = nn_itend
330      ndate0 = nn_date0
331      nleapy = nn_leapy
332      ninist = nn_istate
333      nstock = nn_stock
334      nstocklist = nn_stocklist
335      nwrite = nn_write
336      neuler = nn_euler
337      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
338         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
339         CALL ctl_warn( ctmp1 )
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      !
376      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
377      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
378904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
379      IF(lwm) WRITE ( numond, namdom )
380      !
381      IF(lwp) THEN
382         WRITE(numout,*)
383         WRITE(numout,*) '   Namelist namdom : space & time domain'
384         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh
385         WRITE(numout,*) '      create mesh/mask file(s)              nn_msh     = ', nn_msh
386         WRITE(numout,*) '           = 0   no file created           '
387         WRITE(numout,*) '           = 1   mesh_mask                 '
388         WRITE(numout,*) '           = 2   mesh and mask             '
389         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
390         WRITE(numout,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)'
391         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt
392         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp
393         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs
394      ENDIF
395     
396      call flush( numout )
397      !
398!     !          ! conversion DOCTOR names into model names (this should disappear soon)
399      atfp      = rn_atfp
400      rdt       = rn_rdt
401
402#if defined key_netcdf4
403      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
404      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
405      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
406907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
407      !
408      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
409      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
410908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
411      IF(lwm) WRITE( numond, namnc4 )
412
413      IF(lwp) THEN                        ! control print
414         WRITE(numout,*)
415         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
416         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
417         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
418         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
419         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
420      ENDIF
421
422      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
423      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
424      snc4set%ni   = nn_nchunks_i
425      snc4set%nj   = nn_nchunks_j
426      snc4set%nk   = nn_nchunks_k
427      snc4set%luse = ln_nc4zip
428#else
429      snc4set%luse = .FALSE.        ! No NetCDF 4 case
430#endif
431      !
432   END SUBROUTINE dom_nam
433
434
435   SUBROUTINE dom_ctl
436      !!----------------------------------------------------------------------
437      !!                     ***  ROUTINE dom_ctl  ***
438      !!
439      !! ** Purpose :   Domain control.
440      !!
441      !! ** Method  :   compute and print extrema of masked scale factors
442      !!----------------------------------------------------------------------
443      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
444      INTEGER, DIMENSION(2) ::   iloc   !
445      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
446      !!----------------------------------------------------------------------
447      !
448      IF(lk_mpp) THEN
449         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
450         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
451         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
452         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
453      ELSE
454         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
455         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
456         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
457         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
458         !
459         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
460         iimi1 = iloc(1) + nimpp - 1
461         ijmi1 = iloc(2) + njmpp - 1
462         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
463         iimi2 = iloc(1) + nimpp - 1
464         ijmi2 = iloc(2) + njmpp - 1
465         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
466         iima1 = iloc(1) + nimpp - 1
467         ijma1 = iloc(2) + njmpp - 1
468         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
469         iima2 = iloc(1) + nimpp - 1
470         ijma2 = iloc(2) + njmpp - 1
471      ENDIF
472      IF(lwp) THEN
473         WRITE(numout,*)
474         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
475         WRITE(numout,*) '~~~~~~~'
476         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
477         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
478         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
479         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
480      ENDIF
481      !
482   END SUBROUTINE dom_ctl
483
484
485   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
486      !!----------------------------------------------------------------------
487      !!                     ***  ROUTINE dom_nam  ***
488      !!                   
489      !! ** Purpose :   read the domain size in domain configuration file
490      !!
491      !! ** Method  :   
492      !!
493      !!----------------------------------------------------------------------
494      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
495      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
496      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
497      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
498      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
499      !
500      INTEGER ::   inum, ii   ! local integer
501      REAL(wp) ::   zorca_res                     ! local scalars
502      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
503      !!----------------------------------------------------------------------
504      !
505      ii = 1
506      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
507      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'   ;   ii = ii+1
508      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
509      !
510      CALL iom_open( cn_domcfg, inum )
511      !
512      !                                   !- ORCA family specificity
513      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
514         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
515         !
516         cd_cfg = 'ORCA'
517         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res )
518         !
519         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
520         WRITE(ldtxt(ii),*) '       ==>>>   ORCA configuration '                         ;   ii = ii+1
521         WRITE(ldtxt(ii),*) '       '                                                    ;   ii = ii+1
522         !
523      ELSE                                !- cd_cfg & k_cfg are not used
524         cd_cfg = 'UNKNOWN'
525         kk_cfg = -9999999
526                                          !- or they may be present as global attributes
527                                          !- (netcdf only) 
528         IF( iom_file(inum)%iolib == jpnf90 ) THEN
529            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
530            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
531            IF( TRIM(cd_cfg) .EQ. '!') cd_cfg = 'UNKNOWN'
532            IF( kk_cfg .EQ. -999     ) kk_cfg = -9999999
533         ENDIF
534         !
535      ENDIF
536      !
537      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo )
538      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo )
539      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo )
540      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio )
541      CALL iom_close( inum )
542      !
543      WRITE(ldtxt(ii),*) '   cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
544      WRITE(ldtxt(ii),*) '   jpiglo = ', kpi                                              ;   ii = ii+1
545      WRITE(ldtxt(ii),*) '   jpjglo = ', kpj                                              ;   ii = ii+1
546      WRITE(ldtxt(ii),*) '   jpkglo = ', kpk                                              ;   ii = ii+1
547      WRITE(ldtxt(ii),*) '   type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
548      !       
549   END SUBROUTINE domain_cfg
550   
551   
552   SUBROUTINE cfg_write
553      !!----------------------------------------------------------------------
554      !!                  ***  ROUTINE cfg_write  ***
555      !!                   
556      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
557      !!              contains all the ocean domain informations required to
558      !!              define an ocean configuration.
559      !!
560      !! ** Method  :   Write in a file all the arrays required to set up an
561      !!              ocean configuration.
562      !!
563      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
564      !!                       mesh, Coriolis parameter, and vertical scale factors
565      !!                    NB: also contain ORCA family information
566      !!----------------------------------------------------------------------
567      INTEGER           ::   ji, jj, jk   ! dummy loop indices
568      INTEGER           ::   izco, izps, isco, icav
569      INTEGER           ::   inum     ! local units
570      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
571      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
572      !!----------------------------------------------------------------------
573      !
574      IF(lwp) WRITE(numout,*)
575      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
576      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
577      !
578      !                       ! ============================= !
579      !                       !  create 'domcfg_out.nc' file  !
580      !                       ! ============================= !
581      !         
582      clnam = cn_domcfg_out  ! filename (configuration information)
583      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
584     
585      !
586      !                             !==  ORCA family specificities  ==!
587      IF( cn_cfg == "ORCA" ) THEN
588         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
589         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
590      ENDIF
591      !
592      !                             !==  global domain size  ==!
593      !
594      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
595      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
596      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
597      !
598      !                             !==  domain characteristics  ==!
599      !
600      !                                   ! lateral boundary of the global domain
601      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
602      !
603      !                                   ! type of vertical coordinate
604      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
605      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
606      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
607      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
608      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
609      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
610      !
611      !                                   ! ocean cavities under iceshelves
612      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
613      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
614      !
615      !                             !==  horizontal mesh  !
616      !
617      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
618      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
619      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
620      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
621      !                               
622      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
623      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
624      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
625      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
626      !                               
627      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
628      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
629      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
630      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
631      !
632      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
633      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
634      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
635      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
636      !
637      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
638      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
639      !
640      !                             !==  vertical mesh  ==!
641      !                                                     
642      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
643      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
644      !
645      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
646      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
647      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
648      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
649      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
650      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
651      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
652      !                                         
653      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
654      !
655      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
656      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
657      !
658      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
659         CALL dom_stiff( z2d )
660         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
661      ENDIF
662      !
663      IF( ll_wd ) THEN              ! wetting and drying domain
664         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
665      ENDIF
666      !
667      ! Add some global attributes ( netcdf only )
668      IF( iom_file(inum)%iolib == jpnf90 ) THEN
669         CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
670         CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
671      ENDIF
672      !
673      !                                ! ============================
674      !                                !        close the files
675      !                                ! ============================
676      CALL iom_close( inum )
677      !
678   END SUBROUTINE cfg_write
679
680   !!======================================================================
681END MODULE domain
Note: See TracBrowser for help on using the repository browser.