Context Navigation

domain.F90 @ 10986

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

Download in other formats: