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_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DOM – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/DOM/domain.F90 @ 14037

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

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

Download in other formats: