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

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

dev_merge_2017: OPA_SRC: style only, results unchanged
  • 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 (ln_meshmask=T)
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 = ', TRIM( cn_cfg ), '   nn_cfg = ', nn_cfg
113      ENDIF
114      !
115      !           !==  Reference coordinate system  ==!
116      !
117      CALL dom_glo                     ! global domain versus local domain
118      CALL dom_nam                     ! read namelist ( namrun, namdom )
119      CALL dom_hgr                     ! Horizontal mesh
120      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
121      CALL dom_msk( ik_top, ik_bot )   ! Masks
122      IF( ln_closea ) CALL dom_clo     ! ln_closea=T : closed seas included in the simulation
123                                       ! Read in masks to define closed seas and lakes
124      !
125      DO jj = 1, jpj                   ! depth of the iceshelves
126         DO ji = 1, jpi
127            ik = mikt(ji,jj)
128            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
129         END DO
130      END DO
131      !
132      ht_0(:,:) = 0._wp  ! Reference ocean thickness
133      hu_0(:,:) = 0._wp
134      hv_0(:,:) = 0._wp
135      DO jk = 1, jpk
136         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
137         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
138         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
139      END DO
140      !
141      !           !==  time varying part of coordinate system  ==!
142      !
143      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
144      !
145         !       before        !          now          !       after         !
146            gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
147            gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
148                                   gde3w_n = gde3w_0   !        ---          !
149         !                                                                 
150              e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
151              e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
152              e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
153                                     e3f_n =   e3f_0   !        ---          !
154              e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
155             e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
156             e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
157         !
158         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
159         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
160         !
161         !        before       !          now          !       after         !
162                                      ht_n =    ht_0   !                     ! water column thickness
163               hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !
164               hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
165            r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
166            r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
167         !
168         !
169      ELSE                       != time varying : initialize before/now/after variables
170         !
171         IF( .NOT.l_offline )  CALL dom_vvl_init 
172         !
173      ENDIF
174      !
175      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
176      !
177      IF( ln_meshmask .AND. .NOT.ln_iscpl )                        CALL dom_wri     ! Create a domain file
178      IF( ln_meshmask .AND.      ln_iscpl .AND. .NOT.ln_rstart )   CALL dom_wri     ! Create a domain file
179      IF(                                       .NOT.ln_rstart )   CALL dom_ctl     ! Domain control
180      !
181      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file
182      !
183      IF(lwp) THEN
184         WRITE(numout,*)
185         WRITE(numout,*) 'dom_init :   ==>>>   END of domain initialization'
186         WRITE(numout,*) '~~~~~~~~'
187         WRITE(numout,*) 
188      ENDIF
189      !
190   END SUBROUTINE dom_init
191
192
193   SUBROUTINE dom_glo
194      !!----------------------------------------------------------------------
195      !!                     ***  ROUTINE dom_glo  ***
196      !!
197      !! ** Purpose :   initialization of global domain <--> local domain indices
198      !!
199      !! ** Method  :   
200      !!
201      !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices
202      !!              - mi0 , mi1 : global domain indices ==> local  domain indices
203      !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
204      !!----------------------------------------------------------------------
205      INTEGER ::   ji, jj   ! dummy loop argument
206      !!----------------------------------------------------------------------
207      !
208      DO ji = 1, jpi                 ! local domain indices ==> global domain indices
209        mig(ji) = ji + nimpp - 1
210      END DO
211      DO jj = 1, jpj
212        mjg(jj) = jj + njmpp - 1
213      END DO
214      !                              ! global domain indices ==> local domain indices
215      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
216      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
217      DO ji = 1, jpiglo
218        mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
219        mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi   ) )
220      END DO
221      DO jj = 1, jpjglo
222        mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
223        mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj   ) )
224      END DO
225      IF(lwp) THEN                   ! control print
226         WRITE(numout,*)
227         WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
228         WRITE(numout,*) '~~~~~~~ '
229         WRITE(numout,*) '   global domain:   jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
230         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk
231         WRITE(numout,*)
232         WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done'
233         IF( nn_print >= 1 ) THEN
234            WRITE(numout,*)
235            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)'
236            WRITE(numout,25)              (mig(ji),ji = 1,jpi)
237            WRITE(numout,*)
238            WRITE(numout,*) '          conversion global ==> local  i-index domain'
239            WRITE(numout,*) '             starting index (mi0)'
240            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo)
241            WRITE(numout,*) '             ending index (mi1)'
242            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo)
243            WRITE(numout,*)
244            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)'
245            WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
246            WRITE(numout,*)
247            WRITE(numout,*) '          conversion global ==> local  j-index domain'
248            WRITE(numout,*) '             starting index (mj0)'
249            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo)
250            WRITE(numout,*) '             ending index (mj1)'
251            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo)
252         ENDIF
253      ENDIF
254 25   FORMAT( 100(10x,19i4,/) )
255      !
256   END SUBROUTINE dom_glo
257
258
259   SUBROUTINE dom_nam
260      !!----------------------------------------------------------------------
261      !!                     ***  ROUTINE dom_nam  ***
262      !!                   
263      !! ** Purpose :   read domaine namelists and print the variables.
264      !!
265      !! ** input   : - namrun namelist
266      !!              - namdom namelist
267      !!              - namnc4 namelist   ! "key_netcdf4" only
268      !!----------------------------------------------------------------------
269      USE ioipsl
270      !!
271      INTEGER  ::   ios   ! Local integer
272      !
273      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
274         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
275         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
276         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
277         &             ln_cfmeta, ln_iscpl
278      NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask
279#if defined key_netcdf4
280      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
281#endif
282      !!----------------------------------------------------------------------
283      !
284      IF(lwp) THEN
285         WRITE(numout,*)
286         WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
287         WRITE(numout,*) '~~~~~~~ '
288      ENDIF
289      !
290      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
291      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
292901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
293      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
294      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
295902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
296      IF(lwm) WRITE ( numond, namrun )
297      !
298      IF(lwp) THEN                  ! control print
299         WRITE(numout,*) '   Namelist : namrun   ---   run parameters'
300         WRITE(numout,*) '      job number                      nn_no           = ', nn_no
301         WRITE(numout,*) '      experiment name for output      cn_exp          = ', TRIM( cn_exp           )
302         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in    = ', TRIM( cn_ocerst_in     )
303         WRITE(numout,*) '      restart input directory         cn_ocerst_indir = ', TRIM( cn_ocerst_indir  )
304         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out   = ', TRIM( cn_ocerst_out    )
305         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
306         WRITE(numout,*) '      restart logical                 ln_rstart       = ', ln_rstart
307         WRITE(numout,*) '      start with forward time step    nn_euler        = ', nn_euler
308         WRITE(numout,*) '      control of time step            nn_rstctl       = ', nn_rstctl
309         WRITE(numout,*) '      number of the first time step   nn_it000        = ', nn_it000
310         WRITE(numout,*) '      number of the last time step    nn_itend        = ', nn_itend
311         WRITE(numout,*) '      initial calendar date aammjj    nn_date0        = ', nn_date0
312         WRITE(numout,*) '      initial time of day in hhmm     nn_time0        = ', nn_time0
313         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy        = ', nn_leapy
314         WRITE(numout,*) '      initial state output            nn_istate       = ', nn_istate
315         IF( ln_rst_list ) THEN
316            WRITE(numout,*) '      list of restart dump times      nn_stocklist    =', nn_stocklist
317         ELSE
318            WRITE(numout,*) '      frequency of restart file       nn_stock        = ', nn_stock
319         ENDIF
320         WRITE(numout,*) '      frequency of output file        nn_write        = ', nn_write
321         WRITE(numout,*) '      mask land points                ln_mskland      = ', ln_mskland
322         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta       = ', ln_cfmeta
323         WRITE(numout,*) '      overwrite an existing file      ln_clobber      = ', ln_clobber
324         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz      = ', nn_chunksz
325         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl        = ', ln_iscpl
326      ENDIF
327
328      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
329      cexper = cn_exp
330      nrstdt = nn_rstctl
331      nit000 = nn_it000
332      nitend = nn_itend
333      ndate0 = nn_date0
334      nleapy = nn_leapy
335      ninist = nn_istate
336      nstock = nn_stock
337      nstocklist = nn_stocklist
338      nwrite = nn_write
339      neuler = nn_euler
340      IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN
341         IF(lwp) WRITE(numout,*) 
342         IF(lwp) WRITE(numout,*)'   ==>>>   Start from rest (ln_rstart=F)'
343         IF(lwp) WRITE(numout,*)'           an Euler initial time step is used : nn_euler is forced to 0 '   
344         neuler = 0
345      ENDIF
346      !                             ! control of output frequency
347      IF( nstock == 0 .OR. nstock > nitend ) THEN
348         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
349         CALL ctl_warn( ctmp1 )
350         nstock = nitend
351      ENDIF
352      IF ( nwrite == 0 ) THEN
353         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
354         CALL ctl_warn( ctmp1 )
355         nwrite = nitend
356      ENDIF
357
358#if defined key_agrif
359      IF( Agrif_Root() ) THEN
360#endif
361      IF(lwp) WRITE(numout,*)
362      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
363      CASE (  1 ) 
364         CALL ioconf_calendar('gregorian')
365         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year'
366      CASE (  0 )
367         CALL ioconf_calendar('noleap')
368         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year'
369      CASE ( 30 )
370         CALL ioconf_calendar('360d')
371         IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year'
372      END SELECT
373#if defined key_agrif
374      ENDIF
375#endif
376
377      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
378      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
379903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
380      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
381      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
382904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
383      IF(lwm) WRITE( numond, namdom )
384      !
385      IF(lwp) THEN
386         WRITE(numout,*)
387         WRITE(numout,*) '   Namelist : namdom   ---   space & time domain'
388         WRITE(numout,*) '      linear free surface (=T)                ln_linssh   = ', ln_linssh
389         WRITE(numout,*) '      create mesh/mask file                   ln_meshmask = ', ln_meshmask
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      !          ! conversion DOCTOR names into model names (this should disappear soon)
397      atfp = rn_atfp
398      rdt  = rn_rdt
399
400#if defined key_netcdf4
401      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
402      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
403      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
404907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
405      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
406      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
407908   IF( ios >  0 )   CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
408      IF(lwm) WRITE( numond, namnc4 )
409
410      IF(lwp) THEN                        ! control print
411         WRITE(numout,*)
412         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
413         WRITE(numout,*) '      number of chunks in i-dimension             nn_nchunks_i = ', nn_nchunks_i
414         WRITE(numout,*) '      number of chunks in j-dimension             nn_nchunks_j = ', nn_nchunks_j
415         WRITE(numout,*) '      number of chunks in k-dimension             nn_nchunks_k = ', nn_nchunks_k
416         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression   ln_nc4zip    = ', ln_nc4zip
417      ENDIF
418
419      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
420      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
421      snc4set%ni   = nn_nchunks_i
422      snc4set%nj   = nn_nchunks_j
423      snc4set%nk   = nn_nchunks_k
424      snc4set%luse = ln_nc4zip
425#else
426      snc4set%luse = .FALSE.        ! No NetCDF 4 case
427#endif
428      !
429   END SUBROUTINE dom_nam
430
431
432   SUBROUTINE dom_ctl
433      !!----------------------------------------------------------------------
434      !!                     ***  ROUTINE dom_ctl  ***
435      !!
436      !! ** Purpose :   Domain control.
437      !!
438      !! ** Method  :   compute and print extrema of masked scale factors
439      !!----------------------------------------------------------------------
440      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
441      INTEGER, DIMENSION(2) ::   iloc   !
442      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
443      !!----------------------------------------------------------------------
444      !
445      IF(lk_mpp) THEN
446         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
447         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
448         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
449         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
450      ELSE
451         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
452         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
453         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
454         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
455         !
456         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
457         iimi1 = iloc(1) + nimpp - 1
458         ijmi1 = iloc(2) + njmpp - 1
459         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
460         iimi2 = iloc(1) + nimpp - 1
461         ijmi2 = iloc(2) + njmpp - 1
462         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
463         iima1 = iloc(1) + nimpp - 1
464         ijma1 = iloc(2) + njmpp - 1
465         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
466         iima2 = iloc(1) + nimpp - 1
467         ijma2 = iloc(2) + njmpp - 1
468      ENDIF
469      IF(lwp) THEN
470         WRITE(numout,*)
471         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
472         WRITE(numout,*) '~~~~~~~'
473         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
474         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
475         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
476         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
477      ENDIF
478      !
479   END SUBROUTINE dom_ctl
480
481
482   SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
483      !!----------------------------------------------------------------------
484      !!                     ***  ROUTINE dom_nam  ***
485      !!                   
486      !! ** Purpose :   read the domain size in domain configuration file
487      !!
488      !! ** Method  :   read the cn_domcfg NetCDF file
489      !!----------------------------------------------------------------------
490      CHARACTER(len=*), DIMENSION(:), INTENT(out) ::   ldtxt           ! stored print information
491      CHARACTER(len=*)              , INTENT(out) ::   cd_cfg          ! configuration name
492      INTEGER                       , INTENT(out) ::   kk_cfg          ! configuration resolution
493      INTEGER                       , INTENT(out) ::   kpi, kpj, kpk   ! global domain sizes
494      INTEGER                       , INTENT(out) ::   kperio          ! lateral global domain b.c.
495      !
496      INTEGER ::   inum, ii   ! local integer
497      REAL(wp) ::   zorca_res                     ! local scalars
498      REAL(wp) ::   ziglo, zjglo, zkglo, zperio   !   -      -
499      !!----------------------------------------------------------------------
500      !
501      ii = 1
502      WRITE(ldtxt(ii),*) '           '                                                    ;   ii = ii+1
503      WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'  ;   ii = ii+1
504      WRITE(ldtxt(ii),*) '~~~~~~~~~~ '                                                    ;   ii = ii+1
505      !
506      CALL iom_open( cn_domcfg, inum )
507      !
508      !                                   !- ORCA family specificity
509      IF(  iom_varid( inum, 'ORCA'       , ldstop = .FALSE. ) > 0  .AND.  &
510         & iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0    ) THEN
511         !
512         cd_cfg = 'ORCA'
513         CALL iom_get( inum, 'ORCA_index', zorca_res )   ;   kk_cfg = INT( zorca_res )
514         !
515         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
516         WRITE(ldtxt(ii),*) '   ==>>>   ORCA configuration '                           ;   ii = ii+1
517         WRITE(ldtxt(ii),*) '   .'                                                     ;   ii = ii+1
518         !
519      ELSE                                !- cd_cfg & k_cfg are not used
520         cd_cfg = 'UNKNOWN'
521         kk_cfg = -9999999
522                                          !- or they may be present as global attributes
523                                          !- (netcdf only) 
524         IF( iom_file(inum)%iolib == jpnf90 ) THEN
525            CALL iom_getatt( inum, 'cn_cfg', cd_cfg )  ! returns   !  if not found
526            CALL iom_getatt( inum, 'nn_cfg', kk_cfg )  ! returns -999 if not found
527            IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
528            IF( kk_cfg == -999     ) kk_cfg = -9999999
529         ENDIF
530         !
531      ENDIF
532      !
533      CALL iom_get( inum, 'jpiglo', ziglo  )   ;   kpi = INT( ziglo )
534      CALL iom_get( inum, 'jpjglo', zjglo  )   ;   kpj = INT( zjglo )
535      CALL iom_get( inum, 'jpkglo', zkglo  )   ;   kpk = INT( zkglo )
536      CALL iom_get( inum, 'jperio', zperio )   ;   kperio = INT( zperio )
537      CALL iom_close( inum )
538      !
539      WRITE(ldtxt(ii),*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg             ;   ii = ii+1
540      WRITE(ldtxt(ii),*) '      jpiglo = ', kpi                                              ;   ii = ii+1
541      WRITE(ldtxt(ii),*) '      jpjglo = ', kpj                                              ;   ii = ii+1
542      WRITE(ldtxt(ii),*) '      jpkglo = ', kpk                                              ;   ii = ii+1
543      WRITE(ldtxt(ii),*) '      type of global domain lateral boundary   jperio = ', kperio  ;   ii = ii+1
544      !       
545   END SUBROUTINE domain_cfg
546   
547   
548   SUBROUTINE cfg_write
549      !!----------------------------------------------------------------------
550      !!                  ***  ROUTINE cfg_write  ***
551      !!                   
552      !! ** Purpose :   Create the "cn_domcfg_out" file, a NetCDF file which
553      !!              contains all the ocean domain informations required to
554      !!              define an ocean configuration.
555      !!
556      !! ** Method  :   Write in a file all the arrays required to set up an
557      !!              ocean configuration.
558      !!
559      !! ** output file :   domcfg_out.nc : domain size, characteristics, horizontal
560      !!                       mesh, Coriolis parameter, and vertical scale factors
561      !!                    NB: also contain ORCA family information
562      !!----------------------------------------------------------------------
563      INTEGER           ::   ji, jj, jk   ! dummy loop indices
564      INTEGER           ::   izco, izps, isco, icav
565      INTEGER           ::   inum     ! local units
566      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
567      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
568      !!----------------------------------------------------------------------
569      !
570      IF(lwp) WRITE(numout,*)
571      IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
572      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
573      !
574      !                       ! ============================= !
575      !                       !  create 'domcfg_out.nc' file  !
576      !                       ! ============================= !
577      !         
578      clnam = cn_domcfg_out  ! filename (configuration information)
579      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
580     
581      !
582      !                             !==  ORCA family specificities  ==!
583      IF( cn_cfg == "ORCA" ) THEN
584         CALL iom_rstput( 0, 0, inum, 'ORCA'      , 1._wp            , ktype = jp_i4 )
585         CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )         
586      ENDIF
587      !
588      !                             !==  global domain size  ==!
589      !
590      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
591      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
592      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
593      !
594      !                             !==  domain characteristics  ==!
595      !
596      !                                   ! lateral boundary of the global domain
597      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
598      !
599      !                                   ! type of vertical coordinate
600      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
601      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
602      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
603      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
604      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
605      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
606      !
607      !                                   ! ocean cavities under iceshelves
608      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
609      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
610      !
611      !                             !==  horizontal mesh  !
612      !
613      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
614      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
615      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
616      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
617      !                               
618      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
619      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
620      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
621      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
622      !                               
623      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
624      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
625      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
626      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
627      !
628      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
629      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
630      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
631      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
632      !
633      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
634      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
635      !
636      !                             !==  vertical mesh  ==!
637      !                                                     
638      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d , ktype = jp_r8 )   ! reference 1D-coordinate
639      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d , ktype = jp_r8 )
640      !
641      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0  , ktype = jp_r8 )   ! vertical scale factors
642      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0  , ktype = jp_r8 )
643      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0  , ktype = jp_r8 )
644      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0  , ktype = jp_r8 )
645      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0  , ktype = jp_r8 )
646      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0 , ktype = jp_r8 )
647      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0 , ktype = jp_r8 )
648      !                                         
649      !                             !==  wet top and bottom level  ==!   (caution: multiplied by ssmask)
650      !
651      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
652      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
653      !
654      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
655         CALL dom_stiff( z2d )
656         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
657      ENDIF
658      !
659      IF( ll_wd ) THEN              ! wetting and drying domain
660         CALL iom_rstput( 0, 0, inum, 'ht_0'   , ht_0   , ktype = jp_r8 )
661      ENDIF
662      !
663      ! Add some global attributes ( netcdf only )
664      IF( iom_file(inum)%iolib == jpnf90 ) THEN
665         CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
666         CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
667      ENDIF
668      !
669      !                                ! ============================
670      !                                !        close the files
671      !                                ! ============================
672      CALL iom_close( inum )
673      !
674   END SUBROUTINE cfg_write
675
676   !!======================================================================
677END MODULE domain
Note: See TracBrowser for help on using the repository browser.