Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

domain.F90 @ 12477

Last change on this file since 12477 was 12477, checked in by jcastill, 4 years ago
Changes as in the original branch, plus changes for bgc restart (in branch AMM15_v3_6_STABLE_package_collate)
File size: 36.8 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
295	NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask
296	#if defined key_netcdf4
297	NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
298	#endif
299	!!----------------------------------------------------------------------
300	!
301	IF(lwp) THEN
302	WRITE(numout,*)
303	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
304	WRITE(numout,*) '~~~~~~~ '
305	ENDIF
306	!
307	!
308	REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run
309	READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
310	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist' )
311	REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run
312	READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
313	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist' )
314	IF(lwm) WRITE ( numond, namrun )
315	!
316	IF(lwp) THEN ! control print
317	WRITE(numout,*) ' Namelist : namrun --- run parameters'
318	WRITE(numout,*) ' Assimilation cycle nn_no = ', nn_no
319	WRITE(numout,*) ' experiment name for output cn_exp = ', TRIM( cn_exp )
320	WRITE(numout,*) ' file prefix restart input cn_ocerst_in = ', TRIM( cn_ocerst_in )
321	WRITE(numout,*) ' restart input directory cn_ocerst_indir = ', TRIM( cn_ocerst_indir )
322	WRITE(numout,*) ' file prefix restart output cn_ocerst_out = ', TRIM( cn_ocerst_out )
323	WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
324	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
325	WRITE(numout,*) ' use date in restart name ln_rstdate = ', ln_rstdate
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,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta
344	WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
345	WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
346	WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl
347	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
348	WRITE(numout,*) ' READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
349	WRITE(numout,*) ' Write restart using XIOS nn_wxios = ', nn_wxios
350	ELSE
351	WRITE(numout,*) " AGRIF: nn_wxios will be ingored. See setting for parent"
352	WRITE(numout,*) " AGRIF: ln_xios_read will be ingored. See setting for parent"
353	ENDIF
354	ENDIF
355
356	cexper = cn_exp ! conversion DOCTOR names into model names (this should disappear soon)
357	nrstdt = nn_rstctl
358	nit000 = nn_it000
359	nitend = nn_itend
360	ndate0 = nn_date0
361	nleapy = nn_leapy
362	ninist = nn_istate
363	neuler = nn_euler
364	IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN
365	IF(lwp) WRITE(numout,*)
366	IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)'
367	IF(lwp) WRITE(numout,*)' an Euler initial time step is used : nn_euler is forced to 0 '
368	neuler = 0
369	ENDIF
370	! ! control of output frequency
371	IF( .NOT. ln_rst_list ) THEN ! we use nn_stock
372	IF( nn_stock == -1 ) CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' )
373	IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN
374	WRITE(ctmp1,*) 'nn_stock = ', nn_stock, ' it is forced to ', nitend
375	CALL ctl_warn( ctmp1 )
376	nn_stock = nitend
377	ENDIF
378	ENDIF
379	#if ! defined key_iomput
380	IF( nn_write == -1 ) CALL ctl_warn( 'nn_write = -1 --> no output files will be done' )
381	IF ( nn_write == 0 ) THEN
382	WRITE(ctmp1,*) 'nn_write = ', nn_write, ' it is forced to ', nitend
383	CALL ctl_warn( ctmp1 )
384	nn_write = nitend
385	ENDIF
386	#endif
387
388	#if defined key_agrif
389	IF( Agrif_Root() ) THEN
390	#endif
391	IF(lwp) WRITE(numout,*)
392	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
393	CASE ( 1 )
394	CALL ioconf_calendar('gregorian')
395	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year'
396	CASE ( 0 )
397	CALL ioconf_calendar('noleap')
398	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year'
399	CASE ( 30 )
400	CALL ioconf_calendar('360d')
401	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year'
402	END SELECT
403	#if defined key_agrif
404	ENDIF
405	#endif
406
407	REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
408	READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
409	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' )
410	REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
411	READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
412	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' )
413	IF(lwm) WRITE( numond, namdom )
414	!
415	IF(lwp) THEN
416	WRITE(numout,*)
417	WRITE(numout,*) ' Namelist : namdom --- space & time domain'
418	WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh
419	WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask
420	WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' [m]'
421	WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
422	WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
423	WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs
424	ENDIF
425	!
426	! ! conversion DOCTOR names into model names (this should disappear soon)
427	atfp = rn_atfp
428	rdt = rn_rdt
429
430	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
431	lrxios = ln_xios_read.AND.ln_rstart
432	!set output file type for XIOS based on NEMO namelist
433	IF (nn_wxios > 0) lwxios = .TRUE.
434	nxioso = nn_wxios
435	ENDIF
436
437	#if defined key_netcdf4
438	! ! NetCDF 4 case ("key_netcdf4" defined)
439	REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF
440	READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
441	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
442	REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF
443	READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
444	908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
445	IF(lwm) WRITE( numond, namnc4 )
446
447	IF(lwp) THEN ! control print
448	WRITE(numout,*)
449	WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
450	WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
451	WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
452	WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
453	WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
454	ENDIF
455
456	! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
457	! Note the chunk size in the unlimited (time) dimension will be fixed at 1
458	snc4set%ni = nn_nchunks_i
459	snc4set%nj = nn_nchunks_j
460	snc4set%nk = nn_nchunks_k
461	snc4set%luse = ln_nc4zip
462	#else
463	snc4set%luse = .FALSE. ! No NetCDF 4 case
464	#endif
465	!
466	END SUBROUTINE dom_nam
467
468
469	SUBROUTINE dom_ctl
470	!!----------------------------------------------------------------------
471	!! * ROUTINE dom_ctl *
472	!!
473	!! ** Purpose : Domain control.
474	!!
475	!! ** Method : compute and print extrema of masked scale factors
476	!!----------------------------------------------------------------------
477	INTEGER, DIMENSION(2) :: imi1, imi2, ima1, ima2
478	INTEGER, DIMENSION(2) :: iloc !
479	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
480	!!----------------------------------------------------------------------
481	!
482	IF(lk_mpp) THEN
483	CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 )
484	CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 )
485	CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 )
486	CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 )
487	ELSE
488	ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
489	ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
490	ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
491	ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
492	!
493	iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
494	imi1(1) = iloc(1) + nimpp - 1
495	imi1(2) = iloc(2) + njmpp - 1
496	iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
497	imi2(1) = iloc(1) + nimpp - 1
498	imi2(2) = iloc(2) + njmpp - 1
499	iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
500	ima1(1) = iloc(1) + nimpp - 1
501	ima1(2) = iloc(2) + njmpp - 1
502	iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
503	ima2(1) = iloc(1) + nimpp - 1
504	ima2(2) = iloc(2) + njmpp - 1
505	ENDIF
506	IF(lwp) THEN
507	WRITE(numout,*)
508	WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
509	WRITE(numout,*) '~~~~~~~'
510	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
511	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
512	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
513	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
514	ENDIF
515	!
516	END SUBROUTINE dom_ctl
517
518
519	SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
520	!!----------------------------------------------------------------------
521	!! * ROUTINE dom_nam *
522	!!
523	!! ** Purpose : read the domain size in domain configuration file
524	!!
525	!! ** Method : read the cn_domcfg NetCDF file
526	!!----------------------------------------------------------------------
527	CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name
528	INTEGER , INTENT(out) :: kk_cfg ! configuration resolution
529	INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes
530	INTEGER , INTENT(out) :: kperio ! lateral global domain b.c.
531	!
532	INTEGER :: inum ! local integer
533	REAL(wp) :: zorca_res ! local scalars
534	REAL(wp) :: zperio ! - -
535	INTEGER, DIMENSION(4) :: idvar, idimsz ! size of dimensions
536	!!----------------------------------------------------------------------
537	!
538	IF(lwp) THEN
539	WRITE(numout,*) ' '
540	WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
541	WRITE(numout,*) '~~~~~~~~~~ '
542	ENDIF
543	!
544	CALL iom_open( cn_domcfg, inum )
545	!
546	! !- ORCA family specificity
547	IF( iom_varid( inum, 'ORCA' , ldstop = .FALSE. ) > 0 .AND. &
548	& iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0 ) THEN
549	!
550	cd_cfg = 'ORCA'
551	CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res )
552	!
553	IF(lwp) THEN
554	WRITE(numout,*) ' .'
555	WRITE(numout,*) ' ==>>> ORCA configuration '
556	WRITE(numout,*) ' .'
557	ENDIF
558	!
559	ELSE !- cd_cfg & k_cfg are not used
560	cd_cfg = 'UNKNOWN'
561	kk_cfg = -9999999
562	!- or they may be present as global attributes
563	!- (netcdf only)
564	CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found
565	CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found
566	IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
567	IF( kk_cfg == -999 ) kk_cfg = -9999999
568	!
569	ENDIF
570	!
571	idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz ) ! use e3t_0, that must exist, to get jp(ijk)glo
572	kpi = idimsz(1)
573	kpj = idimsz(2)
574	kpk = idimsz(3)
575	CALL iom_get( inum, 'jperio', zperio ) ; kperio = NINT( zperio )
576	CALL iom_close( inum )
577	!
578	IF(lwp) THEN
579	WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg
580	WRITE(numout,*) ' jpiglo = ', kpi
581	WRITE(numout,*) ' jpjglo = ', kpj
582	WRITE(numout,*) ' jpkglo = ', kpk
583	WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio
584	ENDIF
585	!
586	END SUBROUTINE domain_cfg
587
588
589	SUBROUTINE cfg_write
590	!!----------------------------------------------------------------------
591	!! * ROUTINE cfg_write *
592	!!
593	!! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which
594	!! contains all the ocean domain informations required to
595	!! define an ocean configuration.
596	!!
597	!! ** Method : Write in a file all the arrays required to set up an
598	!! ocean configuration.
599	!!
600	!! ** output file : domcfg_out.nc : domain size, characteristics, horizontal
601	!! mesh, Coriolis parameter, and vertical scale factors
602	!! NB: also contain ORCA family information
603	!!----------------------------------------------------------------------
604	INTEGER :: ji, jj, jk ! dummy loop indices
605	INTEGER :: izco, izps, isco, icav
606	INTEGER :: inum ! local units
607	CHARACTER(len=21) :: clnam ! filename (mesh and mask informations)
608	REAL(wp), DIMENSION(jpi,jpj) :: z2d ! workspace
609	!!----------------------------------------------------------------------
610	!
611	IF(lwp) WRITE(numout,*)
612	IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
613	IF(lwp) WRITE(numout,*) '~~~~~~~~~'
614	!
615	! ! ============================= !
616	! ! create 'domcfg_out.nc' file !
617	! ! ============================= !
618	!
619	clnam = cn_domcfg_out ! filename (configuration information)
620	CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
621
622	!
623	! !== ORCA family specificities ==!
624	IF( cn_cfg == "ORCA" ) THEN
625	CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 )
626	CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )
627	ENDIF
628	!
629	! !== global domain size ==!
630	!
631	CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
632	CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
633	CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk , wp), ktype = jp_i4 )
634	!
635	! !== domain characteristics ==!
636	!
637	! ! lateral boundary of the global domain
638	CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
639	!
640	! ! type of vertical coordinate
641	IF( ln_zco ) THEN ; izco = 1 ; ELSE ; izco = 0 ; ENDIF
642	IF( ln_zps ) THEN ; izps = 1 ; ELSE ; izps = 0 ; ENDIF
643	IF( ln_sco ) THEN ; isco = 1 ; ELSE ; isco = 0 ; ENDIF
644	CALL iom_rstput( 0, 0, inum, 'ln_zco' , REAL( izco, wp), ktype = jp_i4 )
645	CALL iom_rstput( 0, 0, inum, 'ln_zps' , REAL( izps, wp), ktype = jp_i4 )
646	CALL iom_rstput( 0, 0, inum, 'ln_sco' , REAL( isco, wp), ktype = jp_i4 )
647	!
648	! ! ocean cavities under iceshelves
649	IF( ln_isfcav ) THEN ; icav = 1 ; ELSE ; icav = 0 ; ENDIF
650	CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
651	!
652	! !== horizontal mesh !
653	!
654	CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 ) ! latitude
655	CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
656	CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
657	CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
658	!
659	CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 ) ! longitude
660	CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
661	CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
662	CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
663	!
664	CALL iom_rstput( 0, 0, inum, 'e1t' , e1t , ktype = jp_r8 ) ! i-scale factors (e1.)
665	CALL iom_rstput( 0, 0, inum, 'e1u' , e1u , ktype = jp_r8 )
666	CALL iom_rstput( 0, 0, inum, 'e1v' , e1v , ktype = jp_r8 )
667	CALL iom_rstput( 0, 0, inum, 'e1f' , e1f , ktype = jp_r8 )
668	!
669	CALL iom_rstput( 0, 0, inum, 'e2t' , e2t , ktype = jp_r8 ) ! j-scale factors (e2.)
670	CALL iom_rstput( 0, 0, inum, 'e2u' , e2u , ktype = jp_r8 )
671	CALL iom_rstput( 0, 0, inum, 'e2v' , e2v , ktype = jp_r8 )
672	CALL iom_rstput( 0, 0, inum, 'e2f' , e2f , ktype = jp_r8 )
673	!
674	CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 ) ! coriolis factor
675	CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
676	!
677	! !== vertical mesh ==!
678	!
679	CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate
680	CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 )
681	!
682	CALL iom_rstput( 0, 0, inum, 'e3t_0' , e3t_0 , ktype = jp_r8 ) ! vertical scale factors
683	CALL iom_rstput( 0, 0, inum, 'e3u_0' , e3u_0 , ktype = jp_r8 )
684	CALL iom_rstput( 0, 0, inum, 'e3v_0' , e3v_0 , ktype = jp_r8 )
685	CALL iom_rstput( 0, 0, inum, 'e3f_0' , e3f_0 , ktype = jp_r8 )
686	CALL iom_rstput( 0, 0, inum, 'e3w_0' , e3w_0 , ktype = jp_r8 )
687	CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 )
688	CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 )
689	!
690	! !== wet top and bottom level ==! (caution: multiplied by ssmask)
691	!
692	CALL iom_rstput( 0, 0, inum, 'top_level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points (ISF)
693	CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points
694	!
695	IF( ln_sco ) THEN ! s-coordinate: store grid stiffness ratio (Not required anyway)
696	CALL dom_stiff( z2d )
697	CALL iom_rstput( 0, 0, inum, 'stiffness', z2d ) ! ! Max. grid stiffness ratio
698	ENDIF
699	!
700	IF( ll_wd ) THEN ! wetting and drying domain
701	CALL iom_rstput( 0, 0, inum, 'ht_0' , ht_0 , ktype = jp_r8 )
702	ENDIF
703	!
704	! Add some global attributes ( netcdf only )
705	CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
706	CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
707	!
708	! ! ============================
709	! ! close the files
710	! ! ============================
711	CALL iom_close( inum )
712	!
713	END SUBROUTINE cfg_write
714
715	!!======================================================================
716	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/r12083_restart_datestamp/src/OCE/DOM/domain.F90 @ 12477

Download in other formats: