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

Last change on this file since 13286 was 13286, checked in by smasson, 4 years ago
trunk: merge extra halos branch in trunk, see #2366
Property svn:keywords set to `Id`
File size: 36.1 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, including halos, indices
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, excluding halos, indices
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	IF(lk_mpp) THEN
496	CALL mpp_minloc( 'domain', glamt(:,:), tmask_i(:,:), zglmin, imil )
497	CALL mpp_minloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmin, imip )
498	CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 )
499	CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 )
500	CALL mpp_maxloc( 'domain', glamt(:,:), tmask_i(:,:), zglmax, imal )
501	CALL mpp_maxloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmax, imap )
502	CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 )
503	CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 )
504	ELSE
505	llmsk = tmask_i(:,:) == 1._wp
506	zglmin = MINVAL( glamt(:,:), mask = llmsk )
507	zgpmin = MINVAL( gphit(:,:), mask = llmsk )
508	ze1min = MINVAL( e1t(:,:), mask = llmsk )
509	ze2min = MINVAL( e2t(:,:), mask = llmsk )
510	zglmin = MAXVAL( glamt(:,:), mask = llmsk )
511	zgpmin = MAXVAL( gphit(:,:), mask = llmsk )
512	ze1max = MAXVAL( e1t(:,:), mask = llmsk )
513	ze2max = MAXVAL( e2t(:,:), mask = llmsk )
514	!
515	imil = MINLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
516	imip = MINLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
517	imi1 = MINLOC( e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
518	imi2 = MINLOC( e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
519	imal = MAXLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
520	imap = MAXLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
521	ima1 = MAXLOC( e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
522	ima2 = MAXLOC( e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /)
523	ENDIF
524	!
525	IF(lwp) THEN
526	WRITE(numout,*)
527	WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
528	WRITE(numout,*) '~~~~~~~'
529	WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2)
530	WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2)
531	WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2)
532	WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2)
533	WRITE(numout,"(14x,' e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
534	WRITE(numout,"(14x,' e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
535	WRITE(numout,"(14x,' e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
536	WRITE(numout,"(14x,' e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
537	ENDIF
538	!
539	END SUBROUTINE dom_ctl
540
541
542	SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
543	!!----------------------------------------------------------------------
544	!! * ROUTINE dom_nam *
545	!!
546	!! ** Purpose : read the domain size in domain configuration file
547	!!
548	!! ** Method : read the cn_domcfg NetCDF file
549	!!----------------------------------------------------------------------
550	CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name
551	INTEGER , INTENT(out) :: kk_cfg ! configuration resolution
552	INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes
553	INTEGER , INTENT(out) :: kperio ! lateral global domain b.c.
554	!
555	INTEGER :: inum ! local integer
556	REAL(wp) :: zorca_res ! local scalars
557	REAL(wp) :: zperio ! - -
558	INTEGER, DIMENSION(4) :: idvar, idimsz ! size of dimensions
559	!!----------------------------------------------------------------------
560	!
561	IF(lwp) THEN
562	WRITE(numout,*) ' '
563	WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
564	WRITE(numout,*) '~~~~~~~~~~ '
565	ENDIF
566	!
567	CALL iom_open( cn_domcfg, inum )
568	!
569	! !- ORCA family specificity
570	IF( iom_varid( inum, 'ORCA' , ldstop = .FALSE. ) > 0 .AND. &
571	& iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0 ) THEN
572	!
573	cd_cfg = 'ORCA'
574	CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res )
575	!
576	IF(lwp) THEN
577	WRITE(numout,*) ' .'
578	WRITE(numout,*) ' ==>>> ORCA configuration '
579	WRITE(numout,*) ' .'
580	ENDIF
581	!
582	ELSE !- cd_cfg & k_cfg are not used
583	cd_cfg = 'UNKNOWN'
584	kk_cfg = -9999999
585	!- or they may be present as global attributes
586	!- (netcdf only)
587	CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found
588	CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found
589	IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
590	IF( kk_cfg == -999 ) kk_cfg = -9999999
591	!
592	ENDIF
593	!
594	idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz ) ! use e3t_0, that must exist, to get jp(ijk)glo
595	kpi = idimsz(1)
596	kpj = idimsz(2)
597	kpk = idimsz(3)
598	CALL iom_get( inum, 'jperio', zperio ) ; kperio = NINT( zperio )
599	CALL iom_close( inum )
600	!
601	IF(lwp) THEN
602	WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg
603	WRITE(numout,*) ' Ni0glo = ', kpi
604	WRITE(numout,*) ' Nj0glo = ', kpj
605	WRITE(numout,*) ' jpkglo = ', kpk
606	WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio
607	ENDIF
608	!
609	END SUBROUTINE domain_cfg
610
611
612	SUBROUTINE cfg_write
613	!!----------------------------------------------------------------------
614	!! * ROUTINE cfg_write *
615	!!
616	!! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which
617	!! contains all the ocean domain informations required to
618	!! define an ocean configuration.
619	!!
620	!! ** Method : Write in a file all the arrays required to set up an
621	!! ocean configuration.
622	!!
623	!! ** output file : domcfg_out.nc : domain size, characteristics, horizontal
624	!! mesh, Coriolis parameter, and vertical scale factors
625	!! NB: also contain ORCA family information
626	!!----------------------------------------------------------------------
627	INTEGER :: ji, jj, jk ! dummy loop indices
628	INTEGER :: inum ! local units
629	CHARACTER(len=21) :: clnam ! filename (mesh and mask informations)
630	REAL(wp), DIMENSION(jpi,jpj) :: z2d ! workspace
631	!!----------------------------------------------------------------------
632	!
633	IF(lwp) WRITE(numout,*)
634	IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
635	IF(lwp) WRITE(numout,*) '~~~~~~~~~'
636	!
637	! ! ============================= !
638	! ! create 'domcfg_out.nc' file !
639	! ! ============================= !
640	!
641	clnam = cn_domcfg_out ! filename (configuration information)
642	CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
643	!
644	! !== ORCA family specificities ==!
645	IF( cn_cfg == "ORCA" ) THEN
646	CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 )
647	CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )
648	ENDIF
649	!
650	! !== domain characteristics ==!
651	!
652	! ! lateral boundary of the global domain
653	CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
654	!
655	! ! type of vertical coordinate
656	CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 )
657	CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 )
658	CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 )
659	!
660	! ! ocean cavities under iceshelves
661	CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 )
662	!
663	! !== horizontal mesh !
664	!
665	CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 ) ! latitude
666	CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
667	CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
668	CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
669	!
670	CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 ) ! longitude
671	CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
672	CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
673	CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
674	!
675	CALL iom_rstput( 0, 0, inum, 'e1t' , e1t , ktype = jp_r8 ) ! i-scale factors (e1.)
676	CALL iom_rstput( 0, 0, inum, 'e1u' , e1u , ktype = jp_r8 )
677	CALL iom_rstput( 0, 0, inum, 'e1v' , e1v , ktype = jp_r8 )
678	CALL iom_rstput( 0, 0, inum, 'e1f' , e1f , ktype = jp_r8 )
679	!
680	CALL iom_rstput( 0, 0, inum, 'e2t' , e2t , ktype = jp_r8 ) ! j-scale factors (e2.)
681	CALL iom_rstput( 0, 0, inum, 'e2u' , e2u , ktype = jp_r8 )
682	CALL iom_rstput( 0, 0, inum, 'e2v' , e2v , ktype = jp_r8 )
683	CALL iom_rstput( 0, 0, inum, 'e2f' , e2f , ktype = jp_r8 )
684	!
685	CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 ) ! coriolis factor
686	CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
687	!
688	! !== vertical mesh ==!
689	!
690	CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate
691	CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 )
692	!
693	CALL iom_rstput( 0, 0, inum, 'e3t_0' , e3t_0 , ktype = jp_r8 ) ! vertical scale factors
694	CALL iom_rstput( 0, 0, inum, 'e3u_0' , e3u_0 , ktype = jp_r8 )
695	CALL iom_rstput( 0, 0, inum, 'e3v_0' , e3v_0 , ktype = jp_r8 )
696	CALL iom_rstput( 0, 0, inum, 'e3f_0' , e3f_0 , ktype = jp_r8 )
697	CALL iom_rstput( 0, 0, inum, 'e3w_0' , e3w_0 , ktype = jp_r8 )
698	CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 )
699	CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 )
700	!
701	! !== wet top and bottom level ==! (caution: multiplied by ssmask)
702	!
703	CALL iom_rstput( 0, 0, inum, 'top_level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points (ISF)
704	CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points
705	!
706	IF( ln_sco ) THEN ! s-coordinate: store grid stiffness ratio (Not required anyway)
707	CALL dom_stiff( z2d )
708	CALL iom_rstput( 0, 0, inum, 'stiffness', z2d ) ! ! Max. grid stiffness ratio
709	ENDIF
710	!
711	IF( ll_wd ) THEN ! wetting and drying domain
712	CALL iom_rstput( 0, 0, inum, 'ht_0' , ht_0 , ktype = jp_r8 )
713	ENDIF
714	!
715	! Add some global attributes ( netcdf only )
716	CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
717	CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
718	!
719	! ! ============================
720	! ! close the files
721	! ! ============================
722	CALL iom_close( inum )
723	!
724	END SUBROUTINE cfg_write
725
726	!!======================================================================
727	END MODULE domain

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

Download in other formats: