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/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 7200

Last change on this file since 7200 was 7200, checked in by gm, 7 years ago

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