Context Navigation

domain.F90 @ 9596

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

Download in other formats: