Context Navigation

domain.F90 @ 8403

Last change on this file since 8403 was 8403, checked in by deazer, 7 years ago

Add in ROMS WAD option ln_rwd+changes for implicit Bed Friction for ln_wd option
Note no ramp placed on ROMS bed friction yet
CS15mini case added as a Test CASE
at this revision AMM15 with Pure sigma coords barotorpic runs for 4 days without failure
in with ROMS option with 20cm min deoth and 50 vertical levels
Both run for CS15mini
In real domains nothing done on reference level yet so real domains
must have not negative depth points yet.
But a basic test has been done in WAD channel test cases (WAD7)

No changes in Main line source yet. See the MY_SRC sub dir of CS15 and TEST_CASES/WAD
for actual code changes.

File size: 36.3 KB

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

Download in other formats: