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

Last change on this file since 222 was 216, checked in by opalod, 19 years ago
CT : UPDATE151 : New trends organization
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 , 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	# 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	#if ! defined key_fdir
156	USE ioipsl
157	#endif
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	#if ! defined key_fdir
219
220	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
221	CASE ( 1 )
222	CALL ioconf_calendar('gregorian')
223	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
224	CASE ( 0 )
225	CALL ioconf_calendar('noleap')
226	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
227	CASE ( 30 )
228	CALL ioconf_calendar('360d')
229	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
230	END SELECT
231	#endif
232
233	SELECT CASE ( nleapy ) ! year=raajjdays day=rjjhhhours hour=rhhmm*minutes etc ...
234	CASE ( 1 )
235	raajj = 365.25
236	raass = raajj * rjjss
237	rmoss = raass/raamo
238	CASE ( 0 )
239	raajj = 365.
240	raass = raajj * rjjss
241	rmoss = raass/raamo
242	CASE DEFAULT
243	raajj = FLOAT( nleapy ) * raamo
244	raass = raajj * rjjss
245	rmoss = FLOAT( nleapy ) * rjjss
246	END SELECT
247	IF(lwp) THEN
248	WRITE(numout,*)
249	WRITE(numout,*) ' nb of days per year raajj = ', raajj,' days'
250	WRITE(numout,*) ' nb of seconds per year raass = ', raass, ' s'
251	WRITE(numout,*) ' nb of seconds per month rmoss = ', rmoss, ' s'
252	ENDIF
253
254	! ... Control the Max i and j indices used for the SUM control (i.e. when ln_ctl=.true.)
255	IF ( nictl > jpim1 ) THEN
256	IF(lwp) THEN
257	WRITE(numout,cform_war)
258	WRITE(numout,*) ' nictl = ', nictl, ' must be <= to jpim1 '
259	WRITE(numout,*) ' nictl forced to be equal to jpim1 '
260	ENDIF
261	nwarn = nwarn + 1
262	nictl = jpim1
263	ENDIF
264
265	IF ( njctl > jpjm1 ) THEN
266	IF(lwp) THEN
267	WRITE(numout,cform_war)
268	WRITE(numout,*) ' njctl = ', njctl, ' must be <= to jpjm1 '
269	WRITE(numout,*) ' njctl forced to be equal to jpjm1 '
270	ENDIF
271	nwarn = nwarn + 1
272	njctl = jpjm1
273	ENDIF
274
275	! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
276	REWIND( numnam )
277	READ ( numnam, namdom )
278
279	IF(lwp) THEN
280	WRITE(numout,*)
281	WRITE(numout,*) ' Namelist namdom'
282	WRITE(numout,*) ' flag read/compute bathymetry ntopo = ', ntopo
283	WRITE(numout,*) ' minimum thickness of partial e3zps_min = ', e3zps_min, ' (m)'
284	WRITE(numout,*) ' step level e3zps_rat = ', e3zps_rat
285	WRITE(numout,*) ' flag read/compute coordinates ngrid = ', ngrid
286	WRITE(numout,*) ' flag write mesh/mask file(s) nmsh = ', nmsh
287	WRITE(numout,*) ' = 0 no file created '
288	WRITE(numout,*) ' = 1 mesh_mask '
289	WRITE(numout,*) ' = 2 mesh and mask '
290	WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask '
291	WRITE(numout,*) ' acceleration of converge nacc = ', nacc
292	WRITE(numout,*) ' asselin time filter parameter atfp = ', atfp
293	WRITE(numout,*) ' time step rdt = ', rdt
294	WRITE(numout,*) ' minimum time step on tracers rdtmin = ', rdtmin
295	WRITE(numout,*) ' maximum time step on tracers rdtmax = ', rdtmax
296	WRITE(numout,*) ' depth variation tracer step rdth = ', rdth
297	IF( lk_ice_lim ) THEN
298	IF(lwp)WRITE(numout,*) ' ice model coupling frequency nfice = ', nfice
299	nfbulk = nfice
300	IF ( MOD( rday, nfice*rdt ) /= 0) THEN
301	IF(lwp)WRITE(numout,*) ' '
302	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'
303	IF(lwp)WRITE(numout,*) ' '
304	ENDIF
305	ENDIF
306	IF(lwp)WRITE(numout,*) ' bulk computation frequency nfbulk = ', nfbulk, ' = nfice if ice model used'
307	IF(lwp)WRITE(numout,*) ' flag closed sea or not nclosea = ', nclosea
308	ENDIF
309
310	! Default values
311	n_cla = 0
312
313	! Namelist cross land advection
314	REWIND( numnam )
315	READ ( numnam, namcla )
316	IF(lwp) THEN
317	WRITE(numout,*)
318	WRITE(numout,*) ' Namelist namcla'
319	WRITE(numout,*) ' cross land advection n_cla = ',n_cla
320	ENDIF
321
322	END SUBROUTINE dom_nam
323
324
325	SUBROUTINE dom_ctl
326	!!----------------------------------------------------------------------
327	!! * ROUTINE dom_ctl *
328	!!
329	!! ** Purpose : Domain control.
330	!!
331	!! ** Method : compute and print extrema of masked scale factors
332	!!
333	!! History :
334	!! 8.5 ! 02-08 (G. Madec) Original code
335	!!----------------------------------------------------------------------
336	!! * Local declarations
337	INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
338	INTEGER, DIMENSION(2) :: iloc !
339	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
340	!!----------------------------------------------------------------------
341
342	! Extrema of the scale factors
343
344	IF(lwp)WRITE(numout,*)
345	IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
346	IF(lwp)WRITE(numout,*) '~~~~~~~'
347
348	IF (lk_mpp) THEN
349	CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
350	CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
351	CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
352	CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
353	ELSE
354	ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
355	ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
356	ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
357	ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
358
359	iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
360	iimi1 = iloc(1) + nimpp - 1
361	ijmi1 = iloc(2) + njmpp - 1
362	iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
363	iimi2 = iloc(1) + nimpp - 1
364	ijmi2 = iloc(2) + njmpp - 1
365	iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
366	iima1 = iloc(1) + nimpp - 1
367	ijma1 = iloc(2) + njmpp - 1
368	iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
369	iima2 = iloc(1) + nimpp - 1
370	ijma2 = iloc(2) + njmpp - 1
371	ENDIF
372
373	IF(lwp) THEN
374	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
375	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
376	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
377	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
378	ENDIF
379
380	END SUBROUTINE dom_ctl
381
382	!!======================================================================
383	END MODULE domain

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

Download in other formats: