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

source: branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OFF_SRC/domain.F90 @ 5347

Last change on this file since 5347 was 5347, checked in by hadcv, 9 years ago

Added in the ln_cfmeta namelist parameter to OFF_SRC.

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