New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

domain.F90 in NEMO/branches/2020/dev_r13327_KERNEL-06_2_techene_e3/src/OCE/DOM – NEMO

Context Navigation

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

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

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

Download in other formats: