New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
domain.F90 in branches/2017/dev_r8600_xios_read_write_v2/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2017/dev_r8600_xios_read_write_v2/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 8831

Last change on this file since 8831 was 8831, checked in by andmirek, 6 years ago

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