source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 6979

Last change on this file since 6979 was 6979, checked in by cetlod, 5 years ago

SIMPLIF_2_usrdef : make it work for standard Offline configuration

  • Property svn:keywords set to Id
File size: 27.3 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   !!----------------------------------------------------------------------
17   
18   !!----------------------------------------------------------------------
19   !!   dom_init      : initialize the space and time domain
20   !!   dom_nam       : read and contral domain namelists
21   !!   dom_ctl       : control print for the ocean domain
22   !!   cfg_write     : create the "domain_cfg.nc" file containing all required configuration information   
23   !!----------------------------------------------------------------------
24   USE oce            ! ocean variables
25   USE dom_oce        ! domain: ocean
26   USE sbc_oce        ! surface boundary condition: ocean
27   USE phycst         ! physical constants
28   USE usrdef_closea  ! closed seas
29   USE domhgr         ! domain: set the horizontal mesh
30   USE domzgr         ! domain: set the vertical mesh
31   USE dommsk         ! domain: set the mask system
32   USE domwri         ! domain: write the meshmask file
33   USE domvvl         ! variable volume
34   USE c1d            ! 1D vertical configuration
35   USE dyncor_c1d     ! Coriolis term (c1d case)         (cor_c1d routine)
36   !
37   USE in_out_manager ! I/O manager
38   USE iom            ! I/O library
39   USE lbclnk         ! ocean lateral boundary condition (or mpp link)
40   USE lib_mpp        ! distributed memory computing library
41   USE wrk_nemo       ! Memory Allocation
42   USE timing         ! Timing
43
44   IMPLICIT NONE
45   PRIVATE
46
47   PUBLIC   dom_init   ! called by opa.F90
48
49   !!-------------------------------------------------------------------------
50   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
51   !! $Id$
52   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
53   !!-------------------------------------------------------------------------
54CONTAINS
55
56   SUBROUTINE dom_init
57      !!----------------------------------------------------------------------
58      !!                  ***  ROUTINE dom_init  ***
59      !!                   
60      !! ** Purpose :   Domain initialization. Call the routines that are
61      !!              required to create the arrays which define the space
62      !!              and time domain of the ocean model.
63      !!
64      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
65      !!              - dom_hgr: compute or read the horizontal grid-point position
66      !!                         and scale factors, and the coriolis factor
67      !!              - dom_zgr: define the vertical coordinate and the bathymetry
68      !!              - dom_wri: create the meshmask file if nn_msh=1
69      !!              - 1D configuration, move Coriolis, u and v at T-point
70      !!----------------------------------------------------------------------
71      INTEGER ::   ji, jj, jk, ik   ! dummy loop indices
72      INTEGER ::   iconf = 0    ! local integers
73      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7))" 
74      INTEGER , DIMENSION(jpi,jpj) ::   ik_top , ik_bot       ! top and bottom ocean level
75      REAL(wp), DIMENSION(jpi,jpj) ::   z1_hu_0, z1_hv_0
76      !!----------------------------------------------------------------------
77      !
78      IF( nn_timing == 1 )   CALL timing_start('dom_init')
79      !
80      IF(lwp) THEN         ! Ocean domain Parameters (control print)
81         WRITE(numout,*)
82         WRITE(numout,*) 'dom_init : domain initialization'
83         WRITE(numout,*) '~~~~~~~~'
84         !
85         WRITE(numout,*)     '   Domain info'
86         WRITE(numout,*)     '      dimension of model'
87         WRITE(numout,*)     '             Local domain      Global domain       Data domain '
88         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo
89         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo
90         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo
91         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij
92         WRITE(numout,*)     '      mpp local domain info (mpp)'
93         WRITE(numout,*)     '              jpni    : ', jpni, '   jpreci  : ', jpreci
94         WRITE(numout,*)     '              jpnj    : ', jpnj, '   jprecj  : ', jprecj
95         WRITE(numout,*)     '              jpnij   : ', jpnij
96         WRITE(numout,*)     '      lateral boundary of the Global domain : jperio  = ', jperio
97      ENDIF
98      !
99      !           !==  Reference coordinate system  ==!
100      !     
101      CALL dom_nam                     ! read namelist ( namrun, namdom )
102      CALL dom_clo( cp_cfg, jp_cfg )   ! Closed seas and lake
103      CALL dom_hgr                     ! Horizontal mesh
104      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry
105      IF( nn_closea == 0 )   CALL clo_bat( ik_top, ik_bot )    !==  remove closed seas or lakes  ==!
106      CALL dom_msk( ik_top, ik_bot )   ! Masks
107      !
108      DO jj = 1, jpj                   ! depth of the iceshelves
109         DO ji = 1, jpi
110            ik = mikt(ji,jj)
111            risfdep(ji,jj) = gdepw_0(ji,jj,ik)
112         END DO
113      END DO
114      !
115      ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1)   ! Reference ocean thickness
116      hu_0(:,:) = e3u_0(:,:,1) * umask(:,:,1)
117      hv_0(:,:) = e3v_0(:,:,1) * vmask(:,:,1)
118      DO jk = 2, jpk
119         ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
120         hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
121         hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
122      END DO
123      !
124      !           !==  time varying part of coordinate system  ==!
125      !
126      IF( ln_linssh ) THEN       != Fix in time : set to the reference one for all
127      !
128         !       before        !          now          !       after         !
129         ;  gdept_b = gdept_0  ;   gdept_n = gdept_0   !        ---          ! depth of grid-points
130         ;  gdepw_b = gdepw_0  ;   gdepw_n = gdepw_0   !        ---          !
131         ;                     ;   gde3w_n = gde3w_0   !        ---          !
132         !                                                                 
133         ;    e3t_b =   e3t_0  ;     e3t_n =   e3t_0   ;   e3t_a =  e3t_0    ! scale factors
134         ;    e3u_b =   e3u_0  ;     e3u_n =   e3u_0   ;   e3u_a =  e3u_0    !
135         ;    e3v_b =   e3v_0  ;     e3v_n =   e3v_0   ;   e3v_a =  e3v_0    !
136         ;                     ;     e3f_n =   e3f_0   !        ---          !
137         ;    e3w_b =   e3w_0  ;     e3w_n =   e3w_0   !        ---          !
138         ;   e3uw_b =  e3uw_0  ;    e3uw_n =  e3uw_0   !        ---          !
139         ;   e3vw_b =  e3vw_0  ;    e3vw_n =  e3vw_0   !        ---          !
140         !
141         z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )     ! _i mask due to ISF
142         z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
143         !
144         !        before       !          now          !       after         !
145         ;                     ;      ht_n =    ht_0   !                     ! water column thickness
146         ;     hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !
147         ;     hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   !
148         ;  r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness
149         ;  r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   !
150         !
151         !
152      ELSE                       != time varying : initialize before/now/after variables
153         !
154         CALL dom_vvl_init 
155         !
156      ENDIF
157      !
158      IF( lk_c1d         )   CALL cor_c1d       ! 1D configuration: Coriolis set at T-point
159      !
160      IF( nn_msh > 0 .AND. .NOT. ln_iscpl )                         CALL dom_wri      ! Create a domain file
161      IF( nn_msh > 0 .AND.       ln_iscpl .AND. .NOT. ln_rstart )   CALL dom_wri      ! Create a domain file
162      IF( .NOT.ln_rstart )   CALL dom_ctl       ! Domain control
163      !
164     
165      IF(lwp) THEN
166         WRITE(numout,*)
167         WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh
168         WRITE(numout,*) 
169      ENDIF
170      !
171      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file
172      !
173      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
174      !
175   END SUBROUTINE dom_init
176
177
178   SUBROUTINE dom_nam
179      !!----------------------------------------------------------------------
180      !!                     ***  ROUTINE dom_nam  ***
181      !!                   
182      !! ** Purpose :   read domaine namelists and print the variables.
183      !!
184      !! ** input   : - namrun namelist
185      !!              - namdom namelist
186      !!              - namnc4 namelist   ! "key_netcdf4" only
187      !!----------------------------------------------------------------------
188      USE ioipsl
189      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,                 &
190         &             nn_no   , cn_exp   , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl ,     &
191         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     &
192         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     &
193         &             ln_cfmeta, ln_iscpl
194      NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs
195#if defined key_netcdf4
196      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
197#endif
198      INTEGER  ::   ios                 ! Local integer output status for namelist read
199      !!----------------------------------------------------------------------
200
201      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
202      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
203901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
204
205      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
206      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
207902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
208      IF(lwm) WRITE ( numond, namrun )
209      !
210      IF(lwp) THEN                  ! control print
211         WRITE(numout,*)
212         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
213         WRITE(numout,*) '~~~~~~~ '
214         WRITE(numout,*) '   Namelist namrun'
215         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
216         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
217         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
218         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
219         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
220         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
221         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
222         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
223         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
224         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
225         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
226         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
227         WRITE(numout,*) '      initial time of day in hhmm     nn_time0   = ', nn_time0
228         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
229         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
230         IF( ln_rst_list ) THEN
231            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
232         ELSE
233            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
234         ENDIF
235         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
236         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
237         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
238         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
239         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
240         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl
241      ENDIF
242
243      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
244      cexper = cn_exp
245      nrstdt = nn_rstctl
246      nit000 = nn_it000
247      nitend = nn_itend
248      ndate0 = nn_date0
249      nleapy = nn_leapy
250      ninist = nn_istate
251      nstock = nn_stock
252      nstocklist = nn_stocklist
253      nwrite = nn_write
254      neuler = nn_euler
255      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
256         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
257         CALL ctl_warn( ctmp1 )
258         neuler = 0
259      ENDIF
260      !                             ! control of output frequency
261      IF ( nstock == 0 .OR. nstock > nitend ) THEN
262         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
263         CALL ctl_warn( ctmp1 )
264         nstock = nitend
265      ENDIF
266      IF ( nwrite == 0 ) THEN
267         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
268         CALL ctl_warn( ctmp1 )
269         nwrite = nitend
270      ENDIF
271
272#if defined key_agrif
273      IF( Agrif_Root() ) THEN
274#endif
275      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
276      CASE (  1 ) 
277         CALL ioconf_calendar('gregorian')
278         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
279      CASE (  0 )
280         CALL ioconf_calendar('noleap')
281         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
282      CASE ( 30 )
283         CALL ioconf_calendar('360d')
284         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
285      END SELECT
286#if defined key_agrif
287      ENDIF
288#endif
289
290      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
291      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
292903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
293 
294      !
295      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
296      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
297904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
298      IF(lwm) WRITE ( numond, namdom )
299      !
300      IF(lwp) THEN
301         WRITE(numout,*)
302         WRITE(numout,*) '   Namelist namdom : space & time domain'
303         WRITE(numout,*) '      linear free surface (=T)              ln_linssh  = ', ln_linssh
304         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea  = ', nn_closea
305         WRITE(numout,*) '      create mesh/mask file(s)              nn_msh     = ', nn_msh
306         WRITE(numout,*) '           = 0   no file created           '
307         WRITE(numout,*) '           = 1   mesh_mask                 '
308         WRITE(numout,*) '           = 2   mesh and mask             '
309         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
310         WRITE(numout,*) '      treshold to open the isf cavity       rn_isfhmin = ', rn_isfhmin, ' (m)'
311         WRITE(numout,*) '      ocean time step                       rn_rdt     = ', rn_rdt
312         WRITE(numout,*) '      asselin time filter parameter         rn_atfp    = ', rn_atfp
313         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs     = ', ln_crs
314      ENDIF
315     
316      call flush( numout )
317      !
318!     !          ! conversion DOCTOR names into model names (this should disappear soon)
319      atfp      = rn_atfp
320      rdt       = rn_rdt
321
322#if defined key_netcdf4
323      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
324      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
325      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
326907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
327
328      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
329      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
330908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
331      IF(lwm) WRITE( numond, namnc4 )
332
333      IF(lwp) THEN                        ! control print
334         WRITE(numout,*)
335         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
336         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
337         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
338         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
339         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
340      ENDIF
341
342      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
343      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
344      snc4set%ni   = nn_nchunks_i
345      snc4set%nj   = nn_nchunks_j
346      snc4set%nk   = nn_nchunks_k
347      snc4set%luse = ln_nc4zip
348#else
349      snc4set%luse = .FALSE.        ! No NetCDF 4 case
350#endif
351      !
352   END SUBROUTINE dom_nam
353
354
355   SUBROUTINE dom_ctl
356      !!----------------------------------------------------------------------
357      !!                     ***  ROUTINE dom_ctl  ***
358      !!
359      !! ** Purpose :   Domain control.
360      !!
361      !! ** Method  :   compute and print extrema of masked scale factors
362      !!----------------------------------------------------------------------
363      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
364      INTEGER, DIMENSION(2) ::   iloc   !
365      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
366      !!----------------------------------------------------------------------
367      !
368      IF(lk_mpp) THEN
369         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
370         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
371         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
372         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
373      ELSE
374         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
375         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
376         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
377         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
378         !
379         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
380         iimi1 = iloc(1) + nimpp - 1
381         ijmi1 = iloc(2) + njmpp - 1
382         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
383         iimi2 = iloc(1) + nimpp - 1
384         ijmi2 = iloc(2) + njmpp - 1
385         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
386         iima1 = iloc(1) + nimpp - 1
387         ijma1 = iloc(2) + njmpp - 1
388         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
389         iima2 = iloc(1) + nimpp - 1
390         ijma2 = iloc(2) + njmpp - 1
391      ENDIF
392      IF(lwp) THEN
393         WRITE(numout,*)
394         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
395         WRITE(numout,*) '~~~~~~~'
396         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
397         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
398         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
399         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
400      ENDIF
401      !
402   END SUBROUTINE dom_ctl
403
404
405   SUBROUTINE cfg_write
406      !!----------------------------------------------------------------------
407      !!                  ***  ROUTINE cfg_write  ***
408      !!                   
409      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which
410      !!              contains all the ocean domain informations required to
411      !!              define an ocean configuration.
412      !!
413      !! ** Method  :   Write in a file all the arrays required to set up an
414      !!              ocean configuration.
415      !!
416      !! ** output file :   domain_cfg.nc : domain size, characteristics, horizontal mesh,
417      !!                              Coriolis parameter, depth and vertical scale factors
418      !!----------------------------------------------------------------------
419      INTEGER           ::   ji, jj, jk   ! dummy loop indices
420      INTEGER           ::   izco, izps, isco, icav
421      INTEGER           ::   inum     ! temprary units for 'domain_cfg.nc' file
422      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations)
423      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! workspace
424      !!----------------------------------------------------------------------
425      !
426      IF(lwp) WRITE(numout,*)
427      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information'
428      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
429      !
430      !                       ! ============================= !
431      !                       !  create 'domain_cfg.nc' file  !
432      !                       ! ============================= !
433      !         
434      clnam = 'domain_cfg'  ! filename (configuration information)
435      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
436     
437      !                             !==  global domain size  ==!
438      !
439      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
440      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
441      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 )
442      !
443      !                             !==  domain characteristics  ==!
444      !
445      !                                   ! lateral boundary of the global domain
446      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
447      !
448      !                                   ! type of vertical coordinate
449      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF
450      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF
451      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF
452      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 )
453      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 )
454      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 )
455      !
456      !                                   ! ocean cavities under iceshelves
457      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF
458      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
459      !
460      !                             !==  horizontal mesh  !
461      !
462      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )   ! latitude
463      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
464      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
465      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
466      !                               
467      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )   ! longitude
468      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
469      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
470      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
471      !                               
472      CALL iom_rstput( 0, 0, inum, 'e1t'  , e1t  , ktype = jp_r8 )   ! i-scale factors (e1.)
473      CALL iom_rstput( 0, 0, inum, 'e1u'  , e1u  , ktype = jp_r8 )
474      CALL iom_rstput( 0, 0, inum, 'e1v'  , e1v  , ktype = jp_r8 )
475      CALL iom_rstput( 0, 0, inum, 'e1f'  , e1f  , ktype = jp_r8 )
476      !
477      CALL iom_rstput( 0, 0, inum, 'e2t'  , e2t  , ktype = jp_r8 )   ! j-scale factors (e2.)
478      CALL iom_rstput( 0, 0, inum, 'e2u'  , e2u  , ktype = jp_r8 )
479      CALL iom_rstput( 0, 0, inum, 'e2v'  , e2v  , ktype = jp_r8 )
480      CALL iom_rstput( 0, 0, inum, 'e2f'  , e2f  , ktype = jp_r8 )
481      !
482      CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 )   ! coriolis factor
483      CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
484      !
485      !                             !==  vertical mesh - 3D mask  ==!
486      !                                                     
487      CALL iom_rstput( 0, 0, inum, 'gdept_1d', gdept_1d, ktype = jp_r8 )   ! reference 1D-coordinate
488      CALL iom_rstput( 0, 0, inum, 'gdepw_1d', gdepw_1d, ktype = jp_r8 )
489      CALL iom_rstput( 0, 0, inum, 'e3t_1d'  , e3t_1d  , ktype = jp_r8 )
490      CALL iom_rstput( 0, 0, inum, 'e3w_1d'  , e3w_1d  , ktype = jp_r8 )
491      !                                                     
492      CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 )   ! depth (t- & w-points)
493      CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 )
494      !
495      CALL iom_rstput( 0, 0, inum, 'e3t_0'   , e3t_0   , ktype = jp_r8 )   ! vertical scale factors (e
496      CALL iom_rstput( 0, 0, inum, 'e3u_0'   , e3u_0   , ktype = jp_r8 )
497      CALL iom_rstput( 0, 0, inum, 'e3v_0'   , e3v_0   , ktype = jp_r8 )
498      CALL iom_rstput( 0, 0, inum, 'e3f_0'   , e3f_0   , ktype = jp_r8 )
499      CALL iom_rstput( 0, 0, inum, 'e3w_0'   , e3w_0   , ktype = jp_r8 )
500      CALL iom_rstput( 0, 0, inum, 'e3uw_0'  , e3uw_0  , ktype = jp_r8 )
501      CALL iom_rstput( 0, 0, inum, 'e3vw_0'  , e3vw_0  , ktype = jp_r8 )
502      !                                         
503      !                             !==  ocean top and bottom level  ==!   (caution: multiplied by ssmask)
504      !
505      CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points
506      CALL iom_rstput( 0, 0, inum, 'top_level'    , REAL( mikt, wp )*ssmask , ktype = jp_i4 )   ! nb of ocean T-points (ISF)
507      !
508      IF( ln_sco ) THEN             ! s-coordinate: store grid stiffness ratio  (Not required anyway)
509         CALL dom_stiff( z2d )
510         CALL iom_rstput( 0, 0, inum, 'stiffness', z2d )        !    ! Max. grid stiffness ratio
511      ENDIF
512      !
513      !                                ! ============================
514      !                                !        close the files
515      !                                ! ============================
516      CALL iom_close( inum )
517      !
518   END SUBROUTINE cfg_write
519
520   !!======================================================================
521END MODULE domain
Note: See TracBrowser for help on using the repository browser.