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_r12377_KERNEL-06_techene_e3/src/OCE/DOM – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domain.F90 @ 12731

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

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

Download in other formats: