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 NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM – NEMO

source: NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DOM/domain.F90 @ 10001

Last change on this file since 10001 was 10001, checked in by gm, 6 years ago

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