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

source: trunk/NEMOGCM/NEMO/OFF_SRC/domain.F90 @ 4624

Last change on this file since 4624 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.

  • Property svn:keywords set to Id
File size: 21.0 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/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
119         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
120         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz, nn_euler
121      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
122         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
123         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, &
124         &             jphgr_msh, &
125         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
126         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
127         &             ppa2, ppkth2, ppacr2
128      NAMELIST/namcla/ nn_cla
129#if defined key_netcdf4
130      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
131#endif
132      !!----------------------------------------------------------------------
133
134      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run
135      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
136901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
137
138      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run
139      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
140902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
141      IF(lwm) WRITE ( numond, namrun )
142      !
143      IF(lwp) THEN                  ! control print
144         WRITE(numout,*)
145         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
146         WRITE(numout,*) '~~~~~~~ '
147         WRITE(numout,*) '   Namelist namrun' 
148         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
149         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
150         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
151         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
152         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
153         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
154         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
155         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
156         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
157         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
158         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
159         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
160         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
161         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
162         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
163      ENDIF
164      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
165      cexper = cn_exp
166      nrstdt = nn_rstctl
167      nit000 = nn_it000
168      nitend = nn_itend
169      ndate0 = nn_date0
170      nleapy = nn_leapy
171      ninist = nn_istate
172      nstock = nn_stock
173      nwrite = nn_write
174
175
176      !                             ! control of output frequency
177      IF ( nstock == 0 .OR. nstock > nitend ) THEN
178         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
179         CALL ctl_warn( ctmp1 )
180         nstock = nitend
181      ENDIF
182      IF ( nwrite == 0 ) THEN
183         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
184         CALL ctl_warn( ctmp1 )
185         nwrite = nitend
186      ENDIF
187
188      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
189      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
190      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
191
192#if defined key_agrif
193      IF( Agrif_Root() ) THEN
194#endif
195      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
196      CASE (  1 ) 
197         CALL ioconf_calendar('gregorian')
198         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
199      CASE (  0 )
200         CALL ioconf_calendar('noleap')
201         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
202      CASE ( 30 )
203         CALL ioconf_calendar('360d')
204         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
205      END SELECT
206#if defined key_agrif
207      ENDIF
208#endif
209
210      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
211      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
212903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
213
214      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
215      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
216904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
217      IF(lwm) WRITE ( numond, namdom )
218
219      IF(lwp) THEN
220         WRITE(numout,*) 
221         WRITE(numout,*) '   Namelist namdom : space & time domain'
222         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
223         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy
224         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
225         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
226         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
227         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
228         WRITE(numout,*) '           = 0   no file created                 '
229         WRITE(numout,*) '           = 1   mesh_mask                       '
230         WRITE(numout,*) '           = 2   mesh and mask                   '
231         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
232         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
233         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
234         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
235         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
236         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
237         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
238         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
239         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
240         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh
241         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0
242         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0
243         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg
244         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg
245         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m
246         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m
247         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur
248         WRITE(numout,*) '                                        ppa0            = ', ppa0
249         WRITE(numout,*) '                                        ppa1            = ', ppa1
250         WRITE(numout,*) '                                        ppkth           = ', ppkth
251         WRITE(numout,*) '                                        ppacr           = ', ppacr
252         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin
253         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax
254         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
255         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2
256         WRITE(numout,*) '                                      ppkth2            = ', ppkth2
257         WRITE(numout,*) '                                      ppacr2            = ', ppacr2
258      ENDIF
259
260      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
261      e3zps_min = rn_e3zps_min
262      e3zps_rat = rn_e3zps_rat
263      nmsh      = nn_msh
264      nacc      = nn_acc
265      atfp      = rn_atfp
266      rdt       = rn_rdt
267      rdtmin    = rn_rdtmin
268      rdtmax    = rn_rdtmin
269      rdth      = rn_rdth
270
271      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection
272      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
273905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
274
275      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection
276      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
277906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
278      IF(lwm) WRITE( numond, namcla )
279
280      IF(lwp) THEN
281         WRITE(numout,*)
282         WRITE(numout,*) '   Namelist namcla'
283         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
284      ENDIF
285
286#if defined key_netcdf4
287      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
288      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF
289      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
290907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
291
292      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF
293      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
294908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
295      IF(lwm) WRITE( numond, namnc4 )
296      IF(lwp) THEN                        ! control print
297         WRITE(numout,*)
298         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
299         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
300         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
301         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
302         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
303      ENDIF
304
305      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
306      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
307      snc4set%ni   = nn_nchunks_i
308      snc4set%nj   = nn_nchunks_j
309      snc4set%nk   = nn_nchunks_k
310      snc4set%luse = ln_nc4zip
311#else
312      snc4set%luse = .FALSE.        ! No NetCDF 4 case
313#endif
314      !
315   END SUBROUTINE dom_nam
316
317   SUBROUTINE dom_zgr
318      !!----------------------------------------------------------------------
319      !!                ***  ROUTINE dom_zgr  ***
320      !!                   
321      !! ** Purpose :  set the depth of model levels and the resulting
322      !!      vertical scale factors.
323      !!
324      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d)
325      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
326      !!              - vertical coordinate (gdep., e3.) depending on the
327      !!                coordinate chosen :
328      !!                   ln_zco=T   z-coordinate 
329      !!                   ln_zps=T   z-coordinate with partial steps
330      !!                   ln_zco=T   s-coordinate
331      !!
332      !! ** Action  :   define gdep., e3., mbathy and bathy
333      !!----------------------------------------------------------------------
334      INTEGER ::   ioptio = 0   ! temporary integer
335      INTEGER ::   ios
336      !!
337      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
338      !!----------------------------------------------------------------------
339
340      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate
341      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 )
342901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp )
343
344      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate
345      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 )
346902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp )
347      IF(lwm) WRITE ( numond, namzgr )
348
349      IF(lwp) THEN                     ! Control print
350         WRITE(numout,*)
351         WRITE(numout,*) 'dom_zgr : vertical coordinate'
352         WRITE(numout,*) '~~~~~~~'
353         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
354         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
355         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
356         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
357      ENDIF
358
359      ioptio = 0                       ! Check Vertical coordinate options
360      IF( ln_zco ) ioptio = ioptio + 1
361      IF( ln_zps ) ioptio = ioptio + 1
362      IF( ln_sco ) ioptio = ioptio + 1
363      IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
364
365   END SUBROUTINE dom_zgr
366
367   SUBROUTINE dom_ctl
368      !!----------------------------------------------------------------------
369      !!                     ***  ROUTINE dom_ctl  ***
370      !!
371      !! ** Purpose :   Domain control.
372      !!
373      !! ** Method  :   compute and print extrema of masked scale factors
374      !!
375      !! History :
376      !!   8.5  !  02-08  (G. Madec)    Original code
377      !!----------------------------------------------------------------------
378      !! * Local declarations
379      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
380      INTEGER, DIMENSION(2) ::   iloc      !
381      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
382      !!----------------------------------------------------------------------
383
384      ! Extrema of the scale factors
385
386      IF(lwp)WRITE(numout,*)
387      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
388      IF(lwp)WRITE(numout,*) '~~~~~~~'
389
390      IF (lk_mpp) THEN
391         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
392         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
393         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
394         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
395      ELSE
396         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
397         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
398         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
399         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
400
401         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
402         iimi1 = iloc(1) + nimpp - 1
403         ijmi1 = iloc(2) + njmpp - 1
404         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
405         iimi2 = iloc(1) + nimpp - 1
406         ijmi2 = iloc(2) + njmpp - 1
407         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
408         iima1 = iloc(1) + nimpp - 1
409         ijma1 = iloc(2) + njmpp - 1
410         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
411         iima2 = iloc(1) + nimpp - 1
412         ijma2 = iloc(2) + njmpp - 1
413      ENDIF
414
415      IF(lwp) THEN
416         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
417         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
418         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
419         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
420      ENDIF
421
422   END SUBROUTINE dom_ctl
423
424   !!======================================================================
425END MODULE domain
Note: See TracBrowser for help on using the repository browser.