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_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 9328

Last change on this file since 9328 was 9209, checked in by davestorkey, 6 years ago

Alternative bug fixes for closea bugs if ln_read_cfg=.false.
See https://forge.ipsl.jussieu.fr/nemo/ticket/2000#comment:3
Also correct typo in zdfdrg.F90

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