Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

domain.F90

Last change on this file was 6510, checked in by rfurner, 8 years ago
changes to include different start times from branch 2014/dev_r4650_UKMO7_STARTHOUR
Property svn:keywords set to `Id`
File size: 25.2 KB

Line
1	MODULE domain
2	!!==============================================================================
3	!! * MODULE domain *
4	!! Ocean initialization : domain initialization
5	!!==============================================================================
6	!! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code
7	!! ! 1992-01 (M. Imbard) insert time step initialization
8	!! ! 1996-06 (G. Madec) generalized vertical coordinate
9	!! ! 1997-02 (G. Madec) creation of domwri.F
10	!! ! 2001-05 (E.Durand - G. Madec) insert closed sea
11	!! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module
12	!! 2.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization
13	!! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration
14	!! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
15	!!----------------------------------------------------------------------
16
17	!!----------------------------------------------------------------------
18	!! dom_init : initialize the space and time domain
19	!! dom_nam : read and contral domain namelists
20	!! dom_ctl : control print for the ocean domain
21	!!----------------------------------------------------------------------
22	USE oce ! ocean variables
23	USE dom_oce ! domain: ocean
24	USE sbc_oce ! surface boundary condition: ocean
25	USE phycst ! physical constants
26	USE closea ! closed seas
27	USE in_out_manager ! I/O manager
28	USE lib_mpp ! distributed memory computing library
29
30	USE domhgr ! domain: set the horizontal mesh
31	USE domzgr ! domain: set the vertical mesh
32	USE domstp ! domain: set the time-step
33	USE dommsk ! domain: set the mask system
34	USE domwri ! domain: write the meshmask file
35	USE domvvl ! variable volume
36	USE c1d ! 1D vertical configuration
37	USE dyncor_c1d ! Coriolis term (c1d case) (cor_c1d routine)
38	USE timing ! Timing
39	USE lbclnk ! ocean lateral boundary condition (or mpp link)
40
41	IMPLICIT NONE
42	PRIVATE
43
44	PUBLIC dom_init ! called by opa.F90
45
46	!! * Substitutions
47	# include "domzgr_substitute.h90"
48	!!-------------------------------------------------------------------------
49	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
50	!! $Id$
51	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
52	!!-------------------------------------------------------------------------
53	CONTAINS
54
55	SUBROUTINE dom_init
56	!!----------------------------------------------------------------------
57	!! * ROUTINE dom_init *
58	!!
59	!! ** Purpose : Domain initialization. Call the routines that are
60	!! required to create the arrays which define the space
61	!! and time domain of the ocean model.
62	!!
63	!! ** Method : - dom_msk: compute the masks from the bathymetry file
64	!! - dom_hgr: compute or read the horizontal grid-point position
65	!! and scale factors, and the coriolis factor
66	!! - dom_zgr: define the vertical coordinate and the bathymetry
67	!! - dom_stp: defined the model time step
68	!! - dom_wri: create the meshmask file if nmsh=1
69	!! - 1D configuration, move Coriolis, u and v at T-point
70	!!----------------------------------------------------------------------
71	INTEGER :: jk ! dummy loop argument
72	INTEGER :: iconf = 0 ! local integers
73	!!----------------------------------------------------------------------
74	!
75	IF( nn_timing == 1 ) CALL timing_start('dom_init')
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	CALL dom_clo ! Closed seas and lake
85	CALL dom_hgr ! Horizontal mesh
86	CALL dom_zgr ! Vertical mesh and bathymetry
87	CALL dom_msk ! Masks
88	IF( ln_sco.AND.(.NOT.ln_wd) ) &
89	& CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency
90	!
91	ht_0(:,:) = 0.0_wp ! Reference ocean depth at T-points
92	hu_0(:,:) = 0.0_wp ! Reference ocean depth at U-points
93	hv_0(:,:) = 0.0_wp ! Reference ocean depth at V-points
94	DO jk = 1, jpk
95	ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
96	hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
97	hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
98	END DO
99	!
100	IF( lk_vvl ) CALL dom_vvl_init ! Vertical variable mesh
101	!
102	IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point
103	!
104	!
105	hu(:,:) = 0._wp ! Ocean depth at U-points
106	hv(:,:) = 0._wp ! Ocean depth at V-points
107	ht(:,:) = 0._wp ! Ocean depth at T-points
108	DO jk = 1, jpkm1
109	hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
110	hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
111	ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)
112	END DO
113	! ! Inverse of the local depth
114	hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:)
115	hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:)
116
117	CALL dom_stp ! time step
118	IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file
119	IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
120	!
121	IF( nn_timing == 1 ) CALL timing_stop('dom_init')
122	!
123	END SUBROUTINE dom_init
124
125
126	SUBROUTINE dom_nam
127	!!----------------------------------------------------------------------
128	!! * ROUTINE dom_nam *
129	!!
130	!! ** Purpose : read domaine namelists and print the variables.
131	!!
132	!! ** input : - namrun namelist
133	!! - namdom namelist
134	!! - namcla namelist
135	!! - namnc4 namelist ! "key_netcdf4" only
136	!!----------------------------------------------------------------------
137	USE ioipsl
138	NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, &
139	& nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, &
140	& ln_rstdate, &
141	& nn_it000, nn_itend , nn_date0 ,nn_time0 , nn_leapy , nn_istate , nn_stock , &
142	& nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler
143	NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, &
144	& nn_acc , rn_atfp , rn_rdt , rn_rdtmin , &
145	& rn_rdtmax, rn_rdth , nn_closea , ln_crs, &
146	& jphgr_msh, &
147	& ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
148	& ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
149	& ppa2, ppkth2, ppacr2
150	NAMELIST/namcla/ nn_cla
151	#if defined key_netcdf4
152	NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
153	#endif
154	INTEGER :: ios ! Local integer output status for namelist read
155	!!----------------------------------------------------------------------
156
157	REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run
158	READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
159	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
160
161	REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run
162	READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
163	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
164	IF(lwm) WRITE ( numond, namrun )
165	!
166	IF(lwp) THEN ! control print
167	WRITE(numout,*)
168	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
169	WRITE(numout,*) '~~~~~~~ '
170	WRITE(numout,*) ' Namelist namrun'
171	WRITE(numout,*) ' job number nn_no = ', nn_no
172	WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp
173	WRITE(numout,*) ' file prefix restart input cn_ocerst_in= ', cn_ocerst_in
174	WRITE(numout,*) ' restart input directory cn_ocerst_indir= ', cn_ocerst_indir
175	WRITE(numout,*) ' file prefix restart output cn_ocerst_out= ', cn_ocerst_out
176	WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', cn_ocerst_outdir
177	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
178	WRITE(numout,*) ' datestamping of restarts ln_rstdate = ', ln_rstdate
179	WRITE(numout,*) ' restart input directory cn_ocerst_indir= ', cn_ocerst_indir
180	WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', cn_ocerst_outdir
181	WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler
182	WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl
183	WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000
184	WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend
185	WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0
186	WRITE(numout,*) ' initial time of day in hhmm nn_time0 = ', nn_time0
187	WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy
188	WRITE(numout,*) ' initial state output nn_istate = ', nn_istate
189	IF( ln_rst_list ) THEN
190	WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist
191	ELSE
192	WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
193	ENDIF
194	WRITE(numout,*) ' frequency of output file nn_write = ', nn_write
195	WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn
196	WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland
197	WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta
198	WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
199	WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
200	ENDIF
201
202	no = nn_no ! conversion DOCTOR names into model names (this should disappear soon)
203	cexper = cn_exp
204	nrstdt = nn_rstctl
205	nit000 = nn_it000
206	nitend = nn_itend
207	ndate0 = nn_date0
208	nleapy = nn_leapy
209	ninist = nn_istate
210	nstock = nn_stock
211	nstocklist = nn_stocklist
212	nwrite = nn_write
213	neuler = nn_euler
214	IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
215	WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
216	CALL ctl_warn( ctmp1 )
217	neuler = 0
218	ENDIF
219
220	! ! control of output frequency
221	IF ( nstock == 0 .OR. nstock > nitend ) THEN
222	WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
223	CALL ctl_warn( ctmp1 )
224	nstock = nitend
225	ENDIF
226	IF ( nwrite == 0 ) THEN
227	WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
228	CALL ctl_warn( ctmp1 )
229	nwrite = nitend
230	ENDIF
231
232	#if defined key_agrif
233	IF( Agrif_Root() ) THEN
234	#endif
235	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
236	CASE ( 1 )
237	CALL ioconf_calendar('gregorian')
238	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
239	CASE ( 0 )
240	CALL ioconf_calendar('noleap')
241	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
242	CASE ( 30 )
243	CALL ioconf_calendar('360d')
244	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
245	END SELECT
246	#if defined key_agrif
247	ENDIF
248	#endif
249
250	REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
251	READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
252	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
253
254	!
255	REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
256	READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
257	904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
258	IF(lwm) WRITE ( numond, namdom )
259
260	IF(lwp) THEN
261	WRITE(numout,*)
262	WRITE(numout,*) ' Namelist namdom : space & time domain'
263	WRITE(numout,*) ' flag read/compute bathymetry nn_bathy = ', nn_bathy
264	WRITE(numout,*) ' Depth (if =0 bathy=jpkm1) rn_bathy = ', rn_bathy
265	WRITE(numout,*) ' min depth of the ocean (>0) or rn_hmin = ', rn_hmin
266	WRITE(numout,*) ' min number of ocean level (<0) '
267	WRITE(numout,*) ' minimum thickness of partial rn_e3zps_min = ', rn_e3zps_min, ' (m)'
268	WRITE(numout,*) ' step level rn_e3zps_rat = ', rn_e3zps_rat
269	WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh
270	WRITE(numout,*) ' = 0 no file created '
271	WRITE(numout,*) ' = 1 mesh_mask '
272	WRITE(numout,*) ' = 2 mesh and mask '
273	WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask'
274	WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
275	WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
276	WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc
277	WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin
278	WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax
279	WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth
280	WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea
281	WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs
282	WRITE(numout,*) ' type of horizontal mesh jphgr_msh = ', jphgr_msh
283	WRITE(numout,*) ' longitude of first raw and column T-point ppglam0 = ', ppglam0
284	WRITE(numout,*) ' latitude of first raw and column T-point ppgphi0 = ', ppgphi0
285	WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_deg = ', ppe1_deg
286	WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
287	WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_m = ', ppe1_m
288	WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_m = ', ppe2_m
289	WRITE(numout,*) ' ORCA r4, r2 and r05 coefficients ppsur = ', ppsur
290	WRITE(numout,*) ' ppa0 = ', ppa0
291	WRITE(numout,*) ' ppa1 = ', ppa1
292	WRITE(numout,*) ' ppkth = ', ppkth
293	WRITE(numout,*) ' ppacr = ', ppacr
294	WRITE(numout,*) ' Minimum vertical spacing ppdzmin = ', ppdzmin
295	WRITE(numout,*) ' Maximum depth pphmax = ', pphmax
296	WRITE(numout,*) ' Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
297	WRITE(numout,*) ' Double tanh function parameters ppa2 = ', ppa2
298	WRITE(numout,*) ' ppkth2 = ', ppkth2
299	WRITE(numout,*) ' ppacr2 = ', ppacr2
300	ENDIF
301
302	ntopo = nn_bathy ! conversion DOCTOR names into model names (this should disappear soon)
303	e3zps_min = rn_e3zps_min
304	e3zps_rat = rn_e3zps_rat
305	nmsh = nn_msh
306	nacc = nn_acc
307	atfp = rn_atfp
308	rdt = rn_rdt
309	rdtmin = rn_rdtmin
310	rdtmax = rn_rdtmin
311	rdth = rn_rdth
312
313	REWIND( numnam_ref ) ! Namelist namcla in reference namelist : Cross land advection
314	READ ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
315	905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
316
317	REWIND( numnam_cfg ) ! Namelist namcla in configuration namelist : Cross land advection
318	READ ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
319	906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
320	IF(lwm) WRITE( numond, namcla )
321
322	IF(lwp) THEN
323	WRITE(numout,*)
324	WRITE(numout,*) ' Namelist namcla'
325	WRITE(numout,*) ' cross land advection nn_cla = ', nn_cla
326	ENDIF
327	IF ( nn_cla .EQ. 1 ) THEN
328	IF ( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2
329	CONTINUE
330	ELSE
331	CALL ctl_stop( 'STOP', 'Cross land advation iplemented only for ORCA2 configuration: cp_cfg = "orca" and jp_cfg = 2 ' )
332	ENDIF
333	ENDIF
334
335	#if defined key_netcdf4
336	! ! NetCDF 4 case ("key_netcdf4" defined)
337	REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF
338	READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
339	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
340
341	REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF
342	READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
343	908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
344	IF(lwm) WRITE( numond, namnc4 )
345
346	IF(lwp) THEN ! control print
347	WRITE(numout,*)
348	WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
349	WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
350	WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
351	WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
352	WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
353	ENDIF
354
355	! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
356	! Note the chunk size in the unlimited (time) dimension will be fixed at 1
357	snc4set%ni = nn_nchunks_i
358	snc4set%nj = nn_nchunks_j
359	snc4set%nk = nn_nchunks_k
360	snc4set%luse = ln_nc4zip
361	#else
362	snc4set%luse = .FALSE. ! No NetCDF 4 case
363	#endif
364	!
365	END SUBROUTINE dom_nam
366
367
368	SUBROUTINE dom_ctl
369	!!----------------------------------------------------------------------
370	!! * ROUTINE dom_ctl *
371	!!
372	!! ** Purpose : Domain control.
373	!!
374	!! ** Method : compute and print extrema of masked scale factors
375	!!----------------------------------------------------------------------
376	INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
377	INTEGER, DIMENSION(2) :: iloc !
378	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
379	!!----------------------------------------------------------------------
380	!
381	IF(lk_mpp) THEN
382	CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
383	CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
384	CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
385	CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
386	ELSE
387	ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
388	ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
389	ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
390	ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
391
392	iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
393	iimi1 = iloc(1) + nimpp - 1
394	ijmi1 = iloc(2) + njmpp - 1
395	iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
396	iimi2 = iloc(1) + nimpp - 1
397	ijmi2 = iloc(2) + njmpp - 1
398	iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
399	iima1 = iloc(1) + nimpp - 1
400	ijma1 = iloc(2) + njmpp - 1
401	iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
402	iima2 = iloc(1) + nimpp - 1
403	ijma2 = iloc(2) + njmpp - 1
404	ENDIF
405	IF(lwp) THEN
406	WRITE(numout,*)
407	WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
408	WRITE(numout,*) '~~~~~~~'
409	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
410	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
411	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
412	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
413	ENDIF
414	!
415	END SUBROUTINE dom_ctl
416
417	SUBROUTINE dom_stiff
418	!!----------------------------------------------------------------------
419	!! * ROUTINE dom_stiff *
420	!!
421	!! ** Purpose : Diagnose maximum grid stiffness/hydrostatic consistency
422	!!
423	!! ** Method : Compute Haney (1991) hydrostatic condition ratio
424	!! Save the maximum in the vertical direction
425	!! (this number is only relevant in s-coordinates)
426	!!
427	!! Haney, R. L., 1991: On the pressure gradient force
428	!! over steep topography in sigma coordinate ocean models.
429	!! J. Phys. Oceanogr., 21, 610???619.
430	!!----------------------------------------------------------------------
431	INTEGER :: ji, jj, jk
432	REAL(wp) :: zrxmax
433	REAL(wp), DIMENSION(4) :: zr1
434	!!----------------------------------------------------------------------
435	rx1(:,:) = 0.e0
436	zrxmax = 0.e0
437	zr1(:) = 0.e0
438
439	DO ji = 2, jpim1
440	DO jj = 2, jpjm1
441	DO jk = 1, jpkm1
442	zr1(1) = umask(ji-1,jj ,jk) *abs( (gdepw_0(ji ,jj ,jk )-gdepw_0(ji-1,jj ,jk ) &
443	& +gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji-1,jj ,jk+1)) &
444	& /(gdepw_0(ji ,jj ,jk )+gdepw_0(ji-1,jj ,jk ) &
445	& -gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji-1,jj ,jk+1) + rsmall) )
446	zr1(2) = umask(ji ,jj ,jk) *abs( (gdepw_0(ji+1,jj ,jk )-gdepw_0(ji ,jj ,jk ) &
447	& +gdepw_0(ji+1,jj ,jk+1)-gdepw_0(ji ,jj ,jk+1)) &
448	& /(gdepw_0(ji+1,jj ,jk )+gdepw_0(ji ,jj ,jk ) &
449	& -gdepw_0(ji+1,jj ,jk+1)-gdepw_0(ji ,jj ,jk+1) + rsmall) )
450	zr1(3) = vmask(ji ,jj ,jk) *abs( (gdepw_0(ji ,jj+1,jk )-gdepw_0(ji ,jj ,jk ) &
451	& +gdepw_0(ji ,jj+1,jk+1)-gdepw_0(ji ,jj ,jk+1)) &
452	& /(gdepw_0(ji ,jj+1,jk )+gdepw_0(ji ,jj ,jk ) &
453	& -gdepw_0(ji ,jj+1,jk+1)-gdepw_0(ji ,jj ,jk+1) + rsmall) )
454	zr1(4) = vmask(ji ,jj-1,jk) *abs( (gdepw_0(ji ,jj ,jk )-gdepw_0(ji ,jj-1,jk ) &
455	& +gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji ,jj-1,jk+1)) &
456	& /(gdepw_0(ji ,jj ,jk )+gdepw_0(ji ,jj-1,jk ) &
457	& -gdepw_0(ji, jj ,jk+1)-gdepw_0(ji ,jj-1,jk+1) + rsmall) )
458	zrxmax = MAXVAL(zr1(1:4))
459	rx1(ji,jj) = MAX(rx1(ji,jj), zrxmax)
460	END DO
461	END DO
462	END DO
463
464	CALL lbc_lnk( rx1, 'T', 1. )
465
466	zrxmax = MAXVAL(rx1)
467
468	IF( lk_mpp ) CALL mpp_max( zrxmax ) ! max over the global domain
469
470	IF(lwp) THEN
471	WRITE(numout,*)
472	WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
473	WRITE(numout,*) '~~~~~~~~~'
474	ENDIF
475
476	END SUBROUTINE dom_stiff
477
478
479
480	!!======================================================================
481	END MODULE domain

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/UKMO/dev_r5518_Surge_Modelling/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

Download in other formats: