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

Last change on this file since 359 was 359, checked in by opalod, 18 years ago
nemo_v1_update_033 : RB + CT : Add new surface pressure gradient algorithms
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 17.9 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	!! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization
71	!!----------------------------------------------------------------------
72	!! * Local declarations
73	INTEGER :: jk ! dummy loop argument
74	INTEGER :: iconf = 0 ! temporary integers
75	!!----------------------------------------------------------------------
76
77	IF(lwp) THEN
78	WRITE(numout,*)
79	WRITE(numout,*) 'dom_init : domain initialization'
80	WRITE(numout,*) '~~~~~~~~'
81	ENDIF
82
83	CALL dom_nam ! read namelist ( namrun, namdom, namcla )
84
85	CALL dom_clo ! Closed seas and lake
86
87	CALL dom_hgr ! Horizontal mesh
88
89	CALL dom_zgr ! Vertical mesh and bathymetry
90
91	CALL dom_msk ! Masks
92
93
94	! Local depth or Inverse of the local depth of the water column at u- and v-points
95	! ------------------------------
96	! Ocean depth at U- and V-points
97	hu(:,:) = 0.
98	hv(:,:) = 0.
99	DO jk = 1, jpk
100	hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
101	hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
102	END DO
103	! Inverse of the local depth
104	hur(:,:) = fse3u(:,:,1) ! Lower bound : thickness of the first model level
105	hvr(:,:) = fse3v(:,:,1)
106	DO jk = 2, jpk ! Sum of the vertical scale factors
107	hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
108	hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
109	END DO
110	! Compute and mask the inverse of the local depth
111	hur(:,:) = 1. / hur(:,:) * umask(:,:,1)
112	hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1)
113
114
115	CALL dom_stp ! Time step
116
117	IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file
118
119	IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
120
121	END SUBROUTINE dom_init
122
123
124	SUBROUTINE dom_nam
125	!!----------------------------------------------------------------------
126	!! * ROUTINE dom_nam *
127	!!
128	!! ** Purpose : read domaine namelists and print the variables.
129	!!
130	!! ** input : - namrun namelist
131	!! - namdom namelist
132	!! - namcla namelist
133	!!
134	!! History :
135	!! 9.0 ! 03-08 (G. Madec) Original code
136	!!----------------------------------------------------------------------
137	!! * Modules used
138	USE ioipsl
139	NAMELIST/namrun/ no , cexper , ln_rstart , nrstdt , nit000, &
140	& nitend, ndate0 , nleapy , ninist , nstock, &
141	& nprint, nwrite , nrunoff , ln_ctl , nictls, nictle, &
142	& njctls, njctle , nbench , isplt , jsplt
143
144	NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, ngrid , nmsh , &
145	& nacc , atfp , rdt , rdtmin , rdtmax, &
146	& rdth , rdtbt , nfice , nfbulk , nclosea
147	NAMELIST/namcla/ n_cla
148	!!----------------------------------------------------------------------
149
150	IF(lwp) THEN
151	WRITE(numout,*)
152	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
153	WRITE(numout,*) '~~~~~~~ '
154	ENDIF
155
156	! Namelist namrun : parameters of the run
157	REWIND( numnam )
158	READ ( numnam, namrun )
159
160	IF(lwp) THEN
161	WRITE(numout,*) ' Namelist namrun'
162	WRITE(numout,*) ' job number no = ', no
163	WRITE(numout,*) ' experiment name for output cexper = ', cexper
164	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
165	WRITE(numout,*) ' control of time step nrstdt = ', nrstdt
166	WRITE(numout,*) ' number of the first time step nit000 = ', nit000
167	WRITE(numout,*) ' number of the last time step nitend = ', nitend
168	WRITE(numout,*) ' initial calendar date aammjj ndate0 = ', ndate0
169	WRITE(numout,*) ' leap year calendar (0/1) nleapy = ', nleapy
170	WRITE(numout,*) ' initial state output ninist = ', ninist
171	WRITE(numout,*) ' level of print nprint = ', nprint
172	WRITE(numout,*) ' frequency of restart file nstock = ', nstock
173	WRITE(numout,*) ' frequency of output file nwrite = ', nwrite
174	WRITE(numout,*) ' runoff option nrunoff = ', nrunoff
175	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
176	WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls
177	WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle
178	WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls
179	WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle
180	WRITE(numout,*) ' number of proc. following i isplt = ', isplt
181	WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt
182	WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench
183	ENDIF
184
185	ndastp = ndate0 ! Assign initial date to current date
186
187	! ... Control the sub-domain area indices for the print control
188	IF(ln_ctl) THEN
189	IF( lk_mpp ) THEN
190	! the domain is forced to the real splitted domain in MPI
191	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
192	ELSE
193	IF( isplt == 1 .AND. jsplt == 1 ) THEN
194	IF(lwp) WRITE(numout,cform_war)
195	IF(lwp) WRITE(numout,*)' - isplt & jsplt are equal to 1'
196	IF(lwp) WRITE(numout,*)' - the print control will be done over the whole domain'
197	IF(lwp) WRITE(numout,*)
198	ENDIF
199
200	! compute the total number of processors ijsplt
201	ijsplt = isplt*jsplt
202	ENDIF
203
204	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
205	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
206
207	! Control the indices used for the SUM control
208	IF( nictls+nictle+njctls+njctle == 0 ) THEN
209	! the print control is done over the default area
210	lsp_area = .FALSE.
211	ELSE
212	! the print control is done over a specific area
213	lsp_area = .TRUE.
214	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
215	IF(lwp) WRITE(numout,cform_war)
216	IF(lwp) WRITE(numout,*)' - nictls must be 1<=nictls>=jpiglo, it is forced to 1'
217	IF(lwp) WRITE(numout,*)
218	nwarn = nwarn + 1
219	nictls = 1
220	ENDIF
221
222	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
223	IF(lwp) WRITE(numout,cform_war)
224	IF(lwp) WRITE(numout,*)' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo'
225	IF(lwp) WRITE(numout,*)
226	nwarn = nwarn + 1
227	nictle = jpjglo
228	ENDIF
229
230	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
231	IF(lwp) WRITE(numout,cform_war)
232	IF(lwp) WRITE(numout,*)' - njctls must be 1<=njctls>=jpjglo, it is forced to 1'
233	IF(lwp) WRITE(numout,*)
234	nwarn = nwarn + 1
235	njctls = 1
236	ENDIF
237
238	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
239	IF(lwp) WRITE(numout,cform_war)
240	IF(lwp) WRITE(numout,*)' - njctle must be 1<=njctle>= jpjglo, it is forced to jpjglo'
241	IF(lwp) WRITE(numout,*)
242	nwarn = nwarn + 1
243	njctle = jpjglo
244	ENDIF
245
246	ENDIF ! IF( nictls+nictle+njctls+njctle == 0 )
247	ENDIF ! IF(ln_ctl)
248
249	! ... Control of output frequency
250	IF ( nstock == 0 ) THEN
251	IF(lwp)WRITE(numout,cform_war)
252	IF(lwp)WRITE(numout,*) ' nstock = ', nstock, ' it is forced to ', nitend
253	nstock = nitend
254	nwarn = nwarn + 1
255	ENDIF
256	IF ( nwrite == 0 ) THEN
257	IF(lwp)WRITE(numout,cform_war)
258	IF(lwp)WRITE(numout,*) ' nwrite = ', nwrite, ' it is forced to ', nitend
259	nwrite = nitend
260	nwarn = nwarn + 1
261	ENDIF
262
263	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
264	CASE ( 1 )
265	CALL ioconf_calendar('gregorian')
266	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
267	CASE ( 0 )
268	CALL ioconf_calendar('noleap')
269	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
270	CASE ( 30 )
271	CALL ioconf_calendar('360d')
272	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
273	END SELECT
274
275	SELECT CASE ( nleapy ) ! year=raajjdays day=rjjhhhours hour=rhhmm*minutes etc ...
276	CASE ( 1 )
277	raajj = 365.25
278	raass = raajj * rjjss
279	rmoss = raass/raamo
280	CASE ( 0 )
281	raajj = 365.
282	raass = raajj * rjjss
283	rmoss = raass/raamo
284	CASE DEFAULT
285	raajj = FLOAT( nleapy ) * raamo
286	raass = raajj * rjjss
287	rmoss = FLOAT( nleapy ) * rjjss
288	END SELECT
289	IF(lwp) THEN
290	WRITE(numout,*)
291	WRITE(numout,*) ' nb of days per year raajj = ', raajj,' days'
292	WRITE(numout,*) ' nb of seconds per year raass = ', raass, ' s'
293	WRITE(numout,*) ' nb of seconds per month rmoss = ', rmoss, ' s'
294	ENDIF
295
296	! Namelist namdom : space/time domain (bathymetry, mesh, timestep)
297	REWIND( numnam )
298	READ ( numnam, namdom )
299
300	IF(lwp) THEN
301	WRITE(numout,*)
302	WRITE(numout,*) ' Namelist namdom'
303	WRITE(numout,*) ' flag read/compute bathymetry ntopo = ', ntopo
304	WRITE(numout,*) ' minimum thickness of partial e3zps_min = ', e3zps_min, ' (m)'
305	WRITE(numout,*) ' step level e3zps_rat = ', e3zps_rat
306	WRITE(numout,*) ' flag read/compute coordinates ngrid = ', ngrid
307	WRITE(numout,*) ' flag write mesh/mask file(s) nmsh = ', nmsh
308	WRITE(numout,*) ' = 0 no file created '
309	WRITE(numout,*) ' = 1 mesh_mask '
310	WRITE(numout,*) ' = 2 mesh and mask '
311	WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask '
312	WRITE(numout,*) ' acceleration of converge nacc = ', nacc
313	WRITE(numout,*) ' asselin time filter parameter atfp = ', atfp
314	WRITE(numout,*) ' time step rdt = ', rdt
315	WRITE(numout,*) ' minimum time step on tracers rdtmin = ', rdtmin
316	WRITE(numout,*) ' maximum time step on tracers rdtmax = ', rdtmax
317	WRITE(numout,*) ' depth variation tracer step rdth = ', rdth
318	WRITE(numout,*) ' barotropic time step rdtbt = ', rdtbt
319	ENDIF
320
321	IF( lk_ice_lim ) THEN
322	IF(lwp) WRITE(numout,*) ' ice model coupling frequency nfice = ', nfice
323	nfbulk = nfice
324	IF( MOD( rday, nfice*rdt ) /= 0 ) THEN
325	IF(lwp) WRITE(numout,*) ' '
326	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'
327	IF(lwp) WRITE(numout,*) ' '
328	ENDIF
329	IF(lwp) WRITE(numout,*) ' bulk computation frequency nfbulk = ', nfbulk, ' = nfice if ice model used'
330	IF(lwp) WRITE(numout,*) ' flag closed sea or not nclosea = ', nclosea
331	ENDIF
332
333	! Default values
334	n_cla = 0
335
336	! Namelist cross land advection
337	REWIND( numnam )
338	READ ( numnam, namcla )
339	IF(lwp) THEN
340	WRITE(numout,*)
341	WRITE(numout,*) ' Namelist namcla'
342	WRITE(numout,*) ' cross land advection n_cla = ',n_cla
343	ENDIF
344
345	END SUBROUTINE dom_nam
346
347
348	SUBROUTINE dom_ctl
349	!!----------------------------------------------------------------------
350	!! * ROUTINE dom_ctl *
351	!!
352	!! ** Purpose : Domain control.
353	!!
354	!! ** Method : compute and print extrema of masked scale factors
355	!!
356	!! History :
357	!! 8.5 ! 02-08 (G. Madec) Original code
358	!!----------------------------------------------------------------------
359	!! * Local declarations
360	INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
361	INTEGER, DIMENSION(2) :: iloc !
362	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
363	!!----------------------------------------------------------------------
364
365	! Extrema of the scale factors
366
367	IF(lwp)WRITE(numout,*)
368	IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
369	IF(lwp)WRITE(numout,*) '~~~~~~~'
370
371	IF (lk_mpp) THEN
372	CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
373	CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
374	CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
375	CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
376	ELSE
377	ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
378	ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
379	ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
380	ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
381
382	iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
383	iimi1 = iloc(1) + nimpp - 1
384	ijmi1 = iloc(2) + njmpp - 1
385	iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
386	iimi2 = iloc(1) + nimpp - 1
387	ijmi2 = iloc(2) + njmpp - 1
388	iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
389	iima1 = iloc(1) + nimpp - 1
390	ijma1 = iloc(2) + njmpp - 1
391	iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
392	iima2 = iloc(1) + nimpp - 1
393	ijma2 = iloc(2) + njmpp - 1
394	ENDIF
395
396	IF(lwp) THEN
397	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
398	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
399	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
400	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
401	ENDIF
402
403	END SUBROUTINE dom_ctl
404
405	!!======================================================================
406	END MODULE domain

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

Download in other formats: