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

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

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

Download in other formats: