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/TOOLS/DOMAINcfg/src – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/TOOLS/DOMAINcfg/src/domain.f90 @ 9033

Last change on this file since 9033 was 9033, checked in by timgraham, 6 years ago

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