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_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM/domain.F90 @ 13737

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

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

Download in other formats: