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/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM – NEMO

source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domain.F90 @ 12731

Last change on this file since 12731 was 12731, checked in by techene, 4 years ago

replace h. and gde. in case key_qco is activated - quick and dirty

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