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

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

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

Download in other formats: