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

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

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