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/trunk/src/OCE/DOM – NEMO

Context Navigation

source: NEMO/trunk/src/OCE/DOM/domain.F90 @ 13558

Last change on this file since 13558 was 13558, checked in by smasson, 4 years ago
trunk: pass sette tests with debugging option -init=arrays,snan,huge, see #2535
Property svn:keywords set to `Id`
File size: 34.9 KB

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

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

Download in other formats: