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 NEMO/trunk/src/OCE/DOM – NEMO

Context Navigation

source: NEMO/trunk/src/OCE/DOM/domain.F90 @ 13458

Last change on this file since 13458 was 13458, checked in by smasson, 4 years ago
trunk: mpp_min(max)loc testing only inner domain, see #2521
Property svn:keywords set to `Id`
File size: 34.9 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	!! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default
16	!! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface
17	!! 4.x ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio
18	!!----------------------------------------------------------------------
19
20	!!----------------------------------------------------------------------
21	!! dom_init : initialize the space and time domain
22	!! dom_glo : initialize global domain <--> local domain indices
23	!! dom_nam : read and contral domain namelists
24	!! dom_ctl : control print for the ocean domain
25	!! domain_cfg : read the global domain size in domain configuration file
26	!! cfg_write : create the domain configuration file
27	!!----------------------------------------------------------------------
28	USE oce ! ocean variables
29	USE dom_oce ! domain: ocean
30	USE sbc_oce ! surface boundary condition: ocean
31	USE trc_oce ! shared ocean & passive tracers variab
32	USE phycst ! physical constants
33	USE domhgr ! domain: set the horizontal mesh
34	USE domzgr ! domain: set the vertical mesh
35	USE dommsk ! domain: set the mask system
36	USE domwri ! domain: write the meshmask file
37	#if ! defined key_qco
38	USE domvvl ! variable volume
39	#else
40	USE domqco ! variable volume
41	#endif
42	USE c1d ! 1D configuration
43	USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine)
44	USE wet_dry, ONLY : ll_wd
45	USE closea , ONLY : dom_clo ! closed seas
46	!
47	USE in_out_manager ! I/O manager
48	USE iom ! I/O library
49	USE lbclnk ! ocean lateral boundary condition (or mpp link)
50	USE lib_mpp ! distributed memory computing library
51
52	IMPLICIT NONE
53	PRIVATE
54
55	PUBLIC dom_init ! called by nemogcm.F90
56	PUBLIC domain_cfg ! called by nemogcm.F90
57
58	!!-------------------------------------------------------------------------
59	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
60	!! $Id$
61	!! Software governed by the CeCILL license (see ./LICENSE)
62	!!-------------------------------------------------------------------------
63	CONTAINS
64
65	SUBROUTINE dom_init( Kbb, Kmm, Kaa, cdstr )
66	!!----------------------------------------------------------------------
67	!! * ROUTINE dom_init *
68	!!
69	!! ** Purpose : Domain initialization. Call the routines that are
70	!! required to create the arrays which define the space
71	!! and time domain of the ocean model.
72	!!
73	!! ** Method : - dom_msk: compute the masks from the bathymetry file
74	!! - dom_hgr: compute or read the horizontal grid-point position
75	!! and scale factors, and the coriolis factor
76	!! - dom_zgr: define the vertical coordinate and the bathymetry
77	!! - dom_wri: create the meshmask file (ln_meshmask=T)
78	!! - 1D configuration, move Coriolis, u and v at T-point
79	!!----------------------------------------------------------------------
80	INTEGER , INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
81	CHARACTER (len=*), INTENT(in) :: cdstr ! model: NEMO or SAS. Determines core restart variables
82	!
83	INTEGER :: ji, jj, jk, jt ! dummy loop indices
84	INTEGER :: iconf = 0 ! local integers
85	CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))"
86	INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level
87	REAL(wp), DIMENSION(jpi,jpj) :: z1_hu_0, z1_hv_0
88	!!----------------------------------------------------------------------
89	!
90	IF(lwp) THEN ! Ocean domain Parameters (control print)
91	WRITE(numout,*)
92	WRITE(numout,*) 'dom_init : domain initialization'
93	WRITE(numout,*) '~~~~~~~~'
94	!
95	WRITE(numout,*) ' Domain info'
96	WRITE(numout,*) ' dimension of model:'
97	WRITE(numout,*) ' Local domain Global domain Data domain '
98	WRITE(numout,cform) ' ',' jpi : ', jpi, ' jpiglo : ', jpiglo
99	WRITE(numout,cform) ' ',' jpj : ', jpj, ' jpjglo : ', jpjglo
100	WRITE(numout,cform) ' ',' jpk : ', jpk, ' jpkglo : ', jpkglo
101	WRITE(numout,cform) ' ' ,' jpij : ', jpij
102	WRITE(numout,*) ' mpp local domain info (mpp):'
103	WRITE(numout,*) ' jpni : ', jpni, ' nn_hls : ', nn_hls
104	WRITE(numout,*) ' jpnj : ', jpnj, ' nn_hls : ', nn_hls
105	WRITE(numout,*) ' jpnij : ', jpnij
106	WRITE(numout,*) ' lateral boundary of the Global domain : jperio = ', jperio
107	SELECT CASE ( jperio )
108	CASE( 0 ) ; WRITE(numout,*) ' (i.e. closed)'
109	CASE( 1 ) ; WRITE(numout,*) ' (i.e. cyclic east-west)'
110	CASE( 2 ) ; WRITE(numout,*) ' (i.e. cyclic north-south)'
111	CASE( 3 ) ; WRITE(numout,*) ' (i.e. north fold with T-point pivot)'
112	CASE( 4 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with T-point pivot)'
113	CASE( 5 ) ; WRITE(numout,*) ' (i.e. north fold with F-point pivot)'
114	CASE( 6 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with F-point pivot)'
115	CASE( 7 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north-south)'
116	CASE DEFAULT
117	CALL ctl_stop( 'dom_init: jperio is out of range' )
118	END SELECT
119	WRITE(numout,*) ' Ocean model configuration used:'
120	WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg
121	ENDIF
122	lwxios = .FALSE.
123	ln_xios_read = .FALSE.
124	!
125	! !== Reference coordinate system ==!
126	!
127	CALL dom_glo ! global domain versus local domain
128	CALL dom_nam ! read namelist ( namrun, namdom )
129	!
130	IF( lwxios ) THEN
131	!define names for restart write and set core output (restart.F90)
132	CALL iom_set_rst_vars(rst_wfields)
133	CALL iom_set_rstw_core(cdstr)
134	ENDIF
135	!reset namelist for SAS
136	IF(cdstr == 'SAS') THEN
137	IF(lrxios) THEN
138	IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'
139	lrxios = .FALSE.
140	ENDIF
141	ENDIF
142	!
143	CALL dom_hgr ! Horizontal mesh
144
145	IF( ln_closea ) CALL dom_clo ! Read in masks to define closed seas and lakes
146
147	CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry (return top and bottom ocean t-level indices)
148
149	CALL dom_msk( ik_top, ik_bot ) ! Masks
150	!
151	ht_0(:,:) = 0._wp ! Reference ocean thickness
152	hu_0(:,:) = 0._wp
153	hv_0(:,:) = 0._wp
154	hf_0(:,:) = 0._wp
155	DO jk = 1, jpk
156	ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
157	hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
158	hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
159	hf_0(:,:) = hf_0(:,:) + e3f_0(:,:,jk) * fmask(:,:,jk)
160	END DO
161	!
162	r1_ht_0(:,:) = ssmask (:,:) / ( ht_0(:,:) + 1._wp - ssmask (:,:) )
163	r1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) )
164	r1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
165	r1_hf_0(:,:) = ssfmask(:,:) / ( hf_0(:,:) + 1._wp - ssfmask(:,:) )
166
167	!
168	#if defined key_qco
169	! !== initialisation of time varying coordinate ==! Quasi-Euerian coordinate case
170	!
171	IF( .NOT.l_offline ) CALL dom_qco_init( Kbb, Kmm, Kaa )
172	!
173	IF( ln_linssh ) CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible')
174	!
175	#else
176	! !== time varying part of coordinate system ==!
177	!
178	IF( ln_linssh ) THEN != Fix in time : set to the reference one for all
179	!
180	DO jt = 1, jpt ! depth of t- and w-grid-points
181	gdept(:,:,:,jt) = gdept_0(:,:,:)
182	gdepw(:,:,:,jt) = gdepw_0(:,:,:)
183	END DO
184	gde3w(:,:,:) = gde3w_0(:,:,:) ! = gdept as the sum of e3t
185	!
186	DO jt = 1, jpt ! vertical scale factors
187	e3t(:,:,:,jt) = e3t_0(:,:,:)
188	e3u(:,:,:,jt) = e3u_0(:,:,:)
189	e3v(:,:,:,jt) = e3v_0(:,:,:)
190	e3w(:,:,:,jt) = e3w_0(:,:,:)
191	e3uw(:,:,:,jt) = e3uw_0(:,:,:)
192	e3vw(:,:,:,jt) = e3vw_0(:,:,:)
193	END DO
194	e3f(:,:,:) = e3f_0(:,:,:)
195	!
196	DO jt = 1, jpt ! water column thickness and its inverse
197	hu(:,:,jt) = hu_0(:,:)
198	hv(:,:,jt) = hv_0(:,:)
199	r1_hu(:,:,jt) = r1_hu_0(:,:)
200	r1_hv(:,:,jt) = r1_hv_0(:,:)
201	END DO
202	ht(:,:) = ht_0(:,:)
203	!
204	ELSE != time varying : initialize before/now/after variables
205	!
206	IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa )
207	!
208	ENDIF
209	#endif
210
211	!
212
213	IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point
214	!
215
216	#if defined key_agrif
217	IF( .NOT. Agrif_Root() ) CALL Agrif_Init_Domain( Kbb, Kmm, Kaa )
218	#endif
219	IF( ln_meshmask ) CALL dom_wri ! Create a domain file
220	IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
221	!
222	IF( ln_write_cfg ) CALL cfg_write ! create the configuration file
223	!
224	IF(lwp) THEN
225	WRITE(numout,*)
226	WRITE(numout,*) 'dom_init : ==>>> END of domain initialization'
227	WRITE(numout,*) '~~~~~~~~'
228	WRITE(numout,*)
229	ENDIF
230	!
231	END SUBROUTINE dom_init
232
233
234	SUBROUTINE dom_glo
235	!!----------------------------------------------------------------------
236	!! * ROUTINE dom_glo *
237	!!
238	!! ** Purpose : initialization of global domain <--> local domain indices
239	!!
240	!! ** Method :
241	!!
242	!! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices
243	!! - mig0, mjg0: local domain indices ==> global domain, excluding halos, indices
244	!! - mi0 , mi1 : global domain indices ==> local domain indices
245	!! - mj0 , mj1 (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
246	!!----------------------------------------------------------------------
247	INTEGER :: ji, jj ! dummy loop argument
248	!!----------------------------------------------------------------------
249	!
250	DO ji = 1, jpi ! local domain indices ==> global domain indices, including halos
251	mig(ji) = ji + nimpp - 1
252	END DO
253	DO jj = 1, jpj
254	mjg(jj) = jj + njmpp - 1
255	END DO
256	! ! local domain indices ==> global domain indices, excluding halos
257	!
258	mig0(:) = mig(:) - nn_hls
259	mjg0(:) = mjg(:) - nn_hls
260	! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,
261	! we must define mig0 and mjg0 as bellow.
262	! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as:
263	mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) )
264	mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) )
265	!
266	! ! global domain, including halos, indices ==> local domain indices
267	! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
268	! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
269	DO ji = 1, jpiglo
270	mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
271	mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi ) )
272	END DO
273	DO jj = 1, jpjglo
274	mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
275	mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj ) )
276	END DO
277	IF(lwp) THEN ! control print
278	WRITE(numout,*)
279	WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
280	WRITE(numout,*) '~~~~~~~ '
281	WRITE(numout,*) ' global domain: jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
282	WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk
283	WRITE(numout,*)
284	ENDIF
285	!
286	END SUBROUTINE dom_glo
287
288
289	SUBROUTINE dom_nam
290	!!----------------------------------------------------------------------
291	!! * ROUTINE dom_nam *
292	!!
293	!! ** Purpose : read domaine namelists and print the variables.
294	!!
295	!! ** input : - namrun namelist
296	!! - namdom namelist
297	!! - namnc4 namelist ! "key_netcdf4" only
298	!!----------------------------------------------------------------------
299	USE ioipsl
300	!!
301	INTEGER :: ios ! Local integer
302	!
303	NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, &
304	& nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , &
305	& nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , &
306	& nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, ln_1st_euler , &
307	& ln_cfmeta, ln_xios_read, nn_wxios
308	NAMELIST/namdom/ ln_linssh, rn_Dt, rn_atfp, ln_crs, ln_meshmask
309	#if defined key_netcdf4
310	NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
311	#endif
312	!!----------------------------------------------------------------------
313	!
314	IF(lwp) THEN
315	WRITE(numout,*)
316	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
317	WRITE(numout,*) '~~~~~~~ '
318	ENDIF
319	!
320	!
321	READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
322	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist' )
323	READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
324	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist' )
325	IF(lwm) WRITE ( numond, namrun )
326
327	#if defined key_agrif
328	IF( .NOT. Agrif_Root() ) THEN
329	nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1
330	nn_itend = Agrif_Parent(nn_itend) *Agrif_IRhot()
331	ENDIF
332	#endif
333	!
334	IF(lwp) THEN ! control print
335	WRITE(numout,*) ' Namelist : namrun --- run parameters'
336	WRITE(numout,*) ' Assimilation cycle nn_no = ', nn_no
337	WRITE(numout,*) ' experiment name for output cn_exp = ', TRIM( cn_exp )
338	WRITE(numout,*) ' file prefix restart input cn_ocerst_in = ', TRIM( cn_ocerst_in )
339	WRITE(numout,*) ' restart input directory cn_ocerst_indir = ', TRIM( cn_ocerst_indir )
340	WRITE(numout,*) ' file prefix restart output cn_ocerst_out = ', TRIM( cn_ocerst_out )
341	WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
342	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
343	WRITE(numout,*) ' start with forward time step ln_1st_euler = ', ln_1st_euler
344	WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl
345	WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000
346	WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend
347	WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0
348	WRITE(numout,*) ' initial time of day in hhmm nn_time0 = ', nn_time0
349	WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy
350	WRITE(numout,*) ' initial state output nn_istate = ', nn_istate
351	IF( ln_rst_list ) THEN
352	WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist
353	ELSE
354	WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
355	ENDIF
356	#if ! defined key_iomput
357	WRITE(numout,*) ' frequency of output file nn_write = ', nn_write
358	#endif
359	WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland
360	WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta
361	WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
362	WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
363	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
364	WRITE(numout,*) ' READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
365	WRITE(numout,*) ' Write restart using XIOS nn_wxios = ', nn_wxios
366	ELSE
367	WRITE(numout,*) " AGRIF: nn_wxios will be ingored. See setting for parent"
368	WRITE(numout,*) " AGRIF: ln_xios_read will be ingored. See setting for parent"
369	ENDIF
370	ENDIF
371
372	cexper = cn_exp ! conversion DOCTOR names into model names (this should disappear soon)
373	nrstdt = nn_rstctl
374	nit000 = nn_it000
375	nitend = nn_itend
376	ndate0 = nn_date0
377	nleapy = nn_leapy
378	ninist = nn_istate
379	l_1st_euler = ln_1st_euler
380	IF( .NOT. l_1st_euler .AND. .NOT. ln_rstart ) THEN
381	IF(lwp) WRITE(numout,*)
382	IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)'
383	IF(lwp) WRITE(numout,*)' an Euler initial time step is used : l_1st_euler is forced to .true. '
384	l_1st_euler = .true.
385	ENDIF
386	! ! control of output frequency
387	IF( .NOT. ln_rst_list ) THEN ! we use nn_stock
388	IF( nn_stock == -1 ) CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' )
389	IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN
390	WRITE(ctmp1,*) 'nn_stock = ', nn_stock, ' it is forced to ', nitend
391	CALL ctl_warn( ctmp1 )
392	nn_stock = nitend
393	ENDIF
394	ENDIF
395	#if ! defined key_iomput
396	IF( nn_write == -1 ) CALL ctl_warn( 'nn_write = -1 --> no output files will be done' )
397	IF ( nn_write == 0 ) THEN
398	WRITE(ctmp1,*) 'nn_write = ', nn_write, ' it is forced to ', nitend
399	CALL ctl_warn( ctmp1 )
400	nn_write = nitend
401	ENDIF
402	#endif
403
404	IF( Agrif_Root() ) THEN
405	IF(lwp) WRITE(numout,*)
406	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
407	CASE ( 1 )
408	CALL ioconf_calendar('gregorian')
409	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year'
410	CASE ( 0 )
411	CALL ioconf_calendar('noleap')
412	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year'
413	CASE ( 30 )
414	CALL ioconf_calendar('360d')
415	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year'
416	END SELECT
417	ENDIF
418
419	READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
420	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' )
421	READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
422	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' )
423	IF(lwm) WRITE( numond, namdom )
424	!
425	#if defined key_agrif
426	IF( .NOT. Agrif_Root() ) THEN
427	rn_Dt = Agrif_Parent(rn_Dt) / Agrif_Rhot()
428	ENDIF
429	#endif
430	!
431	IF(lwp) THEN
432	WRITE(numout,*)
433	WRITE(numout,*) ' Namelist : namdom --- space & time domain'
434	WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh
435	WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask
436	WRITE(numout,*) ' ocean time step rn_Dt = ', rn_Dt
437	WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
438	WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs
439	ENDIF
440	!
441	!! Initialise current model timestep rDt = 2*rn_Dt if MLF or rDt = rn_Dt if RK3
442	rDt = 2._wp * rn_Dt
443	r1_Dt = 1._wp / rDt
444
445	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
446	lrxios = ln_xios_read.AND.ln_rstart
447	!set output file type for XIOS based on NEMO namelist
448	IF (nn_wxios > 0) lwxios = .TRUE.
449	nxioso = nn_wxios
450	ENDIF
451
452	#if defined key_netcdf4
453	! ! NetCDF 4 case ("key_netcdf4" defined)
454	READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
455	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
456	READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
457	908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
458	IF(lwm) WRITE( numond, namnc4 )
459
460	IF(lwp) THEN ! control print
461	WRITE(numout,*)
462	WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
463	WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
464	WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
465	WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
466	WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
467	ENDIF
468
469	! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
470	! Note the chunk size in the unlimited (time) dimension will be fixed at 1
471	snc4set%ni = nn_nchunks_i
472	snc4set%nj = nn_nchunks_j
473	snc4set%nk = nn_nchunks_k
474	snc4set%luse = ln_nc4zip
475	#else
476	snc4set%luse = .FALSE. ! No NetCDF 4 case
477	#endif
478	!
479	END SUBROUTINE dom_nam
480
481
482	SUBROUTINE dom_ctl
483	!!----------------------------------------------------------------------
484	!! * ROUTINE dom_ctl *
485	!!
486	!! ** Purpose : Domain control.
487	!!
488	!! ** Method : compute and print extrema of masked scale factors
489	!!----------------------------------------------------------------------
490	LOGICAL, DIMENSION(jpi,jpj) :: llmsk
491	INTEGER, DIMENSION(2) :: imil, imip, imi1, imi2, imal, imap, ima1, ima2
492	REAL(wp) :: zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max
493	!!----------------------------------------------------------------------
494	!
495	llmsk = tmask_h(:,:) == 1._wp
496	!
497	CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil )
498	CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip )
499	CALL mpp_minloc( 'domain', e1t(:,:), llmsk, ze1min, imi1 )
500	CALL mpp_minloc( 'domain', e2t(:,:), llmsk, ze2min, imi2 )
501	CALL mpp_maxloc( 'domain', glamt(:,:), llmsk, zglmax, imal )
502	CALL mpp_maxloc( 'domain', gphit(:,:), llmsk, zgpmax, imap )
503	CALL mpp_maxloc( 'domain', e1t(:,:), llmsk, ze1max, ima1 )
504	CALL mpp_maxloc( 'domain', e2t(:,:), llmsk, ze2max, ima2 )
505	!
506	IF(lwp) THEN
507	WRITE(numout,*)
508	WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
509	WRITE(numout,*) '~~~~~~~'
510	WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2)
511	WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2)
512	WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2)
513	WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2)
514	WRITE(numout,"(14x,' e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
515	WRITE(numout,"(14x,' e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
516	WRITE(numout,"(14x,' e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
517	WRITE(numout,"(14x,' e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
518	ENDIF
519	!
520	END SUBROUTINE dom_ctl
521
522
523	SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
524	!!----------------------------------------------------------------------
525	!! * ROUTINE dom_nam *
526	!!
527	!! ** Purpose : read the domain size in domain configuration file
528	!!
529	!! ** Method : read the cn_domcfg NetCDF file
530	!!----------------------------------------------------------------------
531	CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name
532	INTEGER , INTENT(out) :: kk_cfg ! configuration resolution
533	INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes
534	INTEGER , INTENT(out) :: kperio ! lateral global domain b.c.
535	!
536	INTEGER :: inum ! local integer
537	REAL(wp) :: zorca_res ! local scalars
538	REAL(wp) :: zperio ! - -
539	INTEGER, DIMENSION(4) :: idvar, idimsz ! size of dimensions
540	!!----------------------------------------------------------------------
541	!
542	IF(lwp) THEN
543	WRITE(numout,*) ' '
544	WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
545	WRITE(numout,*) '~~~~~~~~~~ '
546	ENDIF
547	!
548	CALL iom_open( cn_domcfg, inum )
549	!
550	! !- ORCA family specificity
551	IF( iom_varid( inum, 'ORCA' , ldstop = .FALSE. ) > 0 .AND. &
552	& iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0 ) THEN
553	!
554	cd_cfg = 'ORCA'
555	CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res )
556	!
557	IF(lwp) THEN
558	WRITE(numout,*) ' .'
559	WRITE(numout,*) ' ==>>> ORCA configuration '
560	WRITE(numout,*) ' .'
561	ENDIF
562	!
563	ELSE !- cd_cfg & k_cfg are not used
564	cd_cfg = 'UNKNOWN'
565	kk_cfg = -9999999
566	!- or they may be present as global attributes
567	!- (netcdf only)
568	CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found
569	CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found
570	IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
571	IF( kk_cfg == -999 ) kk_cfg = -9999999
572	!
573	ENDIF
574	!
575	idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz ) ! use e3t_0, that must exist, to get jp(ijk)glo
576	kpi = idimsz(1)
577	kpj = idimsz(2)
578	kpk = idimsz(3)
579	CALL iom_get( inum, 'jperio', zperio ) ; kperio = NINT( zperio )
580	CALL iom_close( inum )
581	!
582	IF(lwp) THEN
583	WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg
584	WRITE(numout,*) ' Ni0glo = ', kpi
585	WRITE(numout,*) ' Nj0glo = ', kpj
586	WRITE(numout,*) ' jpkglo = ', kpk
587	WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio
588	ENDIF
589	!
590	END SUBROUTINE domain_cfg
591
592
593	SUBROUTINE cfg_write
594	!!----------------------------------------------------------------------
595	!! * ROUTINE cfg_write *
596	!!
597	!! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which
598	!! contains all the ocean domain informations required to
599	!! define an ocean configuration.
600	!!
601	!! ** Method : Write in a file all the arrays required to set up an
602	!! ocean configuration.
603	!!
604	!! ** output file : domcfg_out.nc : domain size, characteristics, horizontal
605	!! mesh, Coriolis parameter, and vertical scale factors
606	!! NB: also contain ORCA family information
607	!!----------------------------------------------------------------------
608	INTEGER :: ji, jj, jk ! dummy loop indices
609	INTEGER :: inum ! local units
610	CHARACTER(len=21) :: clnam ! filename (mesh and mask informations)
611	REAL(wp), DIMENSION(jpi,jpj) :: z2d ! workspace
612	!!----------------------------------------------------------------------
613	!
614	IF(lwp) WRITE(numout,*)
615	IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
616	IF(lwp) WRITE(numout,*) '~~~~~~~~~'
617	!
618	! ! ============================= !
619	! ! create 'domcfg_out.nc' file !
620	! ! ============================= !
621	!
622	clnam = cn_domcfg_out ! filename (configuration information)
623	CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
624	!
625	! !== ORCA family specificities ==!
626	IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN
627	CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 )
628	CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )
629	ENDIF
630	!
631	! !== domain characteristics ==!
632	!
633	! ! lateral boundary of the global domain
634	CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
635	!
636	! ! type of vertical coordinate
637	CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 )
638	CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 )
639	CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 )
640	!
641	! ! ocean cavities under iceshelves
642	CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 )
643	!
644	! !== horizontal mesh !
645	!
646	CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 ) ! latitude
647	CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
648	CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
649	CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
650	!
651	CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 ) ! longitude
652	CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
653	CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
654	CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
655	!
656	CALL iom_rstput( 0, 0, inum, 'e1t' , e1t , ktype = jp_r8 ) ! i-scale factors (e1.)
657	CALL iom_rstput( 0, 0, inum, 'e1u' , e1u , ktype = jp_r8 )
658	CALL iom_rstput( 0, 0, inum, 'e1v' , e1v , ktype = jp_r8 )
659	CALL iom_rstput( 0, 0, inum, 'e1f' , e1f , ktype = jp_r8 )
660	!
661	CALL iom_rstput( 0, 0, inum, 'e2t' , e2t , ktype = jp_r8 ) ! j-scale factors (e2.)
662	CALL iom_rstput( 0, 0, inum, 'e2u' , e2u , ktype = jp_r8 )
663	CALL iom_rstput( 0, 0, inum, 'e2v' , e2v , ktype = jp_r8 )
664	CALL iom_rstput( 0, 0, inum, 'e2f' , e2f , ktype = jp_r8 )
665	!
666	CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 ) ! coriolis factor
667	CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
668	!
669	! !== vertical mesh ==!
670	!
671	CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate
672	CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 )
673	!
674	CALL iom_rstput( 0, 0, inum, 'e3t_0' , e3t_0 , ktype = jp_r8 ) ! vertical scale factors
675	CALL iom_rstput( 0, 0, inum, 'e3u_0' , e3u_0 , ktype = jp_r8 )
676	CALL iom_rstput( 0, 0, inum, 'e3v_0' , e3v_0 , ktype = jp_r8 )
677	CALL iom_rstput( 0, 0, inum, 'e3f_0' , e3f_0 , ktype = jp_r8 )
678	CALL iom_rstput( 0, 0, inum, 'e3w_0' , e3w_0 , ktype = jp_r8 )
679	CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 )
680	CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 )
681	!
682	! !== wet top and bottom level ==! (caution: multiplied by ssmask)
683	!
684	CALL iom_rstput( 0, 0, inum, 'top_level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points (ISF)
685	CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points
686	!
687	IF( ln_sco ) THEN ! s-coordinate: store grid stiffness ratio (Not required anyway)
688	CALL dom_stiff( z2d )
689	CALL iom_rstput( 0, 0, inum, 'stiffness', z2d ) ! ! Max. grid stiffness ratio
690	ENDIF
691	!
692	IF( ll_wd ) THEN ! wetting and drying domain
693	CALL iom_rstput( 0, 0, inum, 'ht_0' , ht_0 , ktype = jp_r8 )
694	ENDIF
695	!
696	! Add some global attributes ( netcdf only )
697	CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
698	CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
699	!
700	! ! ============================
701	! ! close the files
702	! ! ============================
703	CALL iom_close( inum )
704	!
705	END SUBROUTINE cfg_write
706
707	!!======================================================================
708	END MODULE domain

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

Download in other formats: