Context Navigation

domain.F90 @ 12747

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

Download in other formats: