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

source: branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 7421

Last change on this file since 7421 was 7421, checked in by flavoni, 7 years ago

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