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/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/domain.F90 @ 13553

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

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

Download in other formats: