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/CONFIG/TEST_CASES/WAD/MY_SRC – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/domain.F90 @ 9168

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

dev_merge_2017: OPA_SRC & CONFIG: remove useless warning when reading namelist_cfg

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