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/UKMO/dev_r8600_closea_rewrite/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/UKMO/dev_r8600_closea_rewrite/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 9017

Last change on this file since 9017 was 9017, checked in by davestorkey, 7 years ago

UKMO/dev_r8600_closea_rewrite branch : commit code

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