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

source: trunk/NEMO/OPA_SRC/DOM/domain.F90 @ 239

Last change on this file since 239 was 239, checked in by opalod, 19 years ago

CT : UPDATE172 : remove all direct acces modules and the related cpp key key_fdir
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 16.1 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 ice_oce         ! ice variables
18   USE blk_oce         ! bulk variables
19   USE flxrnf          ! runoffs
20   USE daymod          ! calendar
21   USE lib_mpp         ! distributed memory computing library
22
23   USE domhgr          ! domain: set the horizontal mesh
24   USE domzgr          ! domain: set the vertical mesh
25   USE domstp          ! domain: set the time-step
26   USE dommsk          ! domain: set the mask system
27   USE domwri          ! domain: write the meshmask file
28   USE closea          ! closed sea or lake              (dom_clo routine)
29
30   IMPLICIT NONE
31   PRIVATE
32
33   !! * Routine accessibility
34   PUBLIC dom_init       ! called by opa.F90
35
36   !! * Substitutions
37#  include "domzgr_substitute.h90"
38   !!----------------------------------------------------------------------
39   !!   OPA 9.0 , LODYC-IPSL  (2003)
40   !!----------------------------------------------------------------------
41
42CONTAINS
43
44   SUBROUTINE dom_init
45      !!----------------------------------------------------------------------
46      !!                  ***  ROUTINE dom_init  ***
47      !!                   
48      !! ** Purpose :   Domain initialization. Call the routines that are
49      !!      required to create the arrays which define the space and time
50      !!      domain of the ocean model.
51      !!
52      !! ** Method  :
53      !!      - dom_msk: compute the masks from the bathymetry file
54      !!      - dom_hgr: compute or read the horizontal grid-point position and
55      !!                scale factors, and the coriolis factor
56      !!      - dom_zgr: define the vertical coordinate system and the bathymetry
57      !!      - dom_stp: defined the model time step
58      !!      - dom_wri: create the meshmask file if nmsh=1
59      !!
60      !! History :
61      !!        !  90-10  (C. Levy - G. Madec)  Original code
62      !!        !  91-11  (G. Madec)
63      !!        !  92-01  (M. Imbard) insert time step initialization
64      !!        !  96-06  (G. Madec) generalized vertical coordinate
65      !!        !  97-02  (G. Madec) creation of domwri.F
66      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
67      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
68      !!----------------------------------------------------------------------
69      !! * Local declarations
70      INTEGER ::   jk                ! dummy loop argument
71      INTEGER ::   iconf = 0         ! temporary integers
72      !!----------------------------------------------------------------------
73
74      IF(lwp) THEN
75         WRITE(numout,*)
76         WRITE(numout,*) 'dom_init : domain initialization'
77         WRITE(numout,*) '~~~~~~~~'
78      ENDIF
79
80      CALL dom_nam                        ! read namelist ( namrun, namdom, namcla )
81
82      CALL dom_clo                        ! Closed seas and lake
83
84      CALL dom_hgr                        ! Horizontal mesh
85
86      CALL dom_zgr                        ! Vertical mesh and bathymetry
87
88      CALL dom_msk                        ! Masks
89
90
91      ! Local depth or Inverse of the local depth of the water column at u- and v-points
92      ! ------------------------------
93#if defined key_dynspg_fsc
94      ! Ocean depth at U- and V-points
95      hu(:,:) = 0.
96      hv(:,:) = 0.
97
98      DO jk = 1, jpk
99         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
100         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
101      END DO
102# if defined key_trdvor
103      ! Inverse of the local depth
104      hur(:,:) = fse3u(:,:,1)             ! Lower bound : thickness of the first model level
105      hvr(:,:) = fse3v(:,:,1)
106     
107      DO jk = 2, jpk                      ! Sum of the vertical scale factors
108         hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
109         hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
110      END DO
111
112      ! Compute and mask the inverse of the local depth
113      hur(:,:) = 1. / hur(:,:) * umask(:,:,1)
114      hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1)
115# endif
116
117#elif defined key_dynspg_rl
118      ! Inverse of the local depth
119      hur(:,:) = fse3u(:,:,1)             ! Lower bound : thickness of the first model level
120      hvr(:,:) = fse3v(:,:,1)
121     
122      DO jk = 2, jpk                      ! Sum of the vertical scale factors
123         hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
124         hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
125      END DO
126
127      ! Compute and mask the inverse of the local depth
128      hur(:,:) = 1. / hur(:,:) * umask(:,:,1)
129      hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1)
130#endif
131
132      CALL dom_stp                        ! Time step
133
134      IF( nmsh /= 0 )   CALL dom_wri      ! Create a domain file
135
136      IF( .NOT.ln_rstart )   CALL dom_ctl    ! Domain control
137
138   END SUBROUTINE dom_init
139
140
141   SUBROUTINE dom_nam
142      !!----------------------------------------------------------------------
143      !!                     ***  ROUTINE dom_nam  ***
144      !!                   
145      !! ** Purpose :   read domaine namelists and print the variables.
146      !!
147      !! ** input   : - namrun namelist
148      !!              - namdom namelist
149      !!              - namcla namelist
150      !!
151      !! History :
152      !!   9.0  !  03-08  (G. Madec)  Original code
153      !!----------------------------------------------------------------------
154      !! * Modules used
155      USE ioipsl
156      NAMELIST/namrun/ no    , cexper   , ln_rstart , nrstdt , nit000,         &
157         &             nitend, ndate0   , nleapy   , ninist , nstock,          &
158         &             nprint, nwrite   , nrunoff  , ln_ctl , nictl , njctl,   &
159         &             nbench
160      NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, ngrid  , nmsh  ,   &
161         &             nacc  , atfp     , rdt      , rdtmin , rdtmax,   &
162         &             rdth  , nfice    , nfbulk   , nclosea
163      NAMELIST/namcla/ n_cla
164      !!----------------------------------------------------------------------
165
166      IF(lwp) THEN
167         WRITE(numout,*)
168         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
169         WRITE(numout,*) '~~~~~~~ '
170      ENDIF
171
172      ! Namelist namrun : parameters of the run
173      REWIND( numnam )
174      READ  ( numnam, namrun )
175
176      IF(lwp) THEN
177         WRITE(numout,*) '        Namelist namrun'
178         WRITE(numout,*) '           job number                      no        = ', no
179         WRITE(numout,*) '           experiment name for output      cexper    = ', cexper
180         WRITE(numout,*) '           restart logical                 ln_rstart = ', ln_rstart
181         WRITE(numout,*) '           control of time step            nrstdt    = ', nrstdt
182         WRITE(numout,*) '           number of the first time step   nit000    = ', nit000
183         WRITE(numout,*) '           number of the last time step    nitend    = ', nitend
184         WRITE(numout,*) '           initial calendar date aammjj    ndate0    = ', ndate0
185         WRITE(numout,*) '           leap year calendar (0/1)        nleapy    = ', nleapy
186         WRITE(numout,*) '           initial state output            ninist    = ', ninist
187         WRITE(numout,*) '           level of print                  nprint    = ', nprint
188         WRITE(numout,*) '           frequency of restart file       nstock    = ', nstock
189         WRITE(numout,*) '           frequency of output file        nwrite    = ', nwrite
190         WRITE(numout,*) '           runoff option                   nrunoff   = ', nrunoff
191         WRITE(numout,*) '           run control (for debugging)     ln_ctl    = ', ln_ctl
192         WRITE(numout,*) '           Max i indice for SUM control    nictl     = ', nictl
193         WRITE(numout,*) '           Max j indice for SUM control    njctl     = ', njctl
194         WRITE(numout,*) '           benchmark parameter (0/1)       nbench    = ', nbench
195      ENDIF
196
197      l_ctl = ln_ctl .AND. lwp       ! trend control print on the 1st processor only
198
199      ndastp = ndate0                ! Assign initial date to current date
200
201
202! ... Control of output frequency
203      IF ( nstock == 0 ) THEN
204          IF(lwp)WRITE(numout,cform_war)
205          IF(lwp)WRITE(numout,*) '           nstock = ', nstock, ' it is forced to ', nitend
206          nstock = nitend
207          nwarn = nwarn + 1
208      ENDIF
209      IF ( nwrite == 0 ) THEN
210          IF(lwp)WRITE(numout,cform_war)
211          IF(lwp)WRITE(numout,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
212          nwrite = nitend
213          nwarn = nwarn + 1
214      ENDIF
215
216      SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL
217      CASE (  1 ) 
218         CALL ioconf_calendar('gregorian')
219         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year'
220      CASE (  0 )
221         CALL ioconf_calendar('noleap')
222         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year'
223      CASE ( 30 )
224         CALL ioconf_calendar('360d')
225         IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year'
226      END SELECT
227
228      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
229      CASE ( 1 )
230         raajj = 365.25
231         raass = raajj * rjjss
232         rmoss = raass/raamo
233      CASE ( 0 )
234         raajj = 365.
235         raass = raajj * rjjss
236         rmoss = raass/raamo
237      CASE DEFAULT
238         raajj = FLOAT( nleapy ) * raamo
239         raass =        raajj    * rjjss
240         rmoss = FLOAT( nleapy ) * rjjss
241      END SELECT
242      IF(lwp) THEN
243         WRITE(numout,*)
244         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
245         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
246         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
247      ENDIF
248
249! ... Control the Max i and j indices used for the SUM control (i.e. when ln_ctl=.true.)
250      IF ( nictl > jpim1 ) THEN
251          IF(lwp) THEN
252             WRITE(numout,cform_war)
253             WRITE(numout,*) '           nictl = ', nictl, ' must be <= to jpim1 '
254             WRITE(numout,*) '           nictl forced to be equal to jpim1 '
255          ENDIF
256          nwarn = nwarn + 1
257          nictl = jpim1
258      ENDIF
259
260      IF ( njctl > jpjm1 ) THEN
261          IF(lwp) THEN
262             WRITE(numout,cform_war)
263             WRITE(numout,*) '           njctl = ', njctl, ' must be <= to jpjm1 '
264             WRITE(numout,*) '           njctl forced to be equal to jpjm1 '
265          ENDIF
266          nwarn = nwarn + 1
267          njctl = jpjm1
268      ENDIF
269
270      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
271      REWIND( numnam )
272      READ  ( numnam, namdom )
273
274      IF(lwp) THEN
275         WRITE(numout,*)
276         WRITE(numout,*) '        Namelist namdom'
277         WRITE(numout,*) '           flag read/compute bathymetry   ntopo     = ', ntopo
278         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
279         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
280         WRITE(numout,*) '           flag read/compute coordinates  ngrid     = ', ngrid
281         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
282         WRITE(numout,*) '                = 0   no file created                 '
283         WRITE(numout,*) '                = 1   mesh_mask                       '
284         WRITE(numout,*) '                = 2   mesh and mask                   '
285         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
286         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
287         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
288         WRITE(numout,*) '           time step                      rdt       = ', rdt
289         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
290         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
291         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
292      ENDIF
293
294      IF( lk_ice_lim ) THEN
295         IF(lwp) WRITE(numout,*) '           ice model coupling frequency      nfice  = ', nfice
296         nfbulk = nfice
297         IF( MOD( rday, nfice*rdt ) /= 0 ) THEN
298            IF(lwp) WRITE(numout,*) ' '
299            IF(lwp) WRITE(numout,*) 'W A R N I N G :  nfice is NOT a multiple of the number of time steps in a day'
300            IF(lwp) WRITE(numout,*) ' '
301         ENDIF
302         IF(lwp) WRITE(numout,*) '           bulk computation frequency       nfbulk  = ', nfbulk, ' = nfice if ice model used'
303         IF(lwp) WRITE(numout,*) '           flag closed sea or not           nclosea = ', nclosea
304      ENDIF
305
306      ! Default values
307      n_cla = 0
308
309      ! Namelist cross land advection
310      REWIND( numnam )
311      READ  ( numnam, namcla )
312      IF(lwp) THEN
313         WRITE(numout,*)
314         WRITE(numout,*) '        Namelist namcla'
315         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
316      ENDIF
317
318   END SUBROUTINE dom_nam
319
320
321   SUBROUTINE dom_ctl
322      !!----------------------------------------------------------------------
323      !!                     ***  ROUTINE dom_ctl  ***
324      !!
325      !! ** Purpose :   Domain control.
326      !!
327      !! ** Method  :   compute and print extrema of masked scale factors
328      !!
329      !! History :
330      !!   8.5  !  02-08  (G. Madec)    Original code
331      !!----------------------------------------------------------------------
332      !! * Local declarations
333      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
334      INTEGER, DIMENSION(2) ::   iloc      !
335      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
336      !!----------------------------------------------------------------------
337
338      ! Extrema of the scale factors
339
340      IF(lwp)WRITE(numout,*)
341      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
342      IF(lwp)WRITE(numout,*) '~~~~~~~'
343
344      IF (lk_mpp) THEN
345         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
346         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
347         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
348         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
349      ELSE
350         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
351         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
352         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
353         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
354
355         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
356         iimi1 = iloc(1) + nimpp - 1
357         ijmi1 = iloc(2) + njmpp - 1
358         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
359         iimi2 = iloc(1) + nimpp - 1
360         ijmi2 = iloc(2) + njmpp - 1
361         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
362         iima1 = iloc(1) + nimpp - 1
363         ijma1 = iloc(2) + njmpp - 1
364         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
365         iima2 = iloc(1) + nimpp - 1
366         ijma2 = iloc(2) + njmpp - 1
367      ENDIF
368
369      IF(lwp) THEN
370         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
371         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
372         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
373         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
374      ENDIF
375
376   END SUBROUTINE dom_ctl
377
378   !!======================================================================
379END MODULE domain
Note: See TracBrowser for help on using the repository browser.