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

Context Navigation

source: tags/nemo_v1_05/NEMO/OPA_SRC/DOM/domain.F90 @ 3305

Last change on this file since 3305 was 258, checked in by opalod, 19 years ago
nemo_v1_update_004 : CT : Integration of the control print option for debugging work
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 18.4 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 , nictls, nictle, &
161	& njctls, njctle , nbench , isplt , jsplt
162
163	NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, ngrid , nmsh , &
164	& nacc , atfp , rdt , rdtmin , rdtmax, &
165	& rdth , nfice , nfbulk , nclosea
166	NAMELIST/namcla/ n_cla
167	!!----------------------------------------------------------------------
168
169	IF(lwp) THEN
170	WRITE(numout,*)
171	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
172	WRITE(numout,*) '~~~~~~~ '
173	ENDIF
174
175	! Namelist namrun : parameters of the run
176	REWIND( numnam )
177	READ ( numnam, namrun )
178
179	IF(lwp) THEN
180	WRITE(numout,*) ' Namelist namrun'
181	WRITE(numout,*) ' job number no = ', no
182	WRITE(numout,*) ' experiment name for output cexper = ', cexper
183	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
184	WRITE(numout,*) ' control of time step nrstdt = ', nrstdt
185	WRITE(numout,*) ' number of the first time step nit000 = ', nit000
186	WRITE(numout,*) ' number of the last time step nitend = ', nitend
187	WRITE(numout,*) ' initial calendar date aammjj ndate0 = ', ndate0
188	WRITE(numout,*) ' leap year calendar (0/1) nleapy = ', nleapy
189	WRITE(numout,*) ' initial state output ninist = ', ninist
190	WRITE(numout,*) ' level of print nprint = ', nprint
191	WRITE(numout,*) ' frequency of restart file nstock = ', nstock
192	WRITE(numout,*) ' frequency of output file nwrite = ', nwrite
193	WRITE(numout,*) ' runoff option nrunoff = ', nrunoff
194	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
195	WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls
196	WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle
197	WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls
198	WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle
199	WRITE(numout,*) ' number of proc. following i isplt = ', isplt
200	WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt
201	WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench
202	ENDIF
203
204	ndastp = ndate0 ! Assign initial date to current date
205
206	! ... Control the sub-domain area indices for the print control
207	IF(ln_ctl) THEN
208	IF( lk_mpp ) THEN
209	! the domain is forced to the real splitted domain in MPI
210	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
211	ELSE
212	IF( isplt == 1 .AND. jsplt == 1 ) THEN
213	IF(lwp) WRITE(numout,cform_war)
214	IF(lwp) WRITE(numout,*)' - isplt & jsplt are equal to 1'
215	IF(lwp) WRITE(numout,*)' - the print control will be done over the whole domain'
216	IF(lwp) WRITE(numout,*)
217	ENDIF
218
219	! compute the total number of processors ijsplt
220	ijsplt = isplt*jsplt
221	ENDIF
222
223	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
224	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
225
226	! Control the indices used for the SUM control
227	IF( nictls+nictle+njctls+njctle == 0 ) THEN
228	! the print control is done over the default area
229	lsp_area = .FALSE.
230	ELSE
231	! the print control is done over a specific area
232	lsp_area = .TRUE.
233	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
234	IF(lwp) WRITE(numout,cform_war)
235	IF(lwp) WRITE(numout,*)' - nictls must be 1<=nictls>=jpiglo, it is forced to 1'
236	IF(lwp) WRITE(numout,*)
237	nwarn = nwarn + 1
238	nictls = 1
239	ENDIF
240
241	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
242	IF(lwp) WRITE(numout,cform_war)
243	IF(lwp) WRITE(numout,*)' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo'
244	IF(lwp) WRITE(numout,*)
245	nwarn = nwarn + 1
246	nictle = jpjglo
247	ENDIF
248
249	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
250	IF(lwp) WRITE(numout,cform_war)
251	IF(lwp) WRITE(numout,*)' - njctls must be 1<=njctls>=jpjglo, it is forced to 1'
252	IF(lwp) WRITE(numout,*)
253	nwarn = nwarn + 1
254	njctls = 1
255	ENDIF
256
257	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
258	IF(lwp) WRITE(numout,cform_war)
259	IF(lwp) WRITE(numout,*)' - njctle must be 1<=njctle>= jpjglo, it is forced to jpjglo'
260	IF(lwp) WRITE(numout,*)
261	nwarn = nwarn + 1
262	njctle = jpjglo
263	ENDIF
264
265	ENDIF ! IF( nictls+nictle+njctls+njctle == 0 )
266	ENDIF ! IF(ln_ctl)
267
268	! ... Control of output frequency
269	IF ( nstock == 0 ) THEN
270	IF(lwp)WRITE(numout,cform_war)
271	IF(lwp)WRITE(numout,*) ' nstock = ', nstock, ' it is forced to ', nitend
272	nstock = nitend
273	nwarn = nwarn + 1
274	ENDIF
275	IF ( nwrite == 0 ) THEN
276	IF(lwp)WRITE(numout,cform_war)
277	IF(lwp)WRITE(numout,*) ' nwrite = ', nwrite, ' it is forced to ', nitend
278	nwrite = nitend
279	nwarn = nwarn + 1
280	ENDIF
281
282	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
283	CASE ( 1 )
284	CALL ioconf_calendar('gregorian')
285	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
286	CASE ( 0 )
287	CALL ioconf_calendar('noleap')
288	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
289	CASE ( 30 )
290	CALL ioconf_calendar('360d')
291	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
292	END SELECT
293
294	SELECT CASE ( nleapy ) ! year=raajjdays day=rjjhhhours hour=rhhmm*minutes etc ...
295	CASE ( 1 )
296	raajj = 365.25
297	raass = raajj * rjjss
298	rmoss = raass/raamo
299	CASE ( 0 )
300	raajj = 365.
301	raass = raajj * rjjss
302	rmoss = raass/raamo
303	CASE DEFAULT
304	raajj = FLOAT( nleapy ) * raamo
305	raass = raajj * rjjss
306	rmoss = FLOAT( nleapy ) * rjjss
307	END SELECT
308	IF(lwp) THEN
309	WRITE(numout,*)
310	WRITE(numout,*) ' nb of days per year raajj = ', raajj,' days'
311	WRITE(numout,*) ' nb of seconds per year raass = ', raass, ' s'
312	WRITE(numout,*) ' nb of seconds per month rmoss = ', rmoss, ' s'
313	ENDIF
314
315	! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
316	REWIND( numnam )
317	READ ( numnam, namdom )
318
319	IF(lwp) THEN
320	WRITE(numout,*)
321	WRITE(numout,*) ' Namelist namdom'
322	WRITE(numout,*) ' flag read/compute bathymetry ntopo = ', ntopo
323	WRITE(numout,*) ' minimum thickness of partial e3zps_min = ', e3zps_min, ' (m)'
324	WRITE(numout,*) ' step level e3zps_rat = ', e3zps_rat
325	WRITE(numout,*) ' flag read/compute coordinates ngrid = ', ngrid
326	WRITE(numout,*) ' flag write mesh/mask file(s) nmsh = ', nmsh
327	WRITE(numout,*) ' = 0 no file created '
328	WRITE(numout,*) ' = 1 mesh_mask '
329	WRITE(numout,*) ' = 2 mesh and mask '
330	WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask '
331	WRITE(numout,*) ' acceleration of converge nacc = ', nacc
332	WRITE(numout,*) ' asselin time filter parameter atfp = ', atfp
333	WRITE(numout,*) ' time step rdt = ', rdt
334	WRITE(numout,*) ' minimum time step on tracers rdtmin = ', rdtmin
335	WRITE(numout,*) ' maximum time step on tracers rdtmax = ', rdtmax
336	WRITE(numout,*) ' depth variation tracer step rdth = ', rdth
337	ENDIF
338
339	IF( lk_ice_lim ) THEN
340	IF(lwp) WRITE(numout,*) ' ice model coupling frequency nfice = ', nfice
341	nfbulk = nfice
342	IF( MOD( rday, nfice*rdt ) /= 0 ) THEN
343	IF(lwp) WRITE(numout,*) ' '
344	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'
345	IF(lwp) WRITE(numout,*) ' '
346	ENDIF
347	IF(lwp) WRITE(numout,*) ' bulk computation frequency nfbulk = ', nfbulk, ' = nfice if ice model used'
348	IF(lwp) WRITE(numout,*) ' flag closed sea or not nclosea = ', nclosea
349	ENDIF
350
351	! Default values
352	n_cla = 0
353
354	! Namelist cross land advection
355	REWIND( numnam )
356	READ ( numnam, namcla )
357	IF(lwp) THEN
358	WRITE(numout,*)
359	WRITE(numout,*) ' Namelist namcla'
360	WRITE(numout,*) ' cross land advection n_cla = ',n_cla
361	ENDIF
362
363	END SUBROUTINE dom_nam
364
365
366	SUBROUTINE dom_ctl
367	!!----------------------------------------------------------------------
368	!! * ROUTINE dom_ctl *
369	!!
370	!! ** Purpose : Domain control.
371	!!
372	!! ** Method : compute and print extrema of masked scale factors
373	!!
374	!! History :
375	!! 8.5 ! 02-08 (G. Madec) Original code
376	!!----------------------------------------------------------------------
377	!! * Local declarations
378	INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
379	INTEGER, DIMENSION(2) :: iloc !
380	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
381	!!----------------------------------------------------------------------
382
383	! Extrema of the scale factors
384
385	IF(lwp)WRITE(numout,*)
386	IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
387	IF(lwp)WRITE(numout,*) '~~~~~~~'
388
389	IF (lk_mpp) THEN
390	CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
391	CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
392	CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
393	CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
394	ELSE
395	ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
396	ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
397	ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
398	ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
399
400	iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
401	iimi1 = iloc(1) + nimpp - 1
402	ijmi1 = iloc(2) + njmpp - 1
403	iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
404	iimi2 = iloc(1) + nimpp - 1
405	ijmi2 = iloc(2) + njmpp - 1
406	iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
407	iima1 = iloc(1) + nimpp - 1
408	ijma1 = iloc(2) + njmpp - 1
409	iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
410	iima2 = iloc(1) + nimpp - 1
411	ijma2 = iloc(2) + njmpp - 1
412	ENDIF
413
414	IF(lwp) THEN
415	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
416	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
417	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
418	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
419	ENDIF
420
421	END SUBROUTINE dom_ctl
422
423	!!======================================================================
424	END MODULE domain

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

Download in other formats: