Context Navigation

domain.F90 @ 8858

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

Download in other formats: