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

source: branches/UKMO/dev_r5518_GO6_package_text_diagnostics/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 10759

Last change on this file since 10759 was 10759, checked in by andmirek, 5 years ago

GMED 450 write output.namelist.dyn only for nprint > 2

File size: 24.8 KB
RevLine 
[3]1MODULE domain
2   !!==============================================================================
3   !!                       ***  MODULE domain   ***
4   !! Ocean initialization : domain initialization
5   !!==============================================================================
[1438]6   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
7   !!                 !  1992-01  (M. Imbard) insert time step initialization
8   !!                 !  1996-06  (G. Madec) generalized vertical coordinate
9   !!                 !  1997-02  (G. Madec) creation of domwri.F
10   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
11   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
12   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
[2528]13   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
[4152]14   !!            3.6  !  2013     ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
[3]15   !!----------------------------------------------------------------------
[1438]16   
17   !!----------------------------------------------------------------------
[3]18   !!   dom_init       : initialize the space and time domain
19   !!   dom_nam        : read and contral domain namelists
20   !!   dom_ctl        : control print for the ocean domain
21   !!----------------------------------------------------------------------
[2528]22   USE oce             ! ocean variables
23   USE dom_oce         ! domain: ocean
[888]24   USE sbc_oce         ! surface boundary condition: ocean
[719]25   USE phycst          ! physical constants
[1601]26   USE closea          ! closed seas
[719]27   USE in_out_manager  ! I/O manager
[3]28   USE lib_mpp         ! distributed memory computing library
29
30   USE domhgr          ! domain: set the horizontal mesh
31   USE domzgr          ! domain: set the vertical mesh
32   USE domstp          ! domain: set the time-step
33   USE dommsk          ! domain: set the mask system
34   USE domwri          ! domain: write the meshmask file
[592]35   USE domvvl          ! variable volume
[2528]36   USE c1d             ! 1D vertical configuration
37   USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
[3294]38   USE timing          ! Timing
[3680]39   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
[3]40
41   IMPLICIT NONE
42   PRIVATE
43
[1438]44   PUBLIC   dom_init   ! called by opa.F90
[3]45
46   !! * Substitutions
47#  include "domzgr_substitute.h90"
[1438]48   !!-------------------------------------------------------------------------
[2528]49   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[888]50   !! $Id$
[2528]51   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
[1438]52   !!-------------------------------------------------------------------------
[3]53CONTAINS
54
55   SUBROUTINE dom_init
56      !!----------------------------------------------------------------------
57      !!                  ***  ROUTINE dom_init  ***
58      !!                   
59      !! ** Purpose :   Domain initialization. Call the routines that are
[1601]60      !!              required to create the arrays which define the space
61      !!              and time domain of the ocean model.
[3]62      !!
[1601]63      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
64      !!              - dom_hgr: compute or read the horizontal grid-point position
65      !!                         and scale factors, and the coriolis factor
66      !!              - dom_zgr: define the vertical coordinate and the bathymetry
67      !!              - dom_stp: defined the model time step
68      !!              - dom_wri: create the meshmask file if nmsh=1
[2528]69      !!              - 1D configuration, move Coriolis, u and v at T-point
[3]70      !!----------------------------------------------------------------------
[3764]71      INTEGER ::   jk          ! dummy loop argument
72      INTEGER ::   iconf = 0   ! local integers
[3]73      !!----------------------------------------------------------------------
[1601]74      !
[3764]75      IF( nn_timing == 1 )   CALL timing_start('dom_init')
[3294]76      !
[3]77      IF(lwp) THEN
78         WRITE(numout,*)
79         WRITE(numout,*) 'dom_init : domain initialization'
80         WRITE(numout,*) '~~~~~~~~'
81      ENDIF
[1601]82      !
83                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
84                             CALL dom_clo      ! Closed seas and lake
85                             CALL dom_hgr      ! Horizontal mesh
86                             CALL dom_zgr      ! Vertical mesh and bathymetry
87                             CALL dom_msk      ! Masks
[3680]88      IF( ln_sco )           CALL dom_stiff    ! Maximum stiffness ratio/hydrostatic consistency
[4490]89      !
90      ht_0(:,:) = 0.0_wp                       ! Reference ocean depth at T-points
91      hu_0(:,:) = 0.0_wp                       ! Reference ocean depth at U-points
92      hv_0(:,:) = 0.0_wp                       ! Reference ocean depth at V-points
93      DO jk = 1, 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      !
[4292]99      IF( lk_vvl )           CALL dom_vvl_init ! Vertical variable mesh
[1601]100      !
[3764]101      IF( lk_c1d         )   CALL cor_c1d      ! 1D configuration: Coriolis set at T-point
[2528]102      !
[4370]103      !
104      hu(:,:) = 0._wp                          ! Ocean depth at U-points
105      hv(:,:) = 0._wp                          ! Ocean depth at V-points
106      ht(:,:) = 0._wp                          ! Ocean depth at T-points
107      DO jk = 1, jpkm1
[4292]108         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
109         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
[4370]110         ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)
[3]111      END DO
[1601]112      !                                        ! Inverse of the local depth
[4990]113      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:)
114      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:)
[216]115
[1601]116                             CALL dom_stp      ! time step
117      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
118      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
[1438]119      !
[3764]120      IF( nn_timing == 1 )   CALL timing_stop('dom_init')
[3294]121      !
[3]122   END SUBROUTINE dom_init
123
124
125   SUBROUTINE dom_nam
126      !!----------------------------------------------------------------------
127      !!                     ***  ROUTINE dom_nam  ***
128      !!                   
129      !! ** Purpose :   read domaine namelists and print the variables.
130      !!
131      !! ** input   : - namrun namelist
132      !!              - namdom namelist
133      !!              - namcla namelist
[2528]134      !!              - namnc4 namelist   ! "key_netcdf4" only
[3]135      !!----------------------------------------------------------------------
136      USE ioipsl
[5341]137      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               &
[6491]138         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , ln_rstdate, nn_rstctl,   &
[1601]139         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
[5363]140         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler
[4245]141      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   &
142         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  &
[4370]143         &             rn_rdtmax, rn_rdth     , nn_closea , ln_crs,    &
[4147]144         &             jphgr_msh, &
145         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
146         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
147         &             ppa2, ppkth2, ppacr2
[1601]148      NAMELIST/namcla/ nn_cla
[2528]149#if defined key_netcdf4
150      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
151#endif
[4147]152      INTEGER  ::   ios                 ! Local integer output status for namelist read
[3]153      !!----------------------------------------------------------------------
154
[4147]155      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
156      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
157901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
158
159      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
160      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
161902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
[10759]162      IF(lwm .AND. nprint > 2) WRITE ( numond, namrun )
[1601]163      !
164      IF(lwp) THEN                  ! control print
[3]165         WRITE(numout,*)
166         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
167         WRITE(numout,*) '~~~~~~~ '
[1601]168         WRITE(numout,*) '   Namelist namrun'
169         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
170         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
[4147]171         WRITE(numout,*) '      file prefix restart input       cn_ocerst_in= ', cn_ocerst_in
[5341]172         WRITE(numout,*) '      restart input directory         cn_ocerst_indir= ', cn_ocerst_indir
[4147]173         WRITE(numout,*) '      file prefix restart output      cn_ocerst_out= ', cn_ocerst_out
[5341]174         WRITE(numout,*) '      restart output directory        cn_ocerst_outdir= ', cn_ocerst_outdir
[6491]175         WRITE(numout,*) '      restart logical                 ln_rstart  = ' , ln_rstart
176         WRITE(numout,*) '      datestamping of restarts        ln_rstdate  = ', ln_rstdate
[4370]177         WRITE(numout,*) '      start with forward time step    nn_euler   = ', nn_euler
[1604]178         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
[1601]179         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
180         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
181         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
182         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
183         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
[5341]184         IF( ln_rst_list ) THEN
185            WRITE(numout,*) '      list of restart dump times      nn_stocklist   =', nn_stocklist
186         ELSE
187            WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
188         ENDIF
[1601]189         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
190         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
191         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
[5363]192         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
[1601]193         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
194         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
[3]195      ENDIF
196
[1601]197      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
198      cexper = cn_exp
199      nrstdt = nn_rstctl
200      nit000 = nn_it000
201      nitend = nn_itend
202      ndate0 = nn_date0
203      nleapy = nn_leapy
204      ninist = nn_istate
205      nstock = nn_stock
[5341]206      nstocklist = nn_stocklist
[1601]207      nwrite = nn_write
[4370]208      neuler = nn_euler
[5341]209      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
[4370]210         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
211         CALL ctl_warn( ctmp1 )
212         neuler = 0
213      ENDIF
[3]214
[1601]215      !                             ! control of output frequency
[1335]216      IF ( nstock == 0 .OR. nstock > nitend ) THEN
[1601]217         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
[783]218         CALL ctl_warn( ctmp1 )
[1335]219         nstock = nitend
[3]220      ENDIF
221      IF ( nwrite == 0 ) THEN
[1601]222         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
[783]223         CALL ctl_warn( ctmp1 )
224         nwrite = nitend
[3]225      ENDIF
226
[2528]227#if defined key_agrif
[1601]228      IF( Agrif_Root() ) THEN
[2528]229#endif
230      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
231      CASE (  1 ) 
232         CALL ioconf_calendar('gregorian')
233         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
234      CASE (  0 )
235         CALL ioconf_calendar('noleap')
236         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
237      CASE ( 30 )
238         CALL ioconf_calendar('360d')
239         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
240      END SELECT
241#if defined key_agrif
[1601]242      ENDIF
[2528]243#endif
[3]244
[4147]245      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
246      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
247903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
[4152]248 
249      !
[4147]250      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
251      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
252904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
[10759]253      IF(lwm .AND. nprint > 2) WRITE ( numond, namdom )
[4147]254
[3]255      IF(lwp) THEN
[72]256         WRITE(numout,*)
[1601]257         WRITE(numout,*) '   Namelist namdom : space & time domain'
258         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
[4245]259         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
[2528]260         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
261         WRITE(numout,*) '      min number of ocean level (<0)       '
[1601]262         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
263         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
264         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
[2528]265         WRITE(numout,*) '           = 0   no file created           '
266         WRITE(numout,*) '           = 1   mesh_mask                 '
267         WRITE(numout,*) '           = 2   mesh and mask             '
268         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
[4152]269         WRITE(numout,*) '      ocean time step                       rn_rdt    = ', rn_rdt
270         WRITE(numout,*) '      asselin time filter parameter         rn_atfp   = ', rn_atfp
271         WRITE(numout,*) '      acceleration of converge              nn_acc    = ', nn_acc
272         WRITE(numout,*) '        nn_acc=1: surface tracer rdt        rn_rdtmin = ', rn_rdtmin
273         WRITE(numout,*) '                  bottom  tracer rdt        rdtmax    = ', rn_rdtmax
274         WRITE(numout,*) '                  depth of transition       rn_rdth   = ', rn_rdth
275         WRITE(numout,*) '      suppression of closed seas (=0)       nn_closea = ', nn_closea
276         WRITE(numout,*) '      online coarsening of dynamical fields ln_crs    = ', ln_crs
[4147]277         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
278         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
279         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
280         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
281         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
282         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
283         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
284         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
285         WRITE(numout,*) '                                        ppa0            = ', ppa0
286         WRITE(numout,*) '                                        ppa1            = ', ppa1
287         WRITE(numout,*) '                                        ppkth           = ', ppkth
288         WRITE(numout,*) '                                        ppacr           = ', ppacr
289         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
290         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
291         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
292         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
293         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
294         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
[223]295      ENDIF
296
[1601]297      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
298      e3zps_min = rn_e3zps_min
299      e3zps_rat = rn_e3zps_rat
300      nmsh      = nn_msh
301      nacc      = nn_acc
302      atfp      = rn_atfp
303      rdt       = rn_rdt
304      rdtmin    = rn_rdtmin
305      rdtmax    = rn_rdtmin
306      rdth      = rn_rdth
307
[4147]308      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
309      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
310905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
311
312      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
313      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
314906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
[10759]315      IF(lwm .AND. nprint > 2) WRITE( numond, namcla )
[4147]316
[3]317      IF(lwp) THEN
[72]318         WRITE(numout,*)
[1601]319         WRITE(numout,*) '   Namelist namcla'
320         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
[3]321      ENDIF
[4147]322      IF ( nn_cla .EQ. 1 ) THEN
323         IF  ( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2
324            CONTINUE
325         ELSE
326            CALL ctl_stop( 'STOP', 'Cross land advation iplemented only for ORCA2 configuration: cp_cfg = "orca" and jp_cfg = 2 ' )
327         ENDIF
328      ENDIF
[3]329
[2528]330#if defined key_netcdf4
331      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
[4147]332      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
333      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
334907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
335
336      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
337      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
338908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
[10759]339      IF(lwm .AND. nprint > 2) WRITE( numond, namnc4 )
[4147]340
[2528]341      IF(lwp) THEN                        ! control print
342         WRITE(numout,*)
343         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
344         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
345         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
346         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
347         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
348      ENDIF
[1601]349
[2528]350      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
351      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
352      snc4set%ni   = nn_nchunks_i
353      snc4set%nj   = nn_nchunks_j
354      snc4set%nk   = nn_nchunks_k
355      snc4set%luse = ln_nc4zip
356#else
357      snc4set%luse = .FALSE.        ! No NetCDF 4 case
358#endif
[1438]359      !
[3]360   END SUBROUTINE dom_nam
361
362
363   SUBROUTINE dom_ctl
364      !!----------------------------------------------------------------------
365      !!                     ***  ROUTINE dom_ctl  ***
366      !!
367      !! ** Purpose :   Domain control.
368      !!
369      !! ** Method  :   compute and print extrema of masked scale factors
370      !!----------------------------------------------------------------------
371      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
[1601]372      INTEGER, DIMENSION(2) ::   iloc   !
[3]373      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
374      !!----------------------------------------------------------------------
[1601]375      !
376      IF(lk_mpp) THEN
[4990]377         CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
378         CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
379         CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
380         CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
[181]381      ELSE
[4990]382         ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
383         ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
384         ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )   
385         ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )   
[32]386
[4990]387         iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
[181]388         iimi1 = iloc(1) + nimpp - 1
389         ijmi1 = iloc(2) + njmpp - 1
[4990]390         iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
[181]391         iimi2 = iloc(1) + nimpp - 1
392         ijmi2 = iloc(2) + njmpp - 1
[4990]393         iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
[181]394         iima1 = iloc(1) + nimpp - 1
395         ijma1 = iloc(2) + njmpp - 1
[4990]396         iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
[181]397         iima2 = iloc(1) + nimpp - 1
398         ijma2 = iloc(2) + njmpp - 1
[32]399      ENDIF
[3]400      IF(lwp) THEN
[1601]401         WRITE(numout,*)
402         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
403         WRITE(numout,*) '~~~~~~~'
[181]404         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
405         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
406         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
407         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
[3]408      ENDIF
[1438]409      !
[3]410   END SUBROUTINE dom_ctl
411
[3680]412   SUBROUTINE dom_stiff
413      !!----------------------------------------------------------------------
414      !!                  ***  ROUTINE dom_stiff  ***
415      !!                     
416      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency
417      !!
418      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio
419      !!                Save the maximum in the vertical direction
420      !!                (this number is only relevant in s-coordinates)
421      !!
422      !!                Haney, R. L., 1991: On the pressure gradient force
423      !!                over steep topography in sigma coordinate ocean models.
424      !!                J. Phys. Oceanogr., 21, 610???619.
425      !!----------------------------------------------------------------------
426      INTEGER  ::   ji, jj, jk 
427      REAL(wp) ::   zrxmax
428      REAL(wp), DIMENSION(4) :: zr1
429      !!----------------------------------------------------------------------
430      rx1(:,:) = 0.e0
431      zrxmax   = 0.e0
432      zr1(:)   = 0.e0
433     
434      DO ji = 2, jpim1
435         DO jj = 2, jpjm1
436            DO jk = 1, jpkm1
[4292]437               zr1(1) = umask(ji-1,jj  ,jk) *abs( (gdepw_0(ji  ,jj  ,jk  )-gdepw_0(ji-1,jj  ,jk  )  & 
438                    &                         +gdepw_0(ji  ,jj  ,jk+1)-gdepw_0(ji-1,jj  ,jk+1)) &
439                    &                        /(gdepw_0(ji  ,jj  ,jk  )+gdepw_0(ji-1,jj  ,jk  )  &
440                    &                         -gdepw_0(ji  ,jj  ,jk+1)-gdepw_0(ji-1,jj  ,jk+1) + rsmall) )
441               zr1(2) = umask(ji  ,jj  ,jk) *abs( (gdepw_0(ji+1,jj  ,jk  )-gdepw_0(ji  ,jj  ,jk  )  &
442                    &                         +gdepw_0(ji+1,jj  ,jk+1)-gdepw_0(ji  ,jj  ,jk+1)) &
443                    &                        /(gdepw_0(ji+1,jj  ,jk  )+gdepw_0(ji  ,jj  ,jk  )  &
444                    &                         -gdepw_0(ji+1,jj  ,jk+1)-gdepw_0(ji  ,jj  ,jk+1) + rsmall) )
445               zr1(3) = vmask(ji  ,jj  ,jk) *abs( (gdepw_0(ji  ,jj+1,jk  )-gdepw_0(ji  ,jj  ,jk  )  &
446                    &                         +gdepw_0(ji  ,jj+1,jk+1)-gdepw_0(ji  ,jj  ,jk+1)) &
447                    &                        /(gdepw_0(ji  ,jj+1,jk  )+gdepw_0(ji  ,jj  ,jk  )  &
448                    &                         -gdepw_0(ji  ,jj+1,jk+1)-gdepw_0(ji  ,jj  ,jk+1) + rsmall) )
449               zr1(4) = vmask(ji  ,jj-1,jk) *abs( (gdepw_0(ji  ,jj  ,jk  )-gdepw_0(ji  ,jj-1,jk  )  &
450                    &                         +gdepw_0(ji  ,jj  ,jk+1)-gdepw_0(ji  ,jj-1,jk+1)) &
451                    &                        /(gdepw_0(ji  ,jj  ,jk  )+gdepw_0(ji  ,jj-1,jk  )  &
452                    &                         -gdepw_0(ji,  jj  ,jk+1)-gdepw_0(ji  ,jj-1,jk+1) + rsmall) )
[3680]453               zrxmax = MAXVAL(zr1(1:4))
454               rx1(ji,jj) = MAX(rx1(ji,jj), zrxmax)
455            END DO
456         END DO
457      END DO
458
459      CALL lbc_lnk( rx1, 'T', 1. )
460
461      zrxmax = MAXVAL(rx1)
462
463      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain
464
465      IF(lwp) THEN
466         WRITE(numout,*)
467         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
468         WRITE(numout,*) '~~~~~~~~~'
469      ENDIF
470
471   END SUBROUTINE dom_stiff
472
473
474
[3]475   !!======================================================================
476END MODULE domain
Note: See TracBrowser for help on using the repository browser.