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

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

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

Download in other formats: