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

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

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