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 on Ticket #374 – Attachment – NEMO

Ticket #374: domain.F90

File domain.F90, 14.2 KB (added by ed.blockley, 15 years ago)

DOM/domain.F90

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 ice_oce         ! ice variables
16   USE sbc_oce         ! surface boundary condition: ocean
17   USE phycst          ! physical constants
18   USE in_out_manager  ! I/O manager
19   USE lib_mpp         ! distributed memory computing library
20
21   USE domhgr          ! domain: set the horizontal mesh
22   USE domzgr          ! domain: set the vertical mesh
23   USE domstp          ! domain: set the time-step
24   USE dommsk          ! domain: set the mask system
25   USE domwri          ! domain: write the meshmask file
26   USE closea          ! closed sea or lake              (dom_clo routine)
27   USE domvvl          ! variable volume
28
29   IMPLICIT NONE
30   PRIVATE
31
32   !! * Routine accessibility
33   PUBLIC dom_init       ! called by opa.F90
34
35   !! * Substitutions
36#  include "domzgr_substitute.h90"
37   !!----------------------------------------------------------------------
38   !!   OPA 9.0 , LOCEAN-IPSL (2005)
39   !! $Id: domain.F90 1312 2009-02-16 16:35:36Z smasson $
40   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
41   !!----------------------------------------------------------------------
42
43CONTAINS
44
45   SUBROUTINE dom_init
46      !!----------------------------------------------------------------------
47      !!                  ***  ROUTINE dom_init  ***
48      !!                   
49      !! ** Purpose :   Domain initialization. Call the routines that are
50      !!      required to create the arrays which define the space and time
51      !!      domain of the ocean model.
52      !!
53      !! ** Method  :
54      !!      - dom_msk: compute the masks from the bathymetry file
55      !!      - dom_hgr: compute or read the horizontal grid-point position and
56      !!                scale factors, and the coriolis factor
57      !!      - dom_zgr: define the vertical coordinate system and the bathymetry
58      !!      - dom_stp: defined the model time step
59      !!      - dom_wri: create the meshmask file if nmsh=1
60      !!
61      !! History :
62      !!        !  90-10  (C. Levy - G. Madec)  Original code
63      !!        !  91-11  (G. Madec)
64      !!        !  92-01  (M. Imbard) insert time step initialization
65      !!        !  96-06  (G. Madec) generalized vertical coordinate
66      !!        !  97-02  (G. Madec) creation of domwri.F
67      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
68      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
69      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
70      !!----------------------------------------------------------------------
71      !! * Local declarations
72      INTEGER ::   jk                ! dummy loop argument
73      INTEGER ::   iconf = 0         ! temporary integers
74      !!----------------------------------------------------------------------
75
76      IF(lwp) THEN
77         WRITE(numout,*)
78         WRITE(numout,*) 'dom_init : domain initialization'
79         WRITE(numout,*) '~~~~~~~~'
80      ENDIF
81
82      CALL dom_nam                        ! read namelist ( namrun, namdom, namcla )
83
84      CALL dom_clo                        ! Closed seas and lake
85
86      CALL dom_hgr                        ! Horizontal mesh
87
88      CALL dom_zgr                        ! Vertical mesh and bathymetry
89
90      CALL dom_msk                        ! Masks
91
92      IF( lk_vvl )   CALL dom_vvl_ini     ! Vertical variable mesh
93
94      ! Local depth or Inverse of the local depth of the water column at u- and v-points
95      ! ------------------------------
96      ! Ocean depth at U- and V-points
97      hu(:,:) = 0.
98      hv(:,:) = 0.
99
100      DO jk = 1, jpk
101         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
102         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
103      END DO
104      ! Inverse of the local depth
105      hur(:,:) = fse3u(:,:,1)             ! Lower bound : thickness of the first model level
106      hvr(:,:) = fse3v(:,:,1)
107
108      DO jk = 2, jpk                      ! Sum of the vertical scale factors
109         hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
110         hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
111      END DO
112
113      ! Compute and mask the inverse of the local depth
114      hur(:,:) = 1. / hur(:,:) * umask(:,:,1)
115      hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1)
116
117
118      CALL dom_stp                        ! Time step
119
120      IF( nmsh /= 0 )   CALL dom_wri      ! Create a domain file
121
122      IF( .NOT.ln_rstart )   CALL dom_ctl    ! Domain control
123
124   END SUBROUTINE dom_init
125
126
127   SUBROUTINE dom_nam
128      !!----------------------------------------------------------------------
129      !!                     ***  ROUTINE dom_nam  ***
130      !!                   
131      !! ** Purpose :   read domaine namelists and print the variables.
132      !!
133      !! ** input   : - namrun namelist
134      !!              - namdom namelist
135      !!              - namcla namelist
136      !!
137      !! History :
138      !!   9.0  !  03-08  (G. Madec)  Original code
139      !!----------------------------------------------------------------------
140      !! * Modules used
141      USE ioipsl
142      NAMELIST/namrun/ no    , cexper, cn_ocerst_in, cn_ocerst_out, ln_rstart, nrstdt,   &
143         &             nit000, nitend, ndate0      , nleapy       , ninist   , nstock,   &
144         &             nwrite, ln_dimgnnn, ln_mskland, iom_nf90_chunk
145
146      NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, nmsh   ,   &
147         &             nacc  , atfp     , rdt      , rdtmin ,   &
148         &             rdtmax, rdth     , nn_baro  , nclosea
149      NAMELIST/namcla/ n_cla
150      !!----------------------------------------------------------------------
151
152      IF(lwp) THEN
153         WRITE(numout,*)
154         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
155         WRITE(numout,*) '~~~~~~~ '
156      ENDIF
157
158      ! Namelist namrun : parameters of the run
159      REWIND( numnam )
160      READ  ( numnam, namrun )
161
162      IF(lwp) THEN
163         WRITE(numout,*) '        Namelist namrun'
164         WRITE(numout,*) '           job number                      no        = ', no
165         WRITE(numout,*) '           experiment name for output      cexper    = ', cexper
166         WRITE(numout,*) '           restart logical                 ln_rstart = ', ln_rstart
167         WRITE(numout,*) '           control of time step            nrstdt    = ', nrstdt
168         WRITE(numout,*) '           number of the first time step   nit000    = ', nit000
169         WRITE(numout,*) '           number of the last time step    nitend    = ', nitend
170         WRITE(numout,*) '           initial calendar date aammjj    ndate0    = ', ndate0
171         WRITE(numout,*) '           leap year calendar (0/1)        nleapy    = ', nleapy
172         WRITE(numout,*) '           initial state output            ninist    = ', ninist
173         WRITE(numout,*) '           frequency of restart file       nstock    = ', nstock
174         WRITE(numout,*) '           frequency of output file        nwrite    = ', nwrite
175         IF( iom_nf90_chunk > 0 )                                              &
176           &  WRITE(numout,*) '           IOM NF90 chunksize          iom_nf90_chunk = ', iom_nf90_chunk
177         WRITE(numout,*) '           multi file dimgout           ln_dimgnnn   = ', ln_dimgnnn
178         WRITE(numout,*) '           mask land points             ln_mskland   = ', ln_mskland
179      ENDIF
180
181      ! ... Control of output frequency
182      IF ( nstock == 0 .OR. nstock > nitend ) THEN
183         WRITE(ctmp1,*) '           nstock = ', nstock, ' it is forced to ', nitend
184         CALL ctl_warn( ctmp1 )
185         nstock = nitend
186      ENDIF
187      IF ( nwrite == 0 ) THEN
188         WRITE(ctmp1,*) '           nwrite = ', nwrite, ' it is forced to ', nitend
189         CALL ctl_warn( ctmp1 )
190         nwrite = nitend
191      ENDIF
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      SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ...
212      CASE ( 1 )
213         raajj = 365.25
214         raass = raajj * rjjss
215         rmoss = raass/raamo
216      CASE ( 0 )
217         raajj = 365.
218         raass = raajj * rjjss
219         rmoss = raass/raamo
220      CASE DEFAULT
221         raajj = FLOAT( nleapy ) * raamo
222         raass =        raajj    * rjjss
223         rmoss = FLOAT( nleapy ) * rjjss
224      END SELECT
225      IF(lwp) THEN
226         WRITE(numout,*)
227         WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days'
228         WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s'
229         WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s'
230      ENDIF
231
232      ! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
233      REWIND( numnam )
234      READ  ( numnam, namdom )
235
236      IF(lwp) THEN
237         WRITE(numout,*)
238         WRITE(numout,*) '        Namelist namdom'
239         WRITE(numout,*) '           flag read/compute bathymetry   ntopo     = ', ntopo
240         WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)'
241         WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat
242         WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh
243         WRITE(numout,*) '                = 0   no file created                 '
244         WRITE(numout,*) '                = 1   mesh_mask                       '
245         WRITE(numout,*) '                = 2   mesh and mask                   '
246         WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      '
247         WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc
248         WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp
249         WRITE(numout,*) '           time step                      rdt       = ', rdt
250         WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin
251         WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax
252         WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth
253         WRITE(numout,*) '           number of barotropic time step nn_baro   = ', nn_baro
254      ENDIF
255
256      ! Default values
257      n_cla = 0
258
259      ! Namelist cross land advection
260      REWIND( numnam )
261      READ  ( numnam, namcla )
262      IF(lwp) THEN
263         WRITE(numout,*)
264         WRITE(numout,*) '        Namelist namcla'
265         WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla
266      ENDIF
267
268      IF( nbit_cmp == 1 .AND. n_cla /= 0 ) THEN
269         CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' )
270      END IF
271
272   END SUBROUTINE dom_nam
273
274
275   SUBROUTINE dom_ctl
276      !!----------------------------------------------------------------------
277      !!                     ***  ROUTINE dom_ctl  ***
278      !!
279      !! ** Purpose :   Domain control.
280      !!
281      !! ** Method  :   compute and print extrema of masked scale factors
282      !!
283      !! History :
284      !!   8.5  !  02-08  (G. Madec)    Original code
285      !!----------------------------------------------------------------------
286      !! * Local declarations
287      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
288      INTEGER, DIMENSION(2) ::   iloc      !
289      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
290      !!----------------------------------------------------------------------
291
292      ! Extrema of the scale factors
293
294      IF(lwp)WRITE(numout,*)
295      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
296      IF(lwp)WRITE(numout,*) '~~~~~~~'
297
298      IF (lk_mpp) THEN
299         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
300         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
301         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
302         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
303      ELSE
304         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
305         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
306         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
307         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
308
309         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
310         iimi1 = iloc(1) + nimpp - 1
311         ijmi1 = iloc(2) + njmpp - 1
312         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
313         iimi2 = iloc(1) + nimpp - 1
314         ijmi2 = iloc(2) + njmpp - 1
315         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
316         iima1 = iloc(1) + nimpp - 1
317         ijma1 = iloc(2) + njmpp - 1
318         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
319         iima2 = iloc(1) + nimpp - 1
320         ijma2 = iloc(2) + njmpp - 1
321      ENDIF
322
323      IF(lwp) THEN
324         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
325         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
326         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
327         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
328      ENDIF
329
330   END SUBROUTINE dom_ctl
331
332   !!======================================================================
333END MODULE domain