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 @ 12680

Last change on this file since 12680 was 12680, checked in by techene, 4 years ago
dynatfQCO.F90, stepLF.F90 : fixed (remove pe3. from dyn_atf_qco input arguments), all : remove e3. tables and include gurvan's feedbacks
Property svn:keywords set to `Id`
File size: 35.3 KB

Line
1	MODULE domain
2	!!==============================================================================
3	!! * MODULE domain *
4	!! Ocean initialization : domain initialization
5	!!==============================================================================
6	!! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code
7	!! ! 1992-01 (M. Imbard) insert time step initialization
8	!! ! 1996-06 (G. Madec) generalized vertical coordinate
9	!! ! 1997-02 (G. Madec) creation of domwri.F
10	!! ! 2001-05 (E.Durand - G. Madec) insert closed sea
11	!! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module
12	!! 2.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization
13	!! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration
14	!! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
15	!! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default
16	!! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface
17	!! 4.x ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio
18	!!----------------------------------------------------------------------
19
20	!!----------------------------------------------------------------------
21	!! dom_init : initialize the space and time domain
22	!! dom_glo : initialize global domain <--> local domain indices
23	!! dom_nam : read and contral domain namelists
24	!! dom_ctl : control print for the ocean domain
25	!! domain_cfg : read the global domain size in domain configuration file
26	!! cfg_write : create the domain configuration file
27	!!----------------------------------------------------------------------
28	USE oce ! ocean variables
29	USE dom_oce ! domain: ocean
30	USE sbc_oce ! surface boundary condition: ocean
31	USE trc_oce ! shared ocean & passive tracers variab
32	USE phycst ! physical constants
33	USE domhgr ! domain: set the horizontal mesh
34	USE domzgr ! domain: set the vertical mesh
35	USE dommsk ! domain: set the mask system
36	USE domwri ! domain: write the meshmask file
37	#if ! defined key_qco
38	USE domvvl ! variable volume
39	#else
40	USE 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	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	! !== time varying part of coordinate system ==!
169	!
170	IF( ln_linssh ) THEN != Fix in time : set to the reference one for all
171	!
172	DO jt = 1, jpt ! depth of t- and w-grid-points
173	gdept(:,:,:,jt) = gdept_0(:,:,:)
174	gdepw(:,:,:,jt) = gdepw_0(:,:,:)
175	END DO
176	gde3w(:,:,:) = gde3w_0(:,:,:) ! = gdept as the sum of e3t
177	!
178	#if defined key_qco
179	! Quasi-Euerian coordinate : no initialisation of e3. scale factors
180	#else
181	DO jt = 1, jpt ! vertical scale factors
182	e3t(:,:,:,jt) = e3t_0(:,:,:)
183	e3u(:,:,:,jt) = e3u_0(:,:,:)
184	e3v(:,:,:,jt) = e3v_0(:,:,:)
185	e3w(:,:,:,jt) = e3w_0(:,:,:)
186	e3uw(:,:,:,jt) = e3uw_0(:,:,:)
187	e3vw(:,:,:,jt) = e3vw_0(:,:,:)
188	END DO
189	e3f(:,:,:) = e3f_0(:,:,:)
190	!
191	#endif
192	!
193	DO jt = 1, jpt ! water column thickness and its inverse
194	hu(:,:,jt) = hu_0(:,:)
195	hv(:,:,jt) = hv_0(:,:)
196	r1_hu(:,:,jt) = r1_hu_0(:,:)
197	r1_hv(:,:,jt) = r1_hv_0(:,:)
198	END DO
199	ht(:,:) = ht_0(:,:)
200	!
201	ELSE != time varying : initialize before/now/after variables
202	!
203	#if defined key_qco
204	IF( .NOT.l_offline ) CALL dom_qe_init( Kbb, Kmm, Kaa )
205	#else
206	IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa )
207	#endif
208	!
209	ENDIF
210	!
211	IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point
212	!
213	IF( ln_meshmask ) CALL dom_wri ! Create a domain file
214	IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
215	!
216	IF( ln_write_cfg ) CALL cfg_write ! create the configuration file
217	!
218	IF(lwp) THEN
219	WRITE(numout,*)
220	WRITE(numout,*) 'dom_init : ==>>> END of domain initialization'
221	WRITE(numout,*) '~~~~~~~~'
222	WRITE(numout,*)
223	ENDIF
224	!
225	END SUBROUTINE dom_init
226
227
228	SUBROUTINE dom_glo
229	!!----------------------------------------------------------------------
230	!! * ROUTINE dom_glo *
231	!!
232	!! ** Purpose : initialization of global domain <--> local domain indices
233	!!
234	!! ** Method :
235	!!
236	!! ** Action : - mig , mjg : local domain indices ==> global domain indices
237	!! - mi0 , mi1 : global domain indices ==> local domain indices
238	!! - mj0,, mj1 (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
239	!!----------------------------------------------------------------------
240	INTEGER :: ji, jj ! dummy loop argument
241	!!----------------------------------------------------------------------
242	!
243	DO ji = 1, jpi ! local domain indices ==> global domain indices
244	mig(ji) = ji + nimpp - 1
245	END DO
246	DO jj = 1, jpj
247	mjg(jj) = jj + njmpp - 1
248	END DO
249	! ! global domain indices ==> local domain indices
250	! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
251	! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
252	DO ji = 1, jpiglo
253	mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
254	mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi ) )
255	END DO
256	DO jj = 1, jpjglo
257	mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
258	mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj ) )
259	END DO
260	IF(lwp) THEN ! control print
261	WRITE(numout,*)
262	WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
263	WRITE(numout,*) '~~~~~~~ '
264	WRITE(numout,*) ' global domain: jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
265	WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk
266	WRITE(numout,*)
267	WRITE(numout,*) ' conversion from local to global domain indices (and vise versa) done'
268	IF( nn_print >= 1 ) THEN
269	WRITE(numout,*)
270	WRITE(numout,*) ' conversion local ==> global i-index domain (mig)'
271	WRITE(numout,25) (mig(ji),ji = 1,jpi)
272	WRITE(numout,*)
273	WRITE(numout,*) ' conversion global ==> local i-index domain'
274	WRITE(numout,*) ' starting index (mi0)'
275	WRITE(numout,25) (mi0(ji),ji = 1,jpiglo)
276	WRITE(numout,*) ' ending index (mi1)'
277	WRITE(numout,25) (mi1(ji),ji = 1,jpiglo)
278	WRITE(numout,*)
279	WRITE(numout,*) ' conversion local ==> global j-index domain (mjg)'
280	WRITE(numout,25) (mjg(jj),jj = 1,jpj)
281	WRITE(numout,*)
282	WRITE(numout,*) ' conversion global ==> local j-index domain'
283	WRITE(numout,*) ' starting index (mj0)'
284	WRITE(numout,25) (mj0(jj),jj = 1,jpjglo)
285	WRITE(numout,*) ' ending index (mj1)'
286	WRITE(numout,25) (mj1(jj),jj = 1,jpjglo)
287	ENDIF
288	ENDIF
289	25 FORMAT( 100(10x,19i4,/) )
290	!
291	END SUBROUTINE dom_glo
292
293
294	SUBROUTINE dom_nam
295	!!----------------------------------------------------------------------
296	!! * ROUTINE dom_nam *
297	!!
298	!! ** Purpose : read domaine namelists and print the variables.
299	!!
300	!! ** input : - namrun namelist
301	!! - namdom namelist
302	!! - namnc4 namelist ! "key_netcdf4" only
303	!!----------------------------------------------------------------------
304	USE ioipsl
305	!!
306	INTEGER :: ios ! Local integer
307	!
308	NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, &
309	& nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , &
310	& nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , &
311	& nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler , &
312	& ln_cfmeta, ln_xios_read, nn_wxios
313	NAMELIST/namdom/ ln_linssh, rn_rdt, rn_atfp, ln_crs, ln_meshmask
314	#if defined key_netcdf4
315	NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
316	#endif
317	!!----------------------------------------------------------------------
318	!
319	IF(lwp) THEN
320	WRITE(numout,*)
321	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
322	WRITE(numout,*) '~~~~~~~ '
323	ENDIF
324	!
325	!
326	READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
327	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist' )
328	READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
329	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist' )
330	IF(lwm) WRITE ( numond, namrun )
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 nn_euler = ', nn_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	neuler = nn_euler
378	IF( neuler == 1 .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 : nn_euler is forced to 0 '
382	neuler = 0
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 defined key_agrif
403	IF( Agrif_Root() ) THEN
404	#endif
405	IF(lwp) WRITE(numout,*)
406	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
407	CASE ( 1 )
408	CALL ioconf_calendar('gregorian')
409	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year'
410	CASE ( 0 )
411	CALL ioconf_calendar('noleap')
412	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year'
413	CASE ( 30 )
414	CALL ioconf_calendar('360d')
415	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year'
416	END SELECT
417	#if defined key_agrif
418	ENDIF
419	#endif
420
421	READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
422	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' )
423	READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
424	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' )
425	IF(lwm) WRITE( numond, namdom )
426	!
427	IF(lwp) THEN
428	WRITE(numout,*)
429	WRITE(numout,*) ' Namelist : namdom --- space & time domain'
430	WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh
431	WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask
432	WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
433	WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
434	WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs
435	ENDIF
436	!
437	! ! conversion DOCTOR names into model names (this should disappear soon)
438	atfp = rn_atfp
439	rdt = rn_rdt
440
441	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
442	lrxios = ln_xios_read.AND.ln_rstart
443	!set output file type for XIOS based on NEMO namelist
444	IF (nn_wxios > 0) lwxios = .TRUE.
445	nxioso = nn_wxios
446	ENDIF
447
448	#if defined key_netcdf4
449	! ! NetCDF 4 case ("key_netcdf4" defined)
450	READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
451	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
452	READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
453	908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
454	IF(lwm) WRITE( numond, namnc4 )
455
456	IF(lwp) THEN ! control print
457	WRITE(numout,*)
458	WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
459	WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
460	WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
461	WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
462	WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
463	ENDIF
464
465	! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
466	! Note the chunk size in the unlimited (time) dimension will be fixed at 1
467	snc4set%ni = nn_nchunks_i
468	snc4set%nj = nn_nchunks_j
469	snc4set%nk = nn_nchunks_k
470	snc4set%luse = ln_nc4zip
471	#else
472	snc4set%luse = .FALSE. ! No NetCDF 4 case
473	#endif
474	!
475	END SUBROUTINE dom_nam
476
477
478	SUBROUTINE dom_ctl
479	!!----------------------------------------------------------------------
480	!! * ROUTINE dom_ctl *
481	!!
482	!! ** Purpose : Domain control.
483	!!
484	!! ** Method : compute and print extrema of masked scale factors
485	!!----------------------------------------------------------------------
486	INTEGER, DIMENSION(2) :: imi1, imi2, ima1, ima2
487	INTEGER, DIMENSION(2) :: iloc !
488	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
489	!!----------------------------------------------------------------------
490	!
491	IF(lk_mpp) THEN
492	CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 )
493	CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 )
494	CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 )
495	CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 )
496	ELSE
497	ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
498	ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
499	ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
500	ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
501	!
502	iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
503	imi1(1) = iloc(1) + nimpp - 1
504	imi1(2) = iloc(2) + njmpp - 1
505	iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
506	imi2(1) = iloc(1) + nimpp - 1
507	imi2(2) = iloc(2) + njmpp - 1
508	iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
509	ima1(1) = iloc(1) + nimpp - 1
510	ima1(2) = iloc(2) + njmpp - 1
511	iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
512	ima2(1) = iloc(1) + nimpp - 1
513	ima2(2) = iloc(2) + njmpp - 1
514	ENDIF
515	IF(lwp) THEN
516	WRITE(numout,*)
517	WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
518	WRITE(numout,*) '~~~~~~~'
519	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
520	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
521	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
522	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
523	ENDIF
524	!
525	END SUBROUTINE dom_ctl
526
527
528	SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
529	!!----------------------------------------------------------------------
530	!! * ROUTINE dom_nam *
531	!!
532	!! ** Purpose : read the domain size in domain configuration file
533	!!
534	!! ** Method : read the cn_domcfg NetCDF file
535	!!----------------------------------------------------------------------
536	CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name
537	INTEGER , INTENT(out) :: kk_cfg ! configuration resolution
538	INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes
539	INTEGER , INTENT(out) :: kperio ! lateral global domain b.c.
540	!
541	INTEGER :: inum ! local integer
542	REAL(wp) :: zorca_res ! local scalars
543	REAL(wp) :: zperio ! - -
544	INTEGER, DIMENSION(4) :: idvar, idimsz ! size of dimensions
545	!!----------------------------------------------------------------------
546	!
547	IF(lwp) THEN
548	WRITE(numout,*) ' '
549	WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
550	WRITE(numout,*) '~~~~~~~~~~ '
551	ENDIF
552	!
553	CALL iom_open( cn_domcfg, inum )
554	!
555	! !- ORCA family specificity
556	IF( iom_varid( inum, 'ORCA' , ldstop = .FALSE. ) > 0 .AND. &
557	& iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0 ) THEN
558	!
559	cd_cfg = 'ORCA'
560	CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res )
561	!
562	IF(lwp) THEN
563	WRITE(numout,*) ' .'
564	WRITE(numout,*) ' ==>>> ORCA configuration '
565	WRITE(numout,*) ' .'
566	ENDIF
567	!
568	ELSE !- cd_cfg & k_cfg are not used
569	cd_cfg = 'UNKNOWN'
570	kk_cfg = -9999999
571	!- or they may be present as global attributes
572	!- (netcdf only)
573	CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found
574	CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found
575	IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
576	IF( kk_cfg == -999 ) kk_cfg = -9999999
577	!
578	ENDIF
579	!
580	idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz ) ! use e3t_0, that must exist, to get jp(ijk)glo
581	kpi = idimsz(1)
582	kpj = idimsz(2)
583	kpk = idimsz(3)
584	CALL iom_get( inum, 'jperio', zperio ) ; kperio = NINT( zperio )
585	CALL iom_close( inum )
586	!
587	IF(lwp) THEN
588	WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg
589	WRITE(numout,*) ' jpiglo = ', kpi
590	WRITE(numout,*) ' jpjglo = ', kpj
591	WRITE(numout,*) ' jpkglo = ', kpk
592	WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio
593	ENDIF
594	!
595	END SUBROUTINE domain_cfg
596
597
598	SUBROUTINE cfg_write
599	!!----------------------------------------------------------------------
600	!! * ROUTINE cfg_write *
601	!!
602	!! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which
603	!! contains all the ocean domain informations required to
604	!! define an ocean configuration.
605	!!
606	!! ** Method : Write in a file all the arrays required to set up an
607	!! ocean configuration.
608	!!
609	!! ** output file : domcfg_out.nc : domain size, characteristics, horizontal
610	!! mesh, Coriolis parameter, and vertical scale factors
611	!! NB: also contain ORCA family information
612	!!----------------------------------------------------------------------
613	INTEGER :: ji, jj, jk ! dummy loop indices
614	INTEGER :: izco, izps, isco, icav
615	INTEGER :: inum ! local units
616	CHARACTER(len=21) :: clnam ! filename (mesh and mask informations)
617	REAL(wp), DIMENSION(jpi,jpj) :: z2d ! workspace
618	!!----------------------------------------------------------------------
619	!
620	IF(lwp) WRITE(numout,*)
621	IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
622	IF(lwp) WRITE(numout,*) '~~~~~~~~~'
623	!
624	! ! ============================= !
625	! ! create 'domcfg_out.nc' file !
626	! ! ============================= !
627	!
628	clnam = cn_domcfg_out ! filename (configuration information)
629	CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
630
631	!
632	! !== ORCA family specificities ==!
633	IF( cn_cfg == "ORCA" ) THEN
634	CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 )
635	CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )
636	ENDIF
637	!
638	! !== global domain size ==!
639	!
640	CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
641	CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
642	CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk , wp), ktype = jp_i4 )
643	!
644	! !== domain characteristics ==!
645	!
646	! ! lateral boundary of the global domain
647	CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
648	!
649	! ! type of vertical coordinate
650	IF( ln_zco ) THEN ; izco = 1 ; ELSE ; izco = 0 ; ENDIF
651	IF( ln_zps ) THEN ; izps = 1 ; ELSE ; izps = 0 ; ENDIF
652	IF( ln_sco ) THEN ; isco = 1 ; ELSE ; isco = 0 ; ENDIF
653	CALL iom_rstput( 0, 0, inum, 'ln_zco' , REAL( izco, wp), ktype = jp_i4 )
654	CALL iom_rstput( 0, 0, inum, 'ln_zps' , REAL( izps, wp), ktype = jp_i4 )
655	CALL iom_rstput( 0, 0, inum, 'ln_sco' , REAL( isco, wp), ktype = jp_i4 )
656	!
657	! ! ocean cavities under iceshelves
658	IF( ln_isfcav ) THEN ; icav = 1 ; ELSE ; icav = 0 ; ENDIF
659	CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
660	!
661	! !== horizontal mesh !
662	!
663	CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 ) ! latitude
664	CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
665	CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
666	CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
667	!
668	CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 ) ! longitude
669	CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
670	CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
671	CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
672	!
673	CALL iom_rstput( 0, 0, inum, 'e1t' , e1t , ktype = jp_r8 ) ! i-scale factors (e1.)
674	CALL iom_rstput( 0, 0, inum, 'e1u' , e1u , ktype = jp_r8 )
675	CALL iom_rstput( 0, 0, inum, 'e1v' , e1v , ktype = jp_r8 )
676	CALL iom_rstput( 0, 0, inum, 'e1f' , e1f , ktype = jp_r8 )
677	!
678	CALL iom_rstput( 0, 0, inum, 'e2t' , e2t , ktype = jp_r8 ) ! j-scale factors (e2.)
679	CALL iom_rstput( 0, 0, inum, 'e2u' , e2u , ktype = jp_r8 )
680	CALL iom_rstput( 0, 0, inum, 'e2v' , e2v , ktype = jp_r8 )
681	CALL iom_rstput( 0, 0, inum, 'e2f' , e2f , ktype = jp_r8 )
682	!
683	CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 ) ! coriolis factor
684	CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
685	!
686	! !== vertical mesh ==!
687	!
688	CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate
689	CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 )
690	!
691	CALL iom_rstput( 0, 0, inum, 'e3t_0' , e3t_0 , ktype = jp_r8 ) ! vertical scale factors
692	CALL iom_rstput( 0, 0, inum, 'e3u_0' , e3u_0 , ktype = jp_r8 )
693	CALL iom_rstput( 0, 0, inum, 'e3v_0' , e3v_0 , ktype = jp_r8 )
694	CALL iom_rstput( 0, 0, inum, 'e3f_0' , e3f_0 , ktype = jp_r8 )
695	CALL iom_rstput( 0, 0, inum, 'e3w_0' , e3w_0 , ktype = jp_r8 )
696	CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 )
697	CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 )
698	!
699	! !== wet top and bottom level ==! (caution: multiplied by ssmask)
700	!
701	CALL iom_rstput( 0, 0, inum, 'top_level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points (ISF)
702	CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points
703	!
704	IF( ln_sco ) THEN ! s-coordinate: store grid stiffness ratio (Not required anyway)
705	CALL dom_stiff( z2d )
706	CALL iom_rstput( 0, 0, inum, 'stiffness', z2d ) ! ! Max. grid stiffness ratio
707	ENDIF
708	!
709	IF( ll_wd ) THEN ! wetting and drying domain
710	CALL iom_rstput( 0, 0, inum, 'ht_0' , ht_0 , ktype = jp_r8 )
711	ENDIF
712	!
713	! Add some global attributes ( netcdf only )
714	CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
715	CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
716	!
717	! ! ============================
718	! ! close the files
719	! ! ============================
720	CALL iom_close( inum )
721	!
722	END SUBROUTINE cfg_write
723
724	!!======================================================================
725	END MODULE domain

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

Download in other formats: