Context Navigation

domain.F90 @ 15574

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

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

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

Context Navigation

source: NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/DOM/domain.F90 @ 15574

Download in other formats: