Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

domain.F90 @ 14070

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

Download in other formats: