Context Navigation

domain.F90 @ 9383

Last change on this file since 9383 was 9383, checked in by andmirek, 6 years ago
#2050 fixes and changes
File size: 29.8 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	USE iom_def, ONLY:lxios_read, lwxios, wxioso
41
42	IMPLICIT NONE
43	PRIVATE
44
45	PUBLIC dom_init ! called by opa.F90
46	PRIVATE run_namelist, dom_namelist, cla_namelist
47	#if defined key_netcdf4
48	PRIVATE nc4_namelist
49	#endif
50
51	!! * Substitutions
52	# include "domzgr_substitute.h90"
53	!!-------------------------------------------------------------------------
54	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
55	!! $Id$
56	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
57	!!-------------------------------------------------------------------------
58	CONTAINS
59
60	SUBROUTINE dom_init
61	!!----------------------------------------------------------------------
62	!! * ROUTINE dom_init *
63	!!
64	!! ** Purpose : Domain initialization. Call the routines that are
65	!! required to create the arrays which define the space
66	!! and time domain of the ocean model.
67	!!
68	!! ** Method : - dom_msk: compute the masks from the bathymetry file
69	!! - dom_hgr: compute or read the horizontal grid-point position
70	!! and scale factors, and the coriolis factor
71	!! - dom_zgr: define the vertical coordinate and the bathymetry
72	!! - dom_stp: defined the model time step
73	!! - dom_wri: create the meshmask file if nmsh=1
74	!! - 1D configuration, move Coriolis, u and v at T-point
75	!!----------------------------------------------------------------------
76	INTEGER :: jk ! dummy loop argument
77	INTEGER :: iconf = 0 ! local integers
78	!!----------------------------------------------------------------------
79	!
80	IF( nn_timing == 1 ) CALL timing_start('dom_init')
81	!
82	IF(lwp) THEN
83	WRITE(numout,*)
84	WRITE(numout,*) 'dom_init : domain initialization'
85	WRITE(numout,*) '~~~~~~~~'
86	ENDIF
87	!
88	CALL dom_nam ! read namelist ( namrun, namdom, namcla )
89	CALL dom_clo ! Closed seas and lake
90	CALL dom_hgr ! Horizontal mesh
91	CALL dom_zgr ! Vertical mesh and bathymetry
92	CALL dom_msk ! Masks
93	IF( ln_sco ) CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency
94	!
95	ht_0(:,:) = 0.0_wp ! Reference ocean depth at T-points
96	hu_0(:,:) = 0.0_wp ! Reference ocean depth at U-points
97	hv_0(:,:) = 0.0_wp ! Reference ocean depth at V-points
98	DO jk = 1, jpk
99	ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
100	hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
101	hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
102	END DO
103	!
104	IF( lk_vvl ) CALL dom_vvl_init ! Vertical variable mesh
105	!
106	IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point
107	!
108	!
109	hu(:,:) = 0._wp ! Ocean depth at U-points
110	hv(:,:) = 0._wp ! Ocean depth at V-points
111	ht(:,:) = 0._wp ! Ocean depth at T-points
112	DO jk = 1, jpkm1
113	hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
114	hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
115	ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)
116	END DO
117	! ! Inverse of the local depth
118	hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:)
119	hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:)
120
121	CALL dom_stp ! time step
122	IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file
123	IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
124	!
125	IF( nn_timing == 1 ) CALL timing_stop('dom_init')
126	!
127	END SUBROUTINE dom_init
128
129
130	SUBROUTINE dom_nam
131	!!----------------------------------------------------------------------
132	!! * ROUTINE dom_nam *
133	!!
134	!! ** Purpose : read domaine namelists and print the variables.
135	!!
136	!! ** input : - namrun namelist
137	!! - namdom namelist
138	!! - namcla namelist
139	!! - namnc4 namelist ! "key_netcdf4" only
140	!!----------------------------------------------------------------------
141	USE ioipsl
142	NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, &
143	& nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , ln_rstdate, nn_rstctl, &
144	& nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , &
145	& nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler, &
146	& ln_xios_read, nn_wxios
147	NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, &
148	& nn_acc , rn_atfp , rn_rdt , rn_rdtmin , &
149	& rn_rdtmax, rn_rdth , nn_closea , ln_crs, &
150	& jphgr_msh, &
151	& ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
152	& ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
153	& ppa2, ppkth2, ppacr2
154	NAMELIST/namcla/ nn_cla
155	#if defined key_netcdf4
156	NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
157	#endif
158	INTEGER :: ios ! Local integer output status for namelist read
159	!!----------------------------------------------------------------------
160	ln_xios_read = .false. ! set in case ln_xios_read is not in namelist
161	nn_wxios = 0
162	IF(lwm) THEN
163	REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run
164	READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
165	901 CONTINUE
166	ENDIF
167	call mpp_bcast(ios)
168	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
169	IF(lwm) THEN
170	REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run
171	READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
172	902 CONTINUE
173	ENDIF
174	call mpp_bcast(ios)
175	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
176
177	IF(lwm) WRITE ( numond, namrun )
178	!
179	CALL run_namelist()
180
181	IF(lwp) THEN ! control print
182	WRITE(numout,*)
183	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
184	WRITE(numout,*) '~~~~~~~ '
185	WRITE(numout,*) ' Namelist namrun'
186	WRITE(numout,*) ' job number nn_no = ', nn_no
187	WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp
188	WRITE(numout,*) ' file prefix restart input cn_ocerst_in= ', cn_ocerst_in
189	WRITE(numout,*) ' restart input directory cn_ocerst_indir= ', cn_ocerst_indir
190	WRITE(numout,*) ' file prefix restart output cn_ocerst_out= ', cn_ocerst_out
191	WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', cn_ocerst_outdir
192	WRITE(numout,*) ' restart logical ln_rstart = ' , ln_rstart
193	WRITE(numout,*) ' datestamping of restarts ln_rstdate = ', ln_rstdate
194	WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler
195	WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl
196	WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000
197	WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend
198	WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0
199	WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy
200	WRITE(numout,*) ' initial state output nn_istate = ', nn_istate
201	IF( ln_rst_list ) THEN
202	WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist
203	ELSE
204	WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
205	ENDIF
206	WRITE(numout,*) ' frequency of output file nn_write = ', nn_write
207	WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn
208	WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland
209	WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta
210	WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
211	WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
212	WRITE(numout,*) ' READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
213	WRITE(numout,*) ' Write restart using XIOS nn_wxios = ', nn_wxios
214	ENDIF
215
216	no = nn_no ! conversion DOCTOR names into model names (this should disappear soon)
217	cexper = cn_exp
218	nrstdt = nn_rstctl
219	nit000 = nn_it000
220	nitend = nn_itend
221	ndate0 = nn_date0
222	nleapy = nn_leapy
223	ninist = nn_istate
224	nstock = nn_stock
225	nstocklist = nn_stocklist
226	nwrite = nn_write
227	neuler = nn_euler
228	lxios_read = ln_xios_read.and.ln_rstart
229	IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
230	WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
231	CALL ctl_warn( ctmp1 )
232	neuler = 0
233	ENDIF
234
235	! ! control of output frequency
236	IF ( nstock == 0 .OR. nstock > nitend ) THEN
237	WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
238	CALL ctl_warn( ctmp1 )
239	nstock = nitend
240	ENDIF
241	IF ( nwrite == 0 ) THEN
242	WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
243	CALL ctl_warn( ctmp1 )
244	nwrite = nitend
245	ENDIF
246
247	#if defined key_agrif
248	IF( Agrif_Root() ) THEN
249	#endif
250	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
251	CASE ( 1 )
252	CALL ioconf_calendar('gregorian')
253	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
254	CASE ( 0 )
255	CALL ioconf_calendar('noleap')
256	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
257	CASE ( 30 )
258	CALL ioconf_calendar('360d')
259	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
260	END SELECT
261	#if defined key_agrif
262	ENDIF
263	#endif
264	IF(lwm) THEN
265	REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
266	READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
267	903 CONTINUE
268	ENDIF
269	call mpp_bcast(ios)
270	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
271	IF(lwm) THEN
272	REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
273	READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
274	904 CONTINUE
275	ENDIF
276	call mpp_bcast(ios)
277	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
278
279	IF(lwm) WRITE ( numond, namdom )
280
281	CALL dom_namelist()
282
283	IF(lwp) THEN
284	WRITE(numout,*)
285	WRITE(numout,*) ' Namelist namdom : space & time domain'
286	WRITE(numout,*) ' flag read/compute bathymetry nn_bathy = ', nn_bathy
287	WRITE(numout,*) ' Depth (if =0 bathy=jpkm1) rn_bathy = ', rn_bathy
288	WRITE(numout,*) ' min depth of the ocean (>0) or rn_hmin = ', rn_hmin
289	WRITE(numout,*) ' min number of ocean level (<0) '
290	WRITE(numout,*) ' minimum thickness of partial rn_e3zps_min = ', rn_e3zps_min, ' (m)'
291	WRITE(numout,*) ' step level rn_e3zps_rat = ', rn_e3zps_rat
292	WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh
293	WRITE(numout,*) ' = 0 no file created '
294	WRITE(numout,*) ' = 1 mesh_mask '
295	WRITE(numout,*) ' = 2 mesh and mask '
296	WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask'
297	WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
298	WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
299	WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc
300	WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin
301	WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax
302	WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth
303	WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea
304	WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs
305	WRITE(numout,*) ' type of horizontal mesh jphgr_msh = ', jphgr_msh
306	WRITE(numout,*) ' longitude of first raw and column T-point ppglam0 = ', ppglam0
307	WRITE(numout,*) ' latitude of first raw and column T-point ppgphi0 = ', ppgphi0
308	WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_deg = ', ppe1_deg
309	WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
310	WRITE(numout,*) ' zonal grid-spacing (degrees) ppe1_m = ', ppe1_m
311	WRITE(numout,*) ' meridional grid-spacing (degrees) ppe2_m = ', ppe2_m
312	WRITE(numout,*) ' ORCA r4, r2 and r05 coefficients ppsur = ', ppsur
313	WRITE(numout,*) ' ppa0 = ', ppa0
314	WRITE(numout,*) ' ppa1 = ', ppa1
315	WRITE(numout,*) ' ppkth = ', ppkth
316	WRITE(numout,*) ' ppacr = ', ppacr
317	WRITE(numout,*) ' Minimum vertical spacing ppdzmin = ', ppdzmin
318	WRITE(numout,*) ' Maximum depth pphmax = ', pphmax
319	WRITE(numout,*) ' Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh
320	WRITE(numout,*) ' Double tanh function parameters ppa2 = ', ppa2
321	WRITE(numout,*) ' ppkth2 = ', ppkth2
322	WRITE(numout,*) ' ppacr2 = ', ppacr2
323	ENDIF
324
325	ntopo = nn_bathy ! conversion DOCTOR names into model names (this should disappear soon)
326	e3zps_min = rn_e3zps_min
327	e3zps_rat = rn_e3zps_rat
328	nmsh = nn_msh
329	nacc = nn_acc
330	atfp = rn_atfp
331	rdt = rn_rdt
332	rdtmin = rn_rdtmin
333	rdtmax = rn_rdtmin
334	rdth = rn_rdth
335	if (nn_wxios > 0) lwxios = .TRUE.
336	wxioso = nn_wxios
337
338	IF(lwm) THEN
339	REWIND( numnam_ref ) ! Namelist namcla in reference namelist : Cross land advection
340	READ ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)
341	905 CONTINUE
342	ENDIF
343	call mpp_bcast(ios)
344	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )
345	IF(lwm) THEN
346	REWIND( numnam_cfg ) ! Namelist namcla in configuration namelist : Cross land advection
347	READ ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )
348	906 CONTINUE
349	ENDIF
350	call mpp_bcast(ios)
351	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )
352
353	IF(lwm) WRITE( numond, namcla )
354
355	CALL cla_namelist()
356
357	IF(lwp) THEN
358	WRITE(numout,*)
359	WRITE(numout,*) ' Namelist namcla'
360	WRITE(numout,*) ' cross land advection nn_cla = ', nn_cla
361	ENDIF
362	IF ( nn_cla .EQ. 1 ) THEN
363	IF ( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2
364	CONTINUE
365	ELSE
366	CALL ctl_stop( 'STOP', 'Cross land advation iplemented only for ORCA2 configuration: cp_cfg = "orca" and jp_cfg = 2 ' )
367	ENDIF
368	ENDIF
369
370	#if defined key_netcdf4
371	! ! NetCDF 4 case ("key_netcdf4" defined)
372	IF(lwm) THEN
373	REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF
374	READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
375	907 CONTINUE
376	ENDIF
377	call mpp_bcast(ios)
378	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
379	IF(lwm) THEN
380	REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF
381	READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
382	908 CONTINUE
383	ENDIF
384	call mpp_bcast(ios)
385	IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
386
387	IF(lwm) WRITE( numond, namnc4 )
388
389	CALL nc4_namelist()
390
391	IF(lwp) THEN ! control print
392	WRITE(numout,*)
393	WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
394	WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
395	WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
396	WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
397	WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
398	ENDIF
399
400	! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
401	! Note the chunk size in the unlimited (time) dimension will be fixed at 1
402	snc4set%ni = nn_nchunks_i
403	snc4set%nj = nn_nchunks_j
404	snc4set%nk = nn_nchunks_k
405	snc4set%luse = ln_nc4zip
406	#else
407	snc4set%luse = .FALSE. ! No NetCDF 4 case
408	#endif
409	!
410	END SUBROUTINE dom_nam
411
412
413	SUBROUTINE dom_ctl
414	!!----------------------------------------------------------------------
415	!! * ROUTINE dom_ctl *
416	!!
417	!! ** Purpose : Domain control.
418	!!
419	!! ** Method : compute and print extrema of masked scale factors
420	!!----------------------------------------------------------------------
421	INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
422	INTEGER, DIMENSION(2) :: iloc !
423	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
424	!!----------------------------------------------------------------------
425	!
426	IF(lk_mpp) THEN
427	CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
428	CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
429	CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
430	CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
431	ELSE
432	ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
433	ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
434	ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
435	ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
436
437	iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
438	iimi1 = iloc(1) + nimpp - 1
439	ijmi1 = iloc(2) + njmpp - 1
440	iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
441	iimi2 = iloc(1) + nimpp - 1
442	ijmi2 = iloc(2) + njmpp - 1
443	iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
444	iima1 = iloc(1) + nimpp - 1
445	ijma1 = iloc(2) + njmpp - 1
446	iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
447	iima2 = iloc(1) + nimpp - 1
448	ijma2 = iloc(2) + njmpp - 1
449	ENDIF
450	IF(lwp) THEN
451	WRITE(numout,*)
452	WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
453	WRITE(numout,*) '~~~~~~~'
454	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
455	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
456	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
457	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
458	ENDIF
459	!
460	END SUBROUTINE dom_ctl
461
462	SUBROUTINE dom_stiff
463	!!----------------------------------------------------------------------
464	!! * ROUTINE dom_stiff *
465	!!
466	!! ** Purpose : Diagnose maximum grid stiffness/hydrostatic consistency
467	!!
468	!! ** Method : Compute Haney (1991) hydrostatic condition ratio
469	!! Save the maximum in the vertical direction
470	!! (this number is only relevant in s-coordinates)
471	!!
472	!! Haney, R. L., 1991: On the pressure gradient force
473	!! over steep topography in sigma coordinate ocean models.
474	!! J. Phys. Oceanogr., 21, 610???619.
475	!!----------------------------------------------------------------------
476	INTEGER :: ji, jj, jk
477	REAL(wp) :: zrxmax
478	REAL(wp), DIMENSION(4) :: zr1
479	!!----------------------------------------------------------------------
480	rx1(:,:) = 0.e0
481	zrxmax = 0.e0
482	zr1(:) = 0.e0
483
484	DO ji = 2, jpim1
485	DO jj = 2, jpjm1
486	DO jk = 1, jpkm1
487	zr1(1) = umask(ji-1,jj ,jk) *abs( (gdepw_0(ji ,jj ,jk )-gdepw_0(ji-1,jj ,jk ) &
488	& +gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji-1,jj ,jk+1)) &
489	& /(gdepw_0(ji ,jj ,jk )+gdepw_0(ji-1,jj ,jk ) &
490	& -gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji-1,jj ,jk+1) + rsmall) )
491	zr1(2) = umask(ji ,jj ,jk) *abs( (gdepw_0(ji+1,jj ,jk )-gdepw_0(ji ,jj ,jk ) &
492	& +gdepw_0(ji+1,jj ,jk+1)-gdepw_0(ji ,jj ,jk+1)) &
493	& /(gdepw_0(ji+1,jj ,jk )+gdepw_0(ji ,jj ,jk ) &
494	& -gdepw_0(ji+1,jj ,jk+1)-gdepw_0(ji ,jj ,jk+1) + rsmall) )
495	zr1(3) = vmask(ji ,jj ,jk) *abs( (gdepw_0(ji ,jj+1,jk )-gdepw_0(ji ,jj ,jk ) &
496	& +gdepw_0(ji ,jj+1,jk+1)-gdepw_0(ji ,jj ,jk+1)) &
497	& /(gdepw_0(ji ,jj+1,jk )+gdepw_0(ji ,jj ,jk ) &
498	& -gdepw_0(ji ,jj+1,jk+1)-gdepw_0(ji ,jj ,jk+1) + rsmall) )
499	zr1(4) = vmask(ji ,jj-1,jk) *abs( (gdepw_0(ji ,jj ,jk )-gdepw_0(ji ,jj-1,jk ) &
500	& +gdepw_0(ji ,jj ,jk+1)-gdepw_0(ji ,jj-1,jk+1)) &
501	& /(gdepw_0(ji ,jj ,jk )+gdepw_0(ji ,jj-1,jk ) &
502	& -gdepw_0(ji, jj ,jk+1)-gdepw_0(ji ,jj-1,jk+1) + rsmall) )
503	zrxmax = MAXVAL(zr1(1:4))
504	rx1(ji,jj) = MAX(rx1(ji,jj), zrxmax)
505	END DO
506	END DO
507	END DO
508
509	CALL lbc_lnk( rx1, 'T', 1. )
510
511	zrxmax = MAXVAL(rx1)
512
513	IF( lk_mpp ) CALL mpp_max( zrxmax ) ! max over the global domain
514
515	IF(lwp) THEN
516	WRITE(numout,*)
517	WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
518	WRITE(numout,*) '~~~~~~~~~'
519	ENDIF
520
521	END SUBROUTINE dom_stiff
522
523	SUBROUTINE run_namelist()
524	!!---------------------------------------------------------------------
525	!! * ROUTINE run_namelist *
526	!!
527	!! ** Purpose : Broadcast namelist variables read by procesor lwm
528	!!
529	!! ** Method : use lib_mpp
530	!!----------------------------------------------------------------------
531	#if defined key_mpp_mpi
532	CALL mpp_bcast(cn_ocerst_indir, lc)
533	CALL mpp_bcast(cn_ocerst_outdir, lc)
534	CALL mpp_bcast(nn_stocklist, 10)
535	CALL mpp_bcast(ln_rst_list)
536	CALL mpp_bcast(nn_no)
537	CALL mpp_bcast(cn_exp, lc)
538	CALL mpp_bcast(cn_ocerst_in, lc)
539	CALL mpp_bcast(cn_ocerst_out, lc)
540	CALL mpp_bcast(ln_rstart)
541	CALL mpp_bcast(ln_rstdate)
542	CALL mpp_bcast(nn_rstctl)
543	CALL mpp_bcast(nn_it000)
544	CALL mpp_bcast(nn_itend)
545	CALL mpp_bcast(nn_date0)
546	CALL mpp_bcast(nn_leapy)
547	CALL mpp_bcast(nn_istate)
548	CALL mpp_bcast(nn_stock)
549	CALL mpp_bcast(nn_write)
550	CALL mpp_bcast(ln_dimgnnn)
551	CALL mpp_bcast(ln_mskland)
552	CALL mpp_bcast(ln_cfmeta)
553	CALL mpp_bcast(ln_clobber)
554	CALL mpp_bcast(nn_chunksz)
555	CALL mpp_bcast(nn_euler)
556	CALL mpp_bcast(ln_xios_read)
557	CALL mpp_bcast(nn_wxios)
558	#endif
559	END SUBROUTINE run_namelist
560
561	SUBROUTINE dom_namelist()
562	!!---------------------------------------------------------------------
563	!! * ROUTINE dom_namelist *
564	!!
565	!! ** Purpose : Broadcast namelist variables read by procesor lwm
566	!!
567	!! ** Method : use lib_mpp
568	!!----------------------------------------------------------------------
569	#if defined key_mpp_mpi
570	CALL mpp_bcast(nn_bathy)
571	CALL mpp_bcast(rn_bathy)
572	CALL mpp_bcast(rn_e3zps_min)
573	CALL mpp_bcast(rn_e3zps_rat)
574	CALL mpp_bcast(nn_msh)
575	CALL mpp_bcast(rn_hmin)
576	CALL mpp_bcast(nn_acc)
577	CALL mpp_bcast(rn_atfp)
578	CALL mpp_bcast(rn_rdt)
579	CALL mpp_bcast(rn_rdtmin)
580	CALL mpp_bcast(rn_rdtmax)
581	CALL mpp_bcast(rn_rdth)
582	CALL mpp_bcast(nn_closea)
583	CALL mpp_bcast(ln_crs)
584	CALL mpp_bcast(jphgr_msh)
585	CALL mpp_bcast(ppglam0)
586	CALL mpp_bcast(ppgphi0)
587	CALL mpp_bcast(ppe1_deg)
588	CALL mpp_bcast(ppe2_deg)
589	CALL mpp_bcast(ppe1_m)
590	CALL mpp_bcast(ppe2_m)
591	CALL mpp_bcast(ppsur)
592	CALL mpp_bcast(ppa0)
593	CALL mpp_bcast(ppa1)
594	CALL mpp_bcast(ppkth)
595	CALL mpp_bcast(ppacr)
596	CALL mpp_bcast(ppdzmin)
597	CALL mpp_bcast(pphmax)
598	CALL mpp_bcast(ldbletanh)
599	CALL mpp_bcast(ppa2)
600	CALL mpp_bcast(ppkth2)
601	CALL mpp_bcast(ppacr2)
602	#endif
603	END SUBROUTINE dom_namelist
604
605	SUBROUTINE cla_namelist()
606	!!---------------------------------------------------------------------
607	!! * ROUTINE cla_namelist *
608	!!
609	!! ** Purpose : Broadcast namelist variables read by procesor lwm
610	!!
611	!! ** Method : use lib_mpp
612	!!----------------------------------------------------------------------
613	#if defined key_mpp_mpi
614	CALL mpp_bcast(nn_cla)
615	#endif
616	END SUBROUTINE cla_namelist
617
618	#if defined key_netcdf4
619	SUBROUTINE nc4_namelist()
620	!!---------------------------------------------------------------------
621	!! * ROUTINE nc4_namelist *
622	!!
623	!! ** Purpose : Broadcast namelist variables read by procesor lwm
624	!!
625	!! ** Method : use lib_mpp
626	!!----------------------------------------------------------------------
627	#if defined key_mpp_mpi
628	CALL mpp_bcast(nn_nchunks_i)
629	CALL mpp_bcast(nn_nchunks_j)
630	CALL mpp_bcast(nn_nchunks_k)
631	CALL mpp_bcast(ln_nc4zip)
632	#endif
633	END SUBROUTINE nc4_namelist
634	#endif
635	!!======================================================================
636	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/test_moci_test_suite_namelist_read/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 9383

Download in other formats: