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

Context Navigation

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

Last change on this file since 247 was 247, checked in by opalod, 19 years ago
CL : Add CVS Header and CeCILL licence information
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 16.2 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: