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

Last change on this file since 7514 was 7514, checked in by acc, 7 years ago

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