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 @ 177

Last change on this file since 177 was 112, checked in by opalod, 20 years ago
CT : UPDATE071 : Add a warning when nfice is NOT a multiple of the number of time steps in a day
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 16.6 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 , LODYC-IPSL (2003)
40	!!----------------------------------------------------------------------
41
42	CONTAINS
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	#elif defined key_dynspg_rl
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	#if defined key_trd_vor
117	! Inverse of the local depth
118	hur(:,:) = fse3u(:,:,1) ! Lower bound : thickness of the first model level
119	hvr(:,:) = fse3v(:,:,1)
120
121	DO jk = 2, jpk ! Sum of the vertical scale factors
122	hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
123	hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
124	END DO
125
126	! Compute and mask the inverse of the local depth
127	hur(:,:) = 1. / hur(:,:) * umask(:,:,1)
128	hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1)
129	#endif
130
131	CALL dom_stp ! Time step
132
133	IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file
134
135	IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
136
137	END SUBROUTINE dom_init
138
139
140	SUBROUTINE dom_nam
141	!!----------------------------------------------------------------------
142	!! * ROUTINE dom_nam *
143	!!
144	!! ** Purpose : read domaine namelists and print the variables.
145	!!
146	!! ** input : - namrun namelist
147	!! - namdom namelist
148	!! - namcla namelist
149	!!
150	!! History :
151	!! 9.0 ! 03-08 (G. Madec) Original code
152	!!----------------------------------------------------------------------
153	!! * Modules used
154	#if ! defined key_fdir
155	USE ioipsl
156	#endif
157	NAMELIST/namrun/ no , cexper , ln_rstart , nrstdt , nit000, &
158	& nitend, ndate0 , nleapy , ninist , nstock, &
159	& nprint, nwrite , nrunoff , ln_ctl , nictl , njctl, &
160	& nbench
161	NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, ngrid , nmsh , &
162	& nacc , atfp , rdt , rdtmin , rdtmax, &
163	& rdth , nfice , nfbulk , nclosea
164	NAMELIST/namcla/ n_cla
165	!!----------------------------------------------------------------------
166
167	IF(lwp) THEN
168	WRITE(numout,*)
169	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
170	WRITE(numout,*) '~~~~~~~ '
171	ENDIF
172
173	! Namelist namrun : parameters of the run
174	REWIND( numnam )
175	READ ( numnam, namrun )
176
177	IF(lwp) THEN
178	WRITE(numout,*) ' Namelist namrun'
179	WRITE(numout,*) ' job number no = ', no
180	WRITE(numout,*) ' experiment name for output cexper = ', cexper
181	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
182	WRITE(numout,*) ' control of time step nrstdt = ', nrstdt
183	WRITE(numout,*) ' number of the first time step nit000 = ', nit000
184	WRITE(numout,*) ' number of the last time step nitend = ', nitend
185	WRITE(numout,*) ' initial calendar date aammjj ndate0 = ', ndate0
186	WRITE(numout,*) ' leap year calendar (0/1) nleapy = ', nleapy
187	WRITE(numout,*) ' initial state output ninist = ', ninist
188	WRITE(numout,*) ' level of print nprint = ', nprint
189	WRITE(numout,*) ' frequency of restart file nstock = ', nstock
190	WRITE(numout,*) ' frequency of output file nwrite = ', nwrite
191	WRITE(numout,*) ' runoff option nrunoff = ', nrunoff
192	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
193	WRITE(numout,*) ' Max i indice for SUM control nictl = ', nictl
194	WRITE(numout,*) ' Max j indice for SUM control njctl = ', njctl
195	WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench
196	ENDIF
197
198	l_ctl = ln_ctl .AND. lwp ! trend control print on the 1st processor only
199
200	ndastp = ndate0 ! Assign initial date to current date
201
202
203	! ... Control of output frequency
204	IF ( nstock == 0 ) THEN
205	IF(lwp)WRITE(numout,cform_war)
206	IF(lwp)WRITE(numout,*) ' nstock = ', nstock, ' it is forced to ', nitend
207	nstock = nitend
208	nwarn = nwarn + 1
209	ENDIF
210	IF ( nwrite == 0 ) THEN
211	IF(lwp)WRITE(numout,cform_war)
212	IF(lwp)WRITE(numout,*) ' nwrite = ', nwrite, ' it is forced to ', nitend
213	nwrite = nitend
214	nwarn = nwarn + 1
215	ENDIF
216
217	#if ! defined key_fdir
218
219	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
220	CASE ( 1 )
221	CALL ioconf_calendar('gregorian')
222	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
223	CASE ( 0 )
224	CALL ioconf_calendar('noleap')
225	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
226	CASE ( 30 )
227	CALL ioconf_calendar('360d')
228	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
229	END SELECT
230	#endif
231
232	SELECT CASE ( nleapy ) ! year=raajjdays day=rjjhhhours hour=rhhmm*minutes etc ...
233	CASE ( 1 )
234	raajj = 365.25
235	raass = raajj * rjjss
236	rmoss = raass/raamo
237	CASE ( 0 )
238	raajj = 365.
239	raass = raajj * rjjss
240	rmoss = raass/raamo
241	CASE DEFAULT
242	raajj = FLOAT( nleapy ) * raamo
243	raass = raajj * rjjss
244	rmoss = FLOAT( nleapy ) * rjjss
245	END SELECT
246	IF(lwp) THEN
247	WRITE(numout,*)
248	WRITE(numout,*) ' nb of days per year raajj = ', raajj,' days'
249	WRITE(numout,*) ' nb of seconds per year raass = ', raass, ' s'
250	WRITE(numout,*) ' nb of seconds per month rmoss = ', rmoss, ' s'
251	ENDIF
252
253	! ... Control the Max i and j indices used for the SUM control (i.e. when ln_ctl=.true.)
254	IF ( nictl > jpim1 ) THEN
255	IF(lwp) THEN
256	WRITE(numout,cform_war)
257	WRITE(numout,*) ' nictl = ', nictl, ' must be <= to jpim1 '
258	WRITE(numout,*) ' nictl forced to be equal to jpim1 '
259	ENDIF
260	nwarn = nwarn + 1
261	nictl = jpim1
262	ENDIF
263
264	IF ( njctl > jpjm1 ) THEN
265	IF(lwp) THEN
266	WRITE(numout,cform_war)
267	WRITE(numout,*) ' njctl = ', njctl, ' must be <= to jpjm1 '
268	WRITE(numout,*) ' njctl forced to be equal to jpjm1 '
269	ENDIF
270	nwarn = nwarn + 1
271	njctl = jpjm1
272	ENDIF
273
274	! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
275	REWIND( numnam )
276	READ ( numnam, namdom )
277
278	IF(lwp) THEN
279	WRITE(numout,*)
280	WRITE(numout,*) ' Namelist namdom'
281	WRITE(numout,*) ' flag read/compute bathymetry ntopo = ', ntopo
282	WRITE(numout,*) ' minimum thickness of partial e3zps_min = ', e3zps_min, ' (m)'
283	WRITE(numout,*) ' step level e3zps_rat = ', e3zps_rat
284	WRITE(numout,*) ' flag read/compute coordinates ngrid = ', ngrid
285	WRITE(numout,*) ' flag write mesh/mask file(s) nmsh = ', nmsh
286	WRITE(numout,*) ' = 0 no file created '
287	WRITE(numout,*) ' = 1 mesh_mask '
288	WRITE(numout,*) ' = 2 mesh and mask '
289	WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask '
290	WRITE(numout,*) ' acceleration of converge nacc = ', nacc
291	WRITE(numout,*) ' asselin time filter parameter atfp = ', atfp
292	WRITE(numout,*) ' time step rdt = ', rdt
293	WRITE(numout,*) ' minimum time step on tracers rdtmin = ', rdtmin
294	WRITE(numout,*) ' maximum time step on tracers rdtmax = ', rdtmax
295	WRITE(numout,*) ' depth variation tracer step rdth = ', rdth
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	ENDIF
305	IF(lwp)WRITE(numout,*) ' bulk computation frequency nfbulk = ', nfbulk, ' = nfice if ice model used'
306	IF(lwp)WRITE(numout,*) ' flag closed sea or not nclosea = ', nclosea
307	ENDIF
308
309	! Default values
310	n_cla = 0
311
312	! Namelist cross land advection
313	REWIND( numnam )
314	READ ( numnam, namcla )
315	IF(lwp) THEN
316	WRITE(numout,*)
317	WRITE(numout,*) ' Namelist namcla'
318	WRITE(numout,*) ' cross land advection n_cla = ',n_cla
319	ENDIF
320
321	END SUBROUTINE dom_nam
322
323
324	SUBROUTINE dom_ctl
325	!!----------------------------------------------------------------------
326	!! * ROUTINE dom_ctl *
327	!!
328	!! ** Purpose : Domain control.
329	!!
330	!! ** Method : compute and print extrema of masked scale factors
331	!!
332	!! History :
333	!! 8.5 ! 02-08 (G. Madec) Original code
334	!!----------------------------------------------------------------------
335	!! * Local declarations
336	INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
337	INTEGER, DIMENSION(2) :: iloc !
338	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
339	!!----------------------------------------------------------------------
340
341	! Extrema of the scale factors
342
343	IF(lwp)WRITE(numout,*)
344	IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
345	IF(lwp)WRITE(numout,*) '~~~~~~~'
346	ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
347	ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
348	ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
349	ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
350
351	IF( lk_mpp ) CALL mpp_min( ze1min ) ! min over the global domain
352	IF( lk_mpp ) CALL mpp_min( ze2min )
353	IF( lk_mpp ) CALL mpp_max( ze1max ) ! max over the global domain
354	IF( lk_mpp ) CALL mpp_max( ze2max )
355
356	iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
357	iimi1 = iloc(1) + nimpp - 1
358	ijmi1 = iloc(2) + njmpp - 1
359	iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
360	iimi2 = iloc(1) + nimpp - 1
361	ijmi2 = iloc(2) + njmpp - 1
362	iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
363	iima1 = iloc(1) + nimpp - 1
364	ijma1 = iloc(2) + njmpp - 1
365	iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
366	iima2 = iloc(1) + nimpp - 1
367	ijma2 = iloc(2) + njmpp - 1
368
369	IF( lk_mpp ) THEN
370	!CT bug CALL mpp_isl( iimi1 )
371	!CT bug CALL mpp_isl( ijmi1 )
372	!CT bug CALL mpp_isl( iimi2 )
373	!CT bug CALL mpp_isl( ijmi2 )
374	!CT bug CALL mpp_isl( iima1 )
375	!CT bug CALL mpp_isl( ijma1 )
376	!CT bug CALL mpp_isl( iima2 )
377	!CT bug CALL mpp_isl( ijma2 )
378	ENDIF
379
380	IF(lwp) THEN
381	IF(lk_mpp) THEN
382	WRITE(numout,cform_war)
383	WRITE(numout,*)' Min(Max) of e1t, e2t are those of the first proc only'
384	WRITE(numout,*)
385	END IF
386	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i3,' j= ',i3)") ze1max, iima1, ijma1
387	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i3,' j= ',i3)") ze1min, iimi1, ijmi1
388	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i3,' j= ',i3)") ze2max, iima2, ijma2
389	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i3,' j= ',i3)") ze2min, iimi2, ijmi2
390	ENDIF
391
392	END SUBROUTINE dom_ctl
393
394	!!======================================================================
395	END MODULE domain

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

Download in other formats: