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_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM/domain.F90 @ 13334

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

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

Download in other formats: