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

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

domain.F90 in NEMO/trunk/src/SWE – NEMO

Context Navigation

source: NEMO/trunk/src/SWE/domain.F90 @ 13970

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

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

Download in other formats: