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_r5107_eorca025_closea/NEMOGCM/NEMO/OFF_SRC – NEMO

source: branches/UKMO/dev_r5107_eorca025_closea/NEMOGCM/NEMO/OFF_SRC/domain.F90 @ 5449

Last change on this file since 5449 was 5449, checked in by davestorkey, 9 years ago

Update UKMO/dev_r5107_eorca025_closea branch to revision 5442 of the trunk.

File size: 21.5 KB
Line 
1MODULE domain
2   !!==============================================================================
3   !!                       ***  MODULE domain   ***
4   !! Ocean initialization : domain initialization
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dom_init       : initialize the space and time domain
9   !!   dom_nam        : read and contral domain namelists
10   !!   dom_ctl        : control print for the ocean domain
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE oce             !
14   USE dom_oce         ! ocean space and time domain
15   USE phycst          ! physical constants
16   USE in_out_manager  ! I/O manager
17   USE lib_mpp         ! distributed memory computing library
18
19   USE domstp          ! domain: set the time-step
20   USE domrea          ! domain: write the meshmask file
21   USE dommsk          ! domain : mask
22
23   IMPLICIT NONE
24   PRIVATE
25
26   !! * Routine accessibility
27   PUBLIC dom_init       ! called by opa.F90
28
29   !! * Substitutions
30#  include "domzgr_substitute.h90"
31   !!----------------------------------------------------------------------
32   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
33   !! $Id$
34   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
35   !!----------------------------------------------------------------------
36
37CONTAINS
38
39   SUBROUTINE dom_init
40      !!----------------------------------------------------------------------
41      !!                  ***  ROUTINE dom_init  ***
42      !!                   
43      !! ** Purpose :   Domain initialization. Call the routines that are
44      !!      required to create the arrays which define the space and time
45      !!      domain of the ocean model.
46      !!
47      !! ** Method  :
48      !!      - dom_stp: defined the model time step
49      !!      - dom_rea: read the meshmask file if nmsh=1
50      !!
51      !! History :
52      !!        !  90-10  (C. Levy - G. Madec)  Original code
53      !!        !  91-11  (G. Madec)
54      !!        !  92-01  (M. Imbard) insert time step initialization
55      !!        !  96-06  (G. Madec) generalized vertical coordinate
56      !!        !  97-02  (G. Madec) creation of domwri.F
57      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
58      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
59      !!----------------------------------------------------------------------
60      !! * Local declarations
61      INTEGER ::   jk                ! dummy loop argument
62      INTEGER ::   iconf = 0         ! temporary integers
63      !!----------------------------------------------------------------------
64
65      IF(lwp) THEN
66         WRITE(numout,*)
67         WRITE(numout,*) 'dom_init : domain initialization'
68         WRITE(numout,*) '~~~~~~~~'
69      ENDIF
70
71      CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
72      CALL dom_zgr      ! Vertical mesh and bathymetry option
73      CALL dom_rea      ! Create a domain file
74
75     !
76      ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines
77      !        but could be usefull in many other routines
78      e12t    (:,:) = e1t(:,:) * e2t(:,:)
79      e1e2t   (:,:) = e1t(:,:) * e2t(:,:)
80      e12u    (:,:) = e1u(:,:) * e2u(:,:)
81      e12v    (:,:) = e1v(:,:) * e2v(:,:)
82      e12f    (:,:) = e1f(:,:) * e2f(:,:)
83      r1_e12t (:,:) = 1._wp    / e12t(:,:)
84      r1_e12u (:,:) = 1._wp    / e12u(:,:)
85      r1_e12v (:,:) = 1._wp    / e12v(:,:)
86      r1_e12f (:,:) = 1._wp    / e12f(:,:)
87      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)
88      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)
89      !
90      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points
91      hv(:,:) = 0._wp
92      DO jk = 1, jpk
93         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
94         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
95      END DO
96      !                                        ! Inverse of the local depth
97      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)
98      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)
99
100      CALL dom_stp      ! Time step
101      CALL dom_msk      ! Masks
102      CALL dom_ctl      ! Domain control
103
104   END SUBROUTINE dom_init
105
106   SUBROUTINE dom_nam
107      !!----------------------------------------------------------------------
108      !!                     ***  ROUTINE dom_nam  ***
109      !!                   
110      !! ** Purpose :   read domaine namelists and print the variables.
111      !!
112      !! ** input   : - namrun namelist
113      !!              - namdom namelist
114      !!              - namcla namelist
115      !!----------------------------------------------------------------------
116      USE ioipsl
117      INTEGER  ::   ios                 ! Local integer output status for namelist read
118      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               &
119         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
120         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
121         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler
122      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
123         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
124         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, &
125         &             jphgr_msh, &
126         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
127         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
128         &             ppa2, ppkth2, ppacr2
129      NAMELIST/namcla/ nn_cla
130#if defined key_netcdf4
131      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
132#endif
133      !!----------------------------------------------------------------------
134
135      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
136      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
137901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
138
139      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
140      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
141902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
142      IF(lwm) WRITE ( numond, namrun )
143      !
144      IF(lwp) THEN                  ! control print
145         WRITE(numout,*)
146         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
147         WRITE(numout,*) '~~~~~~~ '
148         WRITE(numout,*) '   Namelist namrun' 
149         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
150         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
151         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
152         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
153         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
154         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
155         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
156         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
157         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
158         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
159         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
160         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
161         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
162         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta
163         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
164         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
165      ENDIF
166      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
167      cexper = cn_exp
168      nrstdt = nn_rstctl
169      nit000 = nn_it000
170      nitend = nn_itend
171      ndate0 = nn_date0
172      nleapy = nn_leapy
173      ninist = nn_istate
174      nstock = nn_stock
175      nstocklist = nn_stocklist
176      nwrite = nn_write
177
178
179      !                             ! control of output frequency
180      IF ( nstock == 0 .OR. nstock > nitend ) THEN
181         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
182         CALL ctl_warn( ctmp1 )
183         nstock = nitend
184      ENDIF
185      IF ( nwrite == 0 ) THEN
186         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
187         CALL ctl_warn( ctmp1 )
188         nwrite = nitend
189      ENDIF
190
191      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
192      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
193      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
194
195#if defined key_agrif
196      IF( Agrif_Root() ) THEN
197#endif
198      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
199      CASE (  1 ) 
200         CALL ioconf_calendar('gregorian')
201         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
202      CASE (  0 )
203         CALL ioconf_calendar('noleap')
204         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
205      CASE ( 30 )
206         CALL ioconf_calendar('360d')
207         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
208      END SELECT
209#if defined key_agrif
210      ENDIF
211#endif
212
213      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
214      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
215903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
216
217      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
218      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
219904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
220      IF(lwm) WRITE ( numond, namdom )
221
222      IF(lwp) THEN
223         WRITE(numout,*) 
224         WRITE(numout,*) '   Namelist namdom : space & time domain'
225         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
226         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
227         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
228         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
229         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
230         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
231         WRITE(numout,*) '           = 0   no file created                 '
232         WRITE(numout,*) '           = 1   mesh_mask                       '
233         WRITE(numout,*) '           = 2   mesh and mask                   '
234         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
235         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
236         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
237         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
238         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
239         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
240         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
241         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
242         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
243         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
244         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
245         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
246         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
247         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
248         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
249         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
250         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
251         WRITE(numout,*) '                                        ppa0            = ', ppa0
252         WRITE(numout,*) '                                        ppa1            = ', ppa1
253         WRITE(numout,*) '                                        ppkth           = ', ppkth
254         WRITE(numout,*) '                                        ppacr           = ', ppacr
255         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
256         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
257         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
258         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
259         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
260         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
261      ENDIF
262
263      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
264      e3zps_min = rn_e3zps_min
265      e3zps_rat = rn_e3zps_rat
266      nmsh      = nn_msh
267      nacc      = nn_acc
268      atfp      = rn_atfp
269      rdt       = rn_rdt
270      rdtmin    = rn_rdtmin
271      rdtmax    = rn_rdtmin
272      rdth      = rn_rdth
273
274      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
275      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
276905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
277
278      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
279      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
280906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
281      IF(lwm) WRITE( numond, namcla )
282
283      IF(lwp) THEN
284         WRITE(numout,*)
285         WRITE(numout,*) '   Namelist namcla'
286         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
287      ENDIF
288
289#if defined key_netcdf4
290      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
291      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
292      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
293907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
294
295      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
296      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
297908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
298      IF(lwm) WRITE( numond, namnc4 )
299      IF(lwp) THEN                        ! control print
300         WRITE(numout,*)
301         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
302         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
303         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
304         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
305         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
306      ENDIF
307
308      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
309      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
310      snc4set%ni   = nn_nchunks_i
311      snc4set%nj   = nn_nchunks_j
312      snc4set%nk   = nn_nchunks_k
313      snc4set%luse = ln_nc4zip
314#else
315      snc4set%luse = .FALSE.        ! No NetCDF 4 case
316#endif
317      !
318   END SUBROUTINE dom_nam
319
320   SUBROUTINE dom_zgr
321      !!----------------------------------------------------------------------
322      !!                ***  ROUTINE dom_zgr  ***
323      !!                   
324      !! ** Purpose :  set the depth of model levels and the resulting
325      !!      vertical scale factors.
326      !!
327      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
328      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
329      !!              - vertical coordinate (gdep., e3.) depending on the
330      !!                coordinate chosen :
331      !!                   ln_zco=T   z-coordinate 
332      !!                   ln_zps=T   z-coordinate with partial steps
333      !!                   ln_zco=T   s-coordinate
334      !!
335      !! ** Action  :   define gdep., e3., mbathy and bathy
336      !!----------------------------------------------------------------------
337      INTEGER ::   ioptio = 0   ! temporary integer
338      INTEGER ::   ios
339      !!
340      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav
341      !!----------------------------------------------------------------------
342
343      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
344      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
345901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
346
347      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
348      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
349902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
350      IF(lwm) WRITE ( numond, namzgr )
351
352      IF(lwp) THEN                     ! Control print
353         WRITE(numout,*)
354         WRITE(numout,*) 'dom_zgr : vertical coordinate'
355         WRITE(numout,*) '~~~~~~~'
356         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
357         WRITE(numout,*) '             z-coordinate - full steps      ln_zco    = ', ln_zco
358         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps    = ', ln_zps
359         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco
360         WRITE(numout,*) '             ice shelf cavity               ln_isfcav = ', ln_isfcav
361      ENDIF
362
363      ioptio = 0                       ! Check Vertical coordinate options
364      IF( ln_zco ) ioptio = ioptio + 1
365      IF( ln_zps ) ioptio = ioptio + 1
366      IF( ln_sco ) ioptio = ioptio + 1
367      IF( ln_isfcav ) ioptio = 33
368      IF ( ioptio /= 1  )   CALL ctl_stop( ' none or several vertical coordinate options used' )
369      IF ( ioptio == 33 )   CALL ctl_stop( ' isf cavity with off line module not yet done    ' )
370
371   END SUBROUTINE dom_zgr
372
373   SUBROUTINE dom_ctl
374      !!----------------------------------------------------------------------
375      !!                     ***  ROUTINE dom_ctl  ***
376      !!
377      !! ** Purpose :   Domain control.
378      !!
379      !! ** Method  :   compute and print extrema of masked scale factors
380      !!
381      !! History :
382      !!   8.5  !  02-08  (G. Madec)    Original code
383      !!----------------------------------------------------------------------
384      !! * Local declarations
385      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
386      INTEGER, DIMENSION(2) ::   iloc      !
387      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
388      !!----------------------------------------------------------------------
389
390      ! Extrema of the scale factors
391
392      IF(lwp)WRITE(numout,*)
393      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
394      IF(lwp)WRITE(numout,*) '~~~~~~~'
395
396      IF (lk_mpp) THEN
397         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
398         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
399         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
400         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
401      ELSE
402         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
403         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
404         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
405         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
406
407         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
408         iimi1 = iloc(1) + nimpp - 1
409         ijmi1 = iloc(2) + njmpp - 1
410         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
411         iimi2 = iloc(1) + nimpp - 1
412         ijmi2 = iloc(2) + njmpp - 1
413         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
414         iima1 = iloc(1) + nimpp - 1
415         ijma1 = iloc(2) + njmpp - 1
416         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
417         iima2 = iloc(1) + nimpp - 1
418         ijma2 = iloc(2) + njmpp - 1
419      ENDIF
420
421      IF(lwp) THEN
422         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
423         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
424         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
425         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
426      ENDIF
427
428   END SUBROUTINE dom_ctl
429
430   !!======================================================================
431END MODULE domain
Note: See TracBrowser for help on using the repository browser.