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/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/DOM – NEMO

Context Navigation

source: NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/DOM/domain.F90 @ 12962

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

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

Download in other formats: