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/OFF_SRC/DOM – NEMO

Context Navigation

source: trunk/NEMO/OFF_SRC/DOM/domain.F90 @ 719

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago
get back to the nemo_v2_3 version for trunk
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 17.0 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 daymod ! calendar
18	USE lib_mpp ! distributed memory computing library
19	USE flxrnf ! runoffs
20
21	USE domstp ! domain: set the time-step
22	USE domrea ! domain: write the meshmask file
23	USE dommsk ! domain : mask
24
25	IMPLICIT NONE
26	PRIVATE
27
28	!! * Routine accessibility
29	PUBLIC dom_init ! called by opa.F90
30
31	!! * Module variables
32	REAL(wp) :: & !!: Namelist nam_zgr_sco
33	sbot_min = 300. , & !: minimum depth of s-bottom surface (>0) (m)
34	sbot_max = 5250. , & !: maximum depth of s-bottom surface (= ocean depth) (>0) (m)
35	theta = 6.0 , & !: surface control parameter (0<=theta<=20)
36	thetb = 0.75, & !: bottom control parameter (0<=thetb<= 1)
37	r_max = 0.15 !: maximum cut-off r-value allowed (0<r_max<1)
38
39
40	!! * Substitutions
41	# include "domzgr_substitute.h90"
42	!!----------------------------------------------------------------------
43	!! OPA 9.0 , LOCEAN-IPSL (2005)
44	!! $Header$
45	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
46	!!----------------------------------------------------------------------
47
48	CONTAINS
49
50	SUBROUTINE dom_init
51	!!----------------------------------------------------------------------
52	!! * ROUTINE dom_init *
53	!!
54	!! ** Purpose : Domain initialization. Call the routines that are
55	!! required to create the arrays which define the space and time
56	!! domain of the ocean model.
57	!!
58	!! ** Method :
59	!! - dom_stp: defined the model time step
60	!! - dom_rea: read 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 :: iconf = 0 ! temporary integers
73	!!----------------------------------------------------------------------
74
75	IF(lwp) THEN
76	WRITE(numout,*)
77	WRITE(numout,*) 'dom_init : domain initialization'
78	WRITE(numout,*) '~~~~~~~~'
79	ENDIF
80
81	CALL dom_nam ! read namelist ( namrun, namdom, namcla )
82
83	CALL dom_stp ! Time step
84
85	CALL dom_rea ! Create a domain file
86
87	CALL dom_msk ! Masks
88
89	CALL dom_ctl ! Domain control
90
91	END SUBROUTINE dom_init
92
93
94	SUBROUTINE dom_nam
95	!!----------------------------------------------------------------------
96	!! * ROUTINE dom_nam *
97	!!
98	!! ** Purpose : read domaine namelists and print the variables.
99	!!
100	!! ** input : - namrun namelist
101	!! - namdom namelist
102	!! - namcla namelist
103	!!
104	!! History :
105	!! 9.0 ! 03-08 (G. Madec) Original code
106	!!----------------------------------------------------------------------
107	!! * Modules used
108	USE ioipsl
109	INTEGER :: ioptio = 0 ! temporary integer
110
111	NAMELIST/nam_run/ no , cexper , ln_rstart , nrstdt , nit000, &
112	& nitend, ndate0 , nleapy , ninist , nstock, &
113	& nprint, nwrite , nrunoff , ln_ctl , nictls, nictle, &
114	& njctls, njctle , nbench , isplt , jsplt
115
116	NAMELIST/nam_zgr/ ln_zco, ln_zps, ln_sco
117
118	NAMELIST/nam_dom/ e3zps_min, e3zps_rat, nmsh , &
119	& nacc , atfp , rdt , rdtmin , rdtmax, &
120	& rdth
121
122	NAMELIST/nam_cla/ n_cla
123	!!----------------------------------------------------------------------
124
125	IF(lwp) THEN
126	WRITE(numout,*)
127	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
128	WRITE(numout,*) '~~~~~~~ '
129	ENDIF
130
131	! Namelist namrun : parameters of the run
132	REWIND( numnam )
133	READ ( numnam, nam_run )
134
135	IF(lwp) THEN
136	WRITE(numout,*) ' Namelist namrun'
137	WRITE(numout,*) ' job number no = ', no
138	WRITE(numout,*) ' experiment name for output cexper = ', cexper
139	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
140	WRITE(numout,*) ' control of time step nrstdt = ', nrstdt
141	WRITE(numout,*) ' number of the first time step nit000 = ', nit000
142	WRITE(numout,*) ' number of the last time step nitend = ', nitend
143	WRITE(numout,*) ' initial calendar date aammjj ndate0 = ', ndate0
144	WRITE(numout,*) ' leap year calendar (0/1) nleapy = ', nleapy
145	WRITE(numout,*) ' initial state output ninist = ', ninist
146	WRITE(numout,*) ' level of print nprint = ', nprint
147	WRITE(numout,*) ' frequency of restart file nstock = ', nstock
148	WRITE(numout,*) ' frequency of output file nwrite = ', nwrite
149	WRITE(numout,*) ' runoff option nrunoff = ', nrunoff
150	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
151	WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls
152	WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle
153	WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls
154	WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle
155	WRITE(numout,*) ' number of proc. following i isplt = ', isplt
156	WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt
157	WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench
158	ENDIF
159
160	ndastp = ndate0 ! Assign initial date to current date
161
162	! ... Control the sub-domain area indices for the print control
163	IF(ln_ctl) THEN
164	IF( lk_mpp ) THEN
165	! the domain is forced to the real splitted domain in MPI
166	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
167	ELSE
168	IF( isplt == 1 .AND. jsplt == 1 ) THEN
169	IF(lwp) WRITE(numout,cform_war)
170	IF(lwp) WRITE(numout,*)' - isplt & jsplt are equal to 1'
171	IF(lwp) WRITE(numout,*)' - the print control will be done over the whole domain'
172	IF(lwp) WRITE(numout,*)
173	ENDIF
174
175	! compute the total number of processors ijsplt
176	ijsplt = isplt*jsplt
177	ENDIF
178
179	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
180	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
181
182	! Control the indices used for the SUM control
183	IF( nictls+nictle+njctls+njctle == 0 ) THEN
184	! the print control is done over the default area
185	lsp_area = .FALSE.
186	ELSE
187	! the print control is done over a specific area
188	lsp_area = .TRUE.
189	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
190	IF(lwp) WRITE(numout,cform_war)
191	IF(lwp) WRITE(numout,*)' - nictls must be 1<=nictls>=jpiglo, it is forced to 1'
192	IF(lwp) WRITE(numout,*)
193	nwarn = nwarn + 1
194	nictls = 1
195	ENDIF
196
197	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
198	IF(lwp) WRITE(numout,cform_war)
199	IF(lwp) WRITE(numout,*)' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo'
200	IF(lwp) WRITE(numout,*)
201	nwarn = nwarn + 1
202	nictle = jpjglo
203	ENDIF
204
205	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
206	IF(lwp) WRITE(numout,cform_war)
207	IF(lwp) WRITE(numout,*)' - njctls must be 1<=njctls>=jpjglo, it is forced to 1'
208	IF(lwp) WRITE(numout,*)
209	nwarn = nwarn + 1
210	njctls = 1
211	ENDIF
212
213	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
214	IF(lwp) WRITE(numout,cform_war)
215	IF(lwp) WRITE(numout,*)' - njctle must be 1<=njctle>= jpjglo, it is forced to jpjglo'
216	IF(lwp) WRITE(numout,*)
217	nwarn = nwarn + 1
218	njctle = jpjglo
219	ENDIF
220
221	ENDIF ! IF( nictls+nictle+njctls+njctle == 0 )
222	ENDIF ! IF(ln_ctl)
223
224	! ... Control of output frequency
225	IF ( nstock == 0 ) THEN
226	IF(lwp)WRITE(numout,cform_war)
227	IF(lwp)WRITE(numout,*) ' nstock = ', nstock, ' it is forced to ', nitend
228	nstock = nitend
229	nwarn = nwarn + 1
230	ENDIF
231	IF ( nwrite == 0 ) THEN
232	IF(lwp)WRITE(numout,cform_war)
233	IF(lwp)WRITE(numout,*) ' nwrite = ', nwrite, ' it is forced to ', nitend
234	nwrite = nitend
235	nwarn = nwarn + 1
236	ENDIF
237
238	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
239	CASE ( 1 )
240	CALL ioconf_calendar('gregorian')
241	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
242	CASE ( 0 )
243	CALL ioconf_calendar('noleap')
244	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
245	CASE ( 30 )
246	CALL ioconf_calendar('360d')
247	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
248	END SELECT
249
250	SELECT CASE ( nleapy ) ! year=raajjdays day=rjjhhhours hour=rhhmm*minutes etc ...
251	CASE ( 1 )
252	raajj = 365.25
253	raass = raajj * rjjss
254	rmoss = raass/raamo
255	CASE ( 0 )
256	raajj = 365.
257	raass = raajj * rjjss
258	rmoss = raass/raamo
259	CASE DEFAULT
260	raajj = FLOAT( nleapy ) * raamo
261	raass = raajj * rjjss
262	rmoss = FLOAT( nleapy ) * rjjss
263	END SELECT
264	IF(lwp) THEN
265	WRITE(numout,*)
266	WRITE(numout,*) ' nb of days per year raajj = ', raajj,' days'
267	WRITE(numout,*) ' nb of seconds per year raass = ', raass, ' s'
268	WRITE(numout,*) ' nb of seconds per month rmoss = ', rmoss, ' s'
269	ENDIF
270
271	! Read Namelist nam_zgr : vertical coordinate'
272	! ---------------------
273	REWIND ( numnam )
274	READ ( numnam, nam_zgr )
275
276	! Parameter control and print
277	! ---------------------------
278	! Control print
279	IF(lwp) THEN
280	WRITE(numout,*)
281	WRITE(numout,*) 'Namelist namzgr : vertical coordinate'
282	WRITE(numout,*) '~~~~~~~'
283	WRITE(numout,*) ' Namelist nam_zgr : set vertical coordinate'
284	WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco
285	WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps
286	WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco
287	ENDIF
288
289	! Check Vertical coordinate options
290	ioptio = 0
291	IF( ln_zco ) ioptio = ioptio + 1
292	IF( ln_zps ) ioptio = ioptio + 1
293	IF( ln_sco ) ioptio = ioptio + 1
294	IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' )
295
296	IF( ln_zco ) THEN
297	IF(lwp) WRITE(numout,*) ' z-coordinate with reduced incore memory requirement'
298	IF( ln_zps .OR. ln_sco ) CALL ctl_stop( ' reduced memory with zps or sco option is impossible' )
299	ENDIF
300
301
302	! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
303	REWIND( numnam )
304	READ ( numnam, nam_dom )
305
306	IF(lwp) THEN
307	WRITE(numout,*)
308	WRITE(numout,*) ' Namelist namdom'
309	WRITE(numout,*) ' minimum thickness of partial e3zps_min = ', e3zps_min, ' (m)'
310	WRITE(numout,*) ' step level e3zps_rat = ', e3zps_rat
311	WRITE(numout,*) ' flag write mesh/mask file(s) nmsh = ', nmsh
312	WRITE(numout,*) ' = 0 no file created '
313	WRITE(numout,*) ' = 1 mesh_mask '
314	WRITE(numout,*) ' = 2 mesh and mask '
315	WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask '
316	WRITE(numout,*) ' acceleration of converge nacc = ', nacc
317	WRITE(numout,*) ' asselin time filter parameter atfp = ', atfp
318	WRITE(numout,*) ' time step rdt = ', rdt
319	WRITE(numout,*) ' minimum time step on tracers rdtmin = ', rdtmin
320	WRITE(numout,*) ' maximum time step on tracers rdtmax = ', rdtmax
321	WRITE(numout,*) ' depth variation tracer step rdth = ', rdth
322	ENDIF
323
324
325
326	! Default values
327	n_cla = 0
328
329	! Namelist cross land advection
330	REWIND( numnam )
331	READ ( numnam, nam_cla )
332	IF(lwp) THEN
333	WRITE(numout,*)
334	WRITE(numout,*) ' Namelist namcla'
335	WRITE(numout,*) ' cross land advection n_cla = ',n_cla
336	ENDIF
337
338	END SUBROUTINE dom_nam
339
340
341	SUBROUTINE dom_ctl
342	!!----------------------------------------------------------------------
343	!! * ROUTINE dom_ctl *
344	!!
345	!! ** Purpose : Domain control.
346	!!
347	!! ** Method : compute and print extrema of masked scale factors
348	!!
349	!! History :
350	!! 8.5 ! 02-08 (G. Madec) Original code
351	!!----------------------------------------------------------------------
352	!! * Local declarations
353	INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
354	INTEGER, DIMENSION(2) :: iloc !
355	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
356	!!----------------------------------------------------------------------
357
358	! Extrema of the scale factors
359
360	IF(lwp)WRITE(numout,*)
361	IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
362	IF(lwp)WRITE(numout,*) '~~~~~~~'
363
364	IF (lk_mpp) THEN
365	CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
366	CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
367	CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
368	CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
369	ELSE
370	ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
371	ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
372	ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
373	ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
374
375	iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
376	iimi1 = iloc(1) + nimpp - 1
377	ijmi1 = iloc(2) + njmpp - 1
378	iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
379	iimi2 = iloc(1) + nimpp - 1
380	ijmi2 = iloc(2) + njmpp - 1
381	iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
382	iima1 = iloc(1) + nimpp - 1
383	ijma1 = iloc(2) + njmpp - 1
384	iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
385	iima2 = iloc(1) + nimpp - 1
386	ijma2 = iloc(2) + njmpp - 1
387	ENDIF
388
389	IF(lwp) THEN
390	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
391	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
392	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
393	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
394	ENDIF
395
396	END SUBROUTINE dom_ctl
397
398	!!======================================================================
399	END MODULE domain

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

Download in other formats: