New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

create_meshmask.f90 in branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src – NEMO

Context Navigation

source: branches/2016/dev_r6999_CONFIGMAN_1/NEMOGCM/TOOLS/SIREN/src/create_meshmask.f90 @ 7153

Last change on this file since 7153 was 7153, checked in by jpaul, 8 years ago
see ticket #1781
File size: 63.3 KB

Line
1	!----------------------------------------------------------------------
2	! NEMO system team, System and Interface for oceanic RElocable Nesting
3	!----------------------------------------------------------------------
4	!
5	! PROGRAM: create_meshmask
6	!
7	! DESCRIPTION:
8	!> @file
9	!> @brief
10	!> This program creates the NetCDF file(s) which contain(s) all the
11	!> ocean domain informations.
12	!> It allows to create the domain_cfg.nc file needed to run NEMO, or
13	!> the mesh_mask file(s).
14	!>
15	!> @details
16	!> @section sec1 method
17	!> Bathymetry (and optionally ice shelf draft) is read on input file.<br/>
18	!> Horizontal grid-point position and scale factors, and the coriolis factor
19	!> are read in coordinates file or computed.<br/>
20	!> Vertical coordinate is defined, and the bathymetry recomputed to fit the
21	!> vertical grid.<br/>
22	!> Finally the masks from the bathymetry are computed.
23	!>
24	!> All the arrays generated, are writen in one to three file(s) depending on
25	!> output option.
26	!> @note the file contain depends on
27	!> the vertical coordinate used (z-coord, partial steps, s-coord)
28	!>
29	!> @section sec2 how to
30	!> to create domain_cfg or meshmask file:<br/>
31	!> @code{.sh}
32	!> ./SIREN/bin/create_meshmask create_meshmask.nam
33	!> @endcode
34	!>
35	!> @note
36	!> you could find a template of the namelist in templates directory.
37	!>
38	!> create_meshmask.nam contains 13 namelists:<br/>
39	!> - logger namelist (namlog)
40	!> - config namelist (namcfg)
41	!> - input files namelist (namin)
42	!> - horizontal grid namelist (namhgr)
43	!> - vertical grid namelist (namzgr)
44	!> - minimum depth namelist (namdmin)
45	!> - vertical coordinate namelist (namzco)
46	!> - partial step namelist (namzps)
47	!> - sigma or hybrid namelist (namsco)
48	! - cross land advection namelist (namcla)
49	!> - lateral boundary condition namelist (namlbc)
50	!> - wetting and dryong namelist (namwd)
51	!> - grid namelist (namgrd)
52	! - zoom namelist (namzoom)
53	!> - output namelist (namout)
54	!>
55	!> * _logger namelist (namlog)_:<br/>
56	!> - cn_logfile : log filename
57	!> - cn_verbosity : verbosity ('trace','debug','info',
58	!> 'warning','error','fatal','none')
59	!> - in_maxerror : maximum number of error allowed
60	!>
61	!> * _config namelist (namcfg)_:<br/>
62	!> - cn_varcfg : variable configuration file
63	!> (see ./SIREN/cfg/variable.cfg)
64	!> - cn_dumcfg : useless (dummy) configuration file, for useless
65	!> dimension or variable (see ./SIREN/cfg/dummy.cfg).
66	!>
67	!> * _input files namelist (namin)_:<br/>
68	!> - cn_bathy : Bathymetry file
69	!> - cn_coord : coordinate file (in_mshhgr=0)
70	!> - cn_isfdep : Iceshelf draft (ln_isfcav=true)
71	!> - in_perio : NEMO periodicity
72	!> - ln_closea :
73	!>
74	!> * _horizontal grid namelist (namhgr)_:<br/>
75	!> - in_mshhgr : type of horizontal mesh
76	!> - 0: curvilinear coordinate on the sphere read in coordinate.nc
77	!> - 1: geographical mesh on the sphere with regular grid-spacing
78	!> - 2: f-plane with regular grid-spacing
79	!> - 3: beta-plane with regular grid-spacing
80	!> - 4: Mercator grid with T/U point at the equator
81	!> - 5: beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
82	!> - dn_ppglam0 : longitude of first raw and column T-point (in_mshhgr = 1 or 4)
83	!> - dn_ppgphi0 : latitude of first raw and column T-point (in_mshhgr = 1 or 4)
84	!> - dn_ppe1_deg : zonal grid-spacing (degrees) (in_mshhgr = 1,2,3 or 4)
85	!> - dn_ppe2_deg : meridional grid-spacing (degrees) (in_mshhgr = 1,2,3 or 4)
86	!>
87	!> * _vertical grid namelist (namzgr)_:<br/>
88	!> - ln_zco : z-coordinate - full steps
89	!> - ln_zps : z-coordinate - partial steps
90	!> - ln_sco : s- or hybrid z-s-coordinate
91	!> - ln_isfcav : ice shelf cavities
92	!> - ln_iscpl : coupling with ice sheet
93	!> - ln_wd : Wetting/drying activation
94	!> - in_nlevel : number of vertical level
95	!>
96	!> * _depth namelist (namdmin)_:<br/>
97	!> - dn_hmin : minimum ocean depth (>0) or minimum number of ocean levels (<0)
98	!> - dn_isfhmin : threshold to discriminate grounded ice to floating ice
99	!>
100	!> * _vertical coordinate namelist (namzco)_:<br/>
101	!> - dn_ppsur : coefficient to compute vertical grid
102	!> - dn_ppa0 : coefficient to compute vertical grid
103	!> - dn_ppa1 : coefficient to compute vertical grid
104	!> - dn_ppkth : coefficient to compute vertical grid
105	!> - dn_ppacr : coefficient to compute vertical grid
106	!> - ln_dbletanh : use double tanh function for vertical coordinates
107	!> - dn_ppa2 : double tanh function parameter
108	!> - dn_ppkth2 : double tanh function parameter
109	!> - dn_ppacr2 : double tanh function parameter
110	!> - dn_ppdzmin : minimum vertical spacing
111	!> - dn_pphmax : maximum depth
112	!>
113	!> @note If ppa1 and ppa0 and ppsur are undefined
114	!> NEMO will compute them from ppdzmin , pphmax, ppkth, ppacr
115	!>
116	!> this namelist is also needed to define partial steps, sigma or hybrid coordinate.
117	!>
118	!> * _partial step namelist (namzps)_:<br/>
119	!> - dn_e3zps_min : minimum thickness of partial step level (meters)
120	!> - dn_e3zps_rat : minimum thickness ratio of partial step level
121	!>
122	!> * _sigma or hybrid namelist (namsco)_:<br/>
123	!> - ln_s_sh94 : use hybrid s-sig Song and Haidvogel 1994 stretching function fssig1
124	!> - ln_s_sf12 : use hybrid s-z-sig Siddorn and Furner 2012 stretching function fgamma
125	!> - dn_sbot_min : minimum depth of s-bottom surface (>0) (m)
126	!> - dn_sbot_max : maximum depth of s-bottom surface (= ocean depth) (>0) (m)
127	!> - dn_hc : Critical depth for transition from sigma to stretched coordinates
128	!> Song and Haidvogel 1994 stretching additional parameters
129	!> - dn_rmax : maximum cut-off r-value allowed (0<dn_rmax<1)
130	!> - dn_theta : surface control parameter (0<=dn_theta<=20)
131	!> - dn_thetb : bottom control parameter (0<=dn_thetb<= 1)
132	!> - dn_bb : stretching parameter ( dn_bb=0; top only, dn_bb =1; top and bottom)
133	!> Siddorn and Furner stretching additional parameters
134	!> - ln_sigcrit : switching to sigma (T) or Z (F) at H<Hc
135	!> - dn_alpha : stretchin parameter ( >1 surface; <1 bottom)
136	!> - dn_efold : e-fold length scale for transition region
137	!> - dn_zs : Surface cell depth (Zs) (m)
138	!> Bottom cell (Zb) (m) = H*rn_zb_a + rn_zb_b'
139	!> - dn_zb_a : Bathymetry multiplier for Zb
140	!> - dn_zb_b : Offset for Zb
141	!>
142	! * _cross land advection namelist (namcla)_:<br/>
143	! - in_cla : =1 cross land advection for exchanges through some straits (only for ORCA2)
144	!
145	!> * _lateral boundary condition namelist (namlbc)_:<br/>
146	!> - rn_shlat : lateral boundary conditions at the coast (modify fmask)
147	!> - shlat = 0 : free slip
148	!> - 0 < shlat < 2 : partial slip
149	!> - shlat = 2 : no slip
150	!> - shlat > 2 : strong slip
151	!> for more information see Boundary Condition at the Coast
152	!> in [NEMO documentation](http://www.nemo-ocean.eu/About-NEMO/Reference-manuals))
153	!>
154	!> * _wetting and drying namelist (namwd)_:<br/>
155	!> - dn_wdmin1 : minimum water depth on dried cells
156	!> - dn_wdmin2 : tolerrance of minimum water depth on dried cells
157	!> - dn_wdld : land elevation below which wetting/drying
158	!>
159	!> * _grid namelist (namgrd)_:<br/>
160	! - cn_cfg : name of the configuration
161	!> - in_cfg : inverse resolution of the configuration (1/4° => 4)
162	!> - ln_bench : GYRE (in_mshhgr = 5 ) used as Benchmark.<br/>
163	!> => forced the resolution to be about 100 km
164	! - ln_zoom : use zoom (namzoom)
165	!> - ln_c1d : use configuration 1D
166	!
167	! * _zoom namelist (namzoom)_:<br/>
168	! - cn_cfz : name of the zoom of configuration
169	! - in_izoom : left bottom i-indices of the zoom in data domain indices
170	! - in_jzoom : left bottom j-indices of the zoom in data domain indices
171	! - ln_zoom_s : South zoom type flag
172	! - ln_zoom_e : East zoom type flag
173	! - ln_zoom_w : West zoom type flag
174	! - ln_zoom_n : North zoom type flag
175	!
176	!> * _output namelist (namout)_:<br/>
177	!> - in_msh : number of output file and contain (0-9)
178	!> - in_nproc : number of processor to be used
179	!> - in_niproc : i-direction number of processor
180	!> - in_njproc : j-direction numebr of processor
181	!>
182	!> @note
183	!> if in_msh == 0 : write '<b>domain_cfg.nc</b>' file
184	!> MOD(in_msh, 3) = 1 : '<b>mesh_mask.nc</b>' file
185	!> = 2 : '<b>mesh.nc</b>' and '<b>mask.nc</b>' files
186	!> = 0 : '<b>mesh_hgr.nc</b>', '<b>mesh_zgr.nc</b>' and '<b>mask.nc</b>' files
187	!>
188	!> For huge size domain, use option 2 or 3 depending on your vertical coordinate.
189	!>
190	!> if in_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw]
191	!> if 3 < in_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays
192	!> corresponding to the depth of the bottom t- and w-points
193	!> if 6 < in_msh <= 9: write 2D arrays corresponding to the depth and the
194	!> thickness (e3[tw]_ps) of the bottom points
195	!>
196	!> @author
197	!> J.Paul
198	! REVISION HISTORY:
199	!> @date September, 2015 - Initial Version (based on domhgr.F90, domzgr.F90, domwri.F90)
200	!> @date October, 2016
201	!> - update from trunk (revision 6961): add wetting and drying, ice sheet coupling..
202	!> @date October, 2016
203	!> - dimension to be used select from configuration file
204	!> - do not use anymore special case for ORCA grid
205	!> - allow to write domain_cfg file
206	!>
207	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
208	!----------------------------------------------------------------------
209	PROGRAM create_meshmask
210
211	USE global ! global variable
212	USE kind ! F90 kind parameter
213	USE phycst ! physical constant
214	USE logger ! log file manager
215	USE date ! date manager
216	USE fct ! basic useful function
217	USE att ! attribute manager
218	USE dim ! dimension manager
219	USE var ! variable manager
220	USE mpp ! MPP manager
221	USE iom_mpp ! I/O MPP manager
222	USE lbc ! lateral boundary conditions
223	USE grid
224	USE grid_hgr
225	USE grid_zgr
226
227	IMPLICIT NONE
228
229	! local variable
230	CHARACTER(LEN=lc) :: cl_namelist
231	CHARACTER(LEN=lc) :: cl_date
232
233	INTEGER(i1), DIMENSION(:) , ALLOCATABLE :: bl_tmp
234
235	INTEGER(i4) :: il_narg
236	INTEGER(i4) :: il_status
237	INTEGER(i4) :: il_fileid
238	INTEGER(i4) :: il_attid
239	INTEGER(i4) :: il_ew
240	INTEGER(i4) :: jpi
241	INTEGER(i4) :: jpj
242	INTEGER(i4) :: jpk
243	INTEGER(i4), DIMENSION(:) , ALLOCATABLE :: il_tmp
244	INTEGER(i4), DIMENSION(:,:) , ALLOCATABLE :: il_mask
245
246	LOGICAL :: ll_exist
247	LOGICAL :: ll_domcfg
248
249	REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_tmp2D
250	REAL(dp) , DIMENSION(:,:,:) , ALLOCATABLE :: dl_tmp3D
251
252	TYPE(TATT) :: tl_att
253	TYPE(TATT) , DIMENSION(:) , ALLOCATABLE :: tl_gatt
254
255	TYPE(TDIM) :: tl_dim
256
257	TYPE(TVAR) :: tl_bathy
258	TYPE(TVAR) :: tl_risfdep
259	TYPE(TVAR) :: tl_misf
260	TYPE(TVAR) :: tl_gdepu
261	TYPE(TVAR) :: tl_gdepv
262	TYPE(TVAR) :: tl_hdept
263	TYPE(TVAR) :: tl_hdepw
264	TYPE(TVAR) :: tl_scalar
265
266	TYPE(TNAMH) :: tl_namh
267	TYPE(TNAMZ) :: tl_namz
268
269	TYPE(TMPP) :: tl_mpp
270	TYPE(TMPP) , TARGET :: tl_mppout0
271	TYPE(TMPP) , TARGET :: tl_mppout1
272	TYPE(TMPP) , TARGET :: tl_mppout2
273	TYPE(TMPP) , POINTER :: tl_mppmsk
274	TYPE(TMPP) , POINTER :: tl_mpphgr
275	TYPE(TMPP) , POINTER :: tl_mppzgr
276
277	! parameter
278	INTEGER(i4) , PARAMETER :: ip_maxatt = 40
279
280	! loop indices
281	INTEGER(i4) :: ji
282	INTEGER(i4) :: jj
283	INTEGER(i4) :: jk
284
285	INTEGER(i4) :: ik
286
287	! namelist variable
288	! namlog
289	CHARACTER(LEN=lc) :: cn_logfile = 'create_meshmask.log'
290	CHARACTER(LEN=lc) :: cn_verbosity= 'warning'
291	INTEGER(i4) :: in_maxerror = 5
292
293	! namcfg
294	CHARACTER(LEN=lc) :: cn_varcfg = './cfg/variable.cfg'
295	CHARACTER(LEN=lc) :: cn_dimcfg = './cfg/dimension.cfg'
296	CHARACTER(LEN=lc) :: cn_dumcfg = './cfg/dummy.cfg'
297
298	! namin
299	CHARACTER(LEN=lc) :: cn_bathy = ''
300	CHARACTER(LEN=lc) :: cn_coord = ''
301	CHARACTER(LEN=lc) :: cn_isfdep = ''
302	INTEGER(i4) :: in_perio = -1
303	LOGICAL :: ln_closea = .TRUE.
304
305	! namzgr
306	LOGICAL :: ln_zco = .FALSE.
307	LOGICAL :: ln_zps = .FALSE.
308	LOGICAL :: ln_sco = .FALSE.
309	LOGICAL :: ln_isfcav = .FALSE.
310	LOGICAL :: ln_iscpl = .FALSE.
311	LOGICAL :: ln_wd = .FALSE.
312	INTEGER(i4) :: in_nlevel = 75
313
314	! namlbc
315	REAL(sp) :: rn_shlat = 2.
316
317	! namout
318	INTEGER(i4) :: in_msh = 0
319	CHARACTER(LEN=lc) :: cn_type = 'cdf'
320	INTEGER(i4) :: in_nproc = 0
321	INTEGER(i4) :: in_niproc = 0
322	INTEGER(i4) :: in_njproc = 0
323	!-------------------------------------------------------------------
324	NAMELIST /namlog/ & !< logger namelist
325	& cn_logfile, & !< log file
326	& cn_verbosity, & !< log verbosity
327	& in_maxerror
328
329	NAMELIST /namcfg/ & !< configuration namelist
330	& cn_varcfg, & !< variable configuration file
331	& cn_dimcfg, & !< dimension configuration file
332	& cn_dumcfg !< dummy configuration file
333
334	NAMELIST /namin/ & !< input namelist
335	& cn_bathy, & !< Bathymetry file
336	& cn_coord, & !< Coordinate file (in_mshhgr=0)
337	& cn_isfdep, & !< Iceshelf draft (ln_isfcav=true)
338	& in_perio, & !< NEMO periodicity
339	& ln_closea
340
341	NAMELIST /namzgr/ &
342	& ln_zco, & !< z-coordinate
343	& ln_zps, & !< z-coordinate with partial steps
344	& ln_sco, & !< s-coordinate
345	& ln_isfcav, & !< presence of ISF
346	& ln_iscpl, & !< coupling with ice sheet
347	& ln_wd, & !< Wetting/drying activation
348	& in_nlevel
349
350	NAMELIST /namlbc/ &
351	& rn_shlat !< lateral momentum boundary condition
352
353	NAMELIST /namout/ & !< output namlist
354	& in_msh, & !< number of output file (1,2,3)
355	& in_nproc, & !< number of processor to be used
356	& in_niproc, & !< i-direction number of processor
357	& in_njproc !< j-direction numebr of processor
358	!-------------------------------------------------------------------
359
360	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
361	!1- namelist
362	!1-1 get namelist
363	il_narg=COMMAND_ARGUMENT_COUNT() !f03 intrinsec
364	IF( il_narg/=1 )THEN
365	PRINT *,"ERROR in create_mask: need a namelist"
366	STOP
367	ELSE
368	CALL GET_COMMAND_ARGUMENT(1,cl_namelist) !f03 intrinsec
369	ENDIF
370	!1-2 read namelist
371	INQUIRE(FILE=TRIM(cl_namelist), EXIST=ll_exist)
372	IF( ll_exist )THEN
373
374	il_fileid=fct_getunit()
375
376	OPEN( il_fileid, FILE=TRIM(cl_namelist), &
377	& FORM='FORMATTED', &
378	& ACCESS='SEQUENTIAL', &
379	& STATUS='OLD', &
380	& ACTION='READ', &
381	& IOSTAT=il_status)
382	CALL fct_err(il_status)
383	IF( il_status /= 0 )THEN
384	PRINT *,"ERROR in create_mask: error opening "//TRIM(cl_namelist)
385	STOP
386	ENDIF
387
388	READ( il_fileid, NML = namlog )
389	!1-2-1 define log file
390	CALL logger_open(TRIM(cn_logfile),TRIM(cn_verbosity),in_maxerror)
391	CALL logger_header()
392
393	READ( il_fileid, NML = namcfg )
394	!1-2-2 get variable extra information
395	CALL var_def_extra(TRIM(cn_varcfg))
396
397	! get dimension allowed
398	CALL dim_def_extra(TRIM(cn_dimcfg))
399
400	! get dummy variable
401	CALL var_get_dummy(TRIM(cn_dumcfg))
402	! get dummy dimension
403	CALL dim_get_dummy(TRIM(cn_dumcfg))
404	! get dummy attribute
405	CALL att_get_dummy(TRIM(cn_dumcfg))
406
407	READ( il_fileid, NML = namin )
408	READ( il_fileid, NML = namzgr )
409	READ( il_fileid, NML = namlbc )
410
411	READ( il_fileid, NML = namout )
412
413	CLOSE( il_fileid, IOSTAT=il_status )
414	CALL fct_err(il_status)
415	IF( il_status /= 0 )THEN
416	CALL logger_error("CREATE MASK: closing "//TRIM(cl_namelist))
417	ENDIF
418
419	ELSE
420
421	PRINT *,"ERROR in create_mask: can't find "//TRIM(cl_namelist)
422
423	ENDIF
424
425	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
426	ll_domcfg=.FALSE.
427	IF( in_msh == 0 )THEN
428	ll_domcfg=.TRUE.
429	ENDIF
430
431	! open file
432	IF( cn_bathy /= '' )THEN
433	tl_mpp=mpp_init( file_init(TRIM(cn_bathy)), id_perio=in_perio)
434	CALL grid_get_info(tl_mpp)
435	ELSE
436	CALL logger_fatal("CREATE MESH MASK: no input bathymetry file found. "//&
437	& "check namelist")
438	ENDIF
439
440	! read bathymetry
441	WRITE(,) 'FILE TO BE USED:',TRIM(cn_bathy)
442	CALL iom_mpp_open(tl_mpp)
443
444	! get dimension
445	jpi=tl_mpp%t_dim(jp_I)%i_len
446	jpj=tl_mpp%t_dim(jp_J)%i_len
447	jpk=in_nlevel
448
449	WRITE(,) 'DIMENSION TO BE USED :',jpi,jpj,jpk
450
451	IF( ln_zco ) THEN
452	WRITE(,) 'VARIABLE READ : Bathy_level'
453	tl_bathy=iom_mpp_read_var(tl_mpp, 'Bathy_level')
454	ELSEIF( ln_zps .OR. ln_sco ) THEN
455	IF ( ln_isfcav ) THEN
456	WRITE(,) 'VARIABLE READ : Bathymetry_isf'
457	tl_bathy=iom_mpp_read_var(tl_mpp, 'Bathymetry_isf' )
458	ELSE
459	WRITE(,) 'VARIABLE READ : Bathymetry'
460	tl_bathy=iom_mpp_read_var(tl_mpp, 'Bathymetry' )
461	END IF
462	ENDIF
463	CALL iom_mpp_close(tl_mpp)
464
465	WHERE( tl_bathy%d_value(:,:,1,1) == tl_bathy%d_fill .OR. &
466	& tl_bathy%d_value(:,:,1,1) < 0._dp )
467	tl_bathy%d_value(:,:,1,1) = 0._dp
468	END WHERE
469
470	IF ( ln_isfcav ) THEN
471	! open Iceshelf draft
472	IF( cn_isfdep /= '' )THEN
473	tl_mpp=mpp_init( file_init(TRIM(cn_isfdep)), id_perio=in_perio)
474	CALL grid_get_info(tl_mpp)
475	ELSE
476	CALL logger_fatal("CREATE MESH MASK: no input Iceshelf draft '//&
477	& 'file found. check namelist")
478	ENDIF
479
480	! read Iceshelf draft
481	CALL iom_mpp_open(tl_mpp)
482	IF( ln_zps .OR. ln_sco ) THEN
483	tl_risfdep=iom_mpp_read_var(tl_mpp, 'isf_draft')
484	ENDIF
485	CALL iom_mpp_close(tl_mpp)
486	ELSE
487	ALLOCATE(dl_tmp2D(jpi,jpj))
488	dl_tmp2D(:,:)=0._dp
489
490	tl_risfdep=var_init('isf_draft',dl_tmp2D(:,:), id_type=NF90_FLOAT)
491
492	DEALLOCATE(dl_tmp2D)
493	ENDIF
494
495	! fill closed sea
496	IF( ln_closea )THEN
497	WRITE(,) "CLOSED SEA"
498	ALLOCATE( il_mask(tl_bathy%t_dim(1)%i_len, &
499	& tl_bathy%t_dim(2)%i_len) )
500
501	! split domain in N sea subdomain
502	il_mask(:,:)=grid_split_domain(tl_bathy)
503
504	! fill smallest domain
505	CALL grid_fill_small_dom( tl_bathy, il_mask(:,:) )
506
507	DEALLOCATE( il_mask )
508	ENDIF
509
510	in_perio = tl_mpp%i_perio
511	il_ew = tl_mpp%i_ew
512
513	! clean
514	CALL mpp_clean(tl_mpp)
515
516	! Horizontal mesh (dom_hgr) -------------------------------------------------
517	tl_namh=grid_hgr_nam( cn_coord, in_perio, cl_namelist )
518
519	! init Horizontal grid global variable
520	CALL grid_hgr_init(jpi,jpj,jpk,ll_domcfg)
521
522	! compute horizontal mesh
523	WRITE(,) "COMPUTE HORIZONTAL MESH"
524	CALL grid_hgr_fill(tl_namh,jpi,jpj,ll_domcfg)
525
526	! Vertyical mesh (dom_zgr) -------------------------------------------------
527	tl_namz=grid_zgr_nam( cn_coord, in_perio, cl_namelist )
528
529	! init Vertical grid global variable
530	CALL grid_zgr_init(jpi,jpj,jpk,ln_sco)
531	IF( ln_zps ) CALL grid_zgr_zps_init(jpi,jpj)
532	IF( ln_sco ) CALL grid_zgr_sco_init(jpi,jpj)
533
534	! compute vertical mesh
535	WRITE(,) "COMPUTE VERTICAL MESH"
536	CALL grid_zgr_fill( tl_namz,jpi,jpj,jpk, tl_bathy, tl_risfdep )
537
538	! compute masks
539	WRITE(,) "COMPUTE MASK"
540	CALL create__mask(tl_namh,jpi,jpj,jpk,ll_domcfg)
541
542	! Maximum stiffness ratio/hydrostatic consistency
543	IF( ln_sco ) CALL grid_zgr_sco_stiff(tl_namz,jpi,jpj,jpk)
544
545	! clean
546	CALL var_clean(tl_bathy)
547
548	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
549	! create ouptut structure
550	IF( in_niproc == 0 .AND. &
551	& in_njproc == 0 .AND. &
552	& in_nproc == 0 )THEN
553	in_niproc = 1
554	in_njproc = 1
555	in_nproc = 1
556	ENDIF
557
558	WRITE(,) "WRITE FILE(S)"
559	IF( ll_domcfg )THEN
560	! ! ============================
561	! ! create 'domain_cfg.nc' file
562	! ! ============================
563	tl_mppout0=mpp_init( 'domain_cfg', tg_tmask, &
564	& in_niproc, in_njproc, in_nproc, &
565	& cd_type=cn_type )
566
567	tl_mppmsk=>tl_mppout0
568	tl_mpphgr=>tl_mppout0
569	tl_mppzgr=>tl_mppout0
570
571	ELSE
572	SELECT CASE ( MOD(in_msh, 3) )
573	! ! ============================
574	CASE ( 1 ) ! create 'mesh_mask.nc' file
575	! ! ============================
576	tl_mppout0=mpp_init( 'mesh_mask', tg_tmask, &
577	& in_niproc, in_njproc, in_nproc, &
578	& cd_type=cn_type )
579
580	tl_mppmsk=>tl_mppout0
581	tl_mpphgr=>tl_mppout0
582	tl_mppzgr=>tl_mppout0
583
584	! ! ============================
585	CASE ( 2 ) ! create 'mesh.nc' and
586	! ! 'mask.nc' files
587	! ! ============================
588	tl_mppout0=mpp_init( 'mask', tg_tmask, &
589	& in_niproc, in_njproc, in_nproc, &
590	& cd_type=cn_type )
591	tl_mppout1=mpp_init( 'mesh', tg_tmask, &
592	& in_niproc, in_njproc, in_nproc, &
593	& cd_type=cn_type )
594
595	tl_mppmsk=>tl_mppout0
596	tl_mpphgr=>tl_mppout1
597	tl_mppzgr=>tl_mppout1
598
599	! ! ============================
600	CASE ( 0 ) ! create 'mesh_hgr.nc'
601	! ! 'mesh_zgr.nc' and
602	! ! 'mask.nc' files
603	! ! ============================
604	tl_mppout0=mpp_init( 'mask', tg_tmask, &
605	& in_niproc, in_njproc, in_nproc, &
606	& cd_type=cn_type )
607	tl_mppout1=mpp_init( 'mesh_hgr', tg_tmask, &
608	& in_niproc, in_njproc, in_nproc, &
609	& cd_type=cn_type )
610	tl_mppout2=mpp_init( 'mesh_zgr', tg_tmask, &
611	& in_niproc, in_njproc, in_nproc, &
612	& cd_type=cn_type )
613	!
614
615	tl_mppmsk=>tl_mppout0
616	tl_mpphgr=>tl_mppout1
617	tl_mppzgr=>tl_mppout2
618
619	END SELECT
620	ENDIF
621
622	! add variables
623	IF( ll_domcfg )THEN
624	ALLOCATE(il_tmp(1))
625	tl_dim%l_use=.FALSE.
626
627	il_tmp(:)=jpi
628	tl_scalar=var_init('jpiglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
629	CALL mpp_add_var(tl_mppmsk, tl_scalar)
630
631	il_tmp(:)=jpj
632	tl_scalar=var_init('jpjglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
633	CALL mpp_add_var(tl_mppmsk, tl_scalar)
634
635	il_tmp(:)=jpk
636	tl_scalar=var_init('jpkglo', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
637	CALL mpp_add_var(tl_mppmsk, tl_scalar)
638
639	il_tmp(:)=tl_mppout0%i_perio
640	tl_scalar=var_init('jperio', il_tmp(:), id_type=NF90_INT, td_dim=tl_dim)
641	CALL mpp_add_var(tl_mppmsk, tl_scalar)
642
643	DEALLOCATE(il_tmp)
644	ALLOCATE(bl_tmp(1))
645
646	bl_tmp(:)=0
647	IF( ln_zco ) bl_tmp(:)=1
648	tl_scalar=var_init('ln_zco',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
649	CALL mpp_add_var(tl_mppmsk, tl_scalar)
650
651	bl_tmp(:)=0
652	IF( ln_zps ) bl_tmp(:)=1
653	tl_scalar=var_init('ln_zps',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
654	CALL mpp_add_var(tl_mppmsk, tl_scalar)
655
656	bl_tmp(:)=0
657	IF( ln_sco ) bl_tmp(:)=1
658	tl_scalar=var_init('ln_sco',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
659	CALL mpp_add_var(tl_mppmsk, tl_scalar)
660
661	bl_tmp(:)=0
662	IF( ln_isfcav ) bl_tmp(:)=1
663	tl_scalar=var_init('ln_isfcav',bl_tmp(:), id_type=NF90_BYTE, td_dim=tl_dim)
664	CALL mpp_add_var(tl_mppmsk, tl_scalar)
665
666	DEALLOCATE(bl_tmp)
667	CALL var_clean(tl_scalar)
668	ENDIF
669
670	!!! mask (msk)
671	!!!----------------------
672	IF( .NOT. ll_domcfg )THEN
673	! tmask
674	CALL mpp_add_var(tl_mppmsk, tg_tmask)
675	CALL var_clean(tg_tmask)
676	! umask
677	CALL mpp_add_var(tl_mppmsk, tg_umask)
678	CALL var_clean(tg_umask)
679	! vmask
680	CALL mpp_add_var(tl_mppmsk, tg_vmask)
681	CALL var_clean(tg_vmask)
682	! fmask
683	CALL mpp_add_var(tl_mppmsk, tg_fmask)
684	CALL var_clean(tg_fmask)
685	ENDIF
686
687	!!! horizontal mesh (hgr)
688	!!!----------------------
689
690	! latitude
691	! glamt
692	CALL mpp_add_var(tl_mpphgr, tg_glamt)
693	CALL var_clean(tg_glamt)
694	! glamu
695	CALL mpp_add_var(tl_mpphgr, tg_glamu)
696	CALL var_clean(tg_glamu)
697	! glamV
698	CALL mpp_add_var(tl_mpphgr, tg_glamv)
699	CALL var_clean(tg_glamv)
700	! glamf
701	CALL mpp_add_var(tl_mpphgr, tg_glamf)
702	CALL var_clean(tg_glamf)
703
704	! longitude
705	! gphit
706	CALL mpp_add_var(tl_mpphgr, tg_gphit)
707	CALL var_clean(tg_gphit)
708	! gphiu
709	CALL mpp_add_var(tl_mpphgr, tg_gphiu)
710	CALL var_clean(tg_gphiu)
711	! gphiv
712	CALL mpp_add_var(tl_mpphgr, tg_gphiv)
713	CALL var_clean(tg_gphiv)
714	! gphif
715	CALL mpp_add_var(tl_mpphgr, tg_gphif)
716	CALL var_clean(tg_gphif)
717
718	! e1 scale factors
719	! e1t
720	CALL mpp_add_var(tl_mpphgr, tg_e1t)
721	CALL var_clean(tg_e1t)
722	! e1u
723	CALL mpp_add_var(tl_mpphgr, tg_e1u)
724	CALL var_clean(tg_e1u)
725	! e1v
726	CALL mpp_add_var(tl_mpphgr, tg_e1v)
727	CALL var_clean(tg_e1v)
728	! e1f
729	CALL mpp_add_var(tl_mpphgr, tg_e1f)
730	CALL var_clean(tg_e1f)
731
732	! e2 scale factors
733	! e2t
734	CALL mpp_add_var(tl_mpphgr, tg_e2t)
735	CALL var_clean(tg_e2t)
736	! e2u
737	CALL mpp_add_var(tl_mpphgr, tg_e2u)
738	CALL var_clean(tg_e2u)
739	! e2v
740	CALL mpp_add_var(tl_mpphgr, tg_e2v)
741	CALL var_clean(tg_e2v)
742	! e2f
743	CALL mpp_add_var(tl_mpphgr, tg_e2f)
744	CALL var_clean(tg_e2f)
745
746	! coriolis factor
747	! ff_t
748	CALL mpp_add_var(tl_mpphgr, tg_ff_t)
749	CALL var_clean(tg_ff_t)
750	! ff_f
751	CALL mpp_add_var(tl_mpphgr, tg_ff_f)
752	CALL var_clean(tg_ff_f)
753
754	! angles
755	IF( .NOT. ll_domcfg )THEN
756	! cost
757	CALL mpp_add_var(tl_mpphgr, tg_gcost)
758	CALL var_clean(tg_gcost)
759	! cosu
760	CALL mpp_add_var(tl_mpphgr, tg_gcosu)
761	CALL var_clean(tg_gcosu)
762	! cosv
763	CALL mpp_add_var(tl_mpphgr, tg_gcosv)
764	CALL var_clean(tg_gcosv)
765	! cosf
766	CALL mpp_add_var(tl_mpphgr, tg_gcosf)
767	CALL var_clean(tg_gcosf)
768
769	! sint
770	CALL mpp_add_var(tl_mpphgr, tg_gsint)
771	CALL var_clean(tg_gsint)
772	! sinu
773	CALL mpp_add_var(tl_mpphgr, tg_gsinu)
774	CALL var_clean(tg_gsinu)
775	! sinv
776	CALL mpp_add_var(tl_mpphgr, tg_gsinv)
777	CALL var_clean(tg_gsinv)
778	! sinf
779	CALL mpp_add_var(tl_mpphgr, tg_gsinf)
780	CALL var_clean(tg_gsinf)
781	ENDIF
782
783	!!! vertical mesh (zgr)
784	!!!----------------------
785	! note that mbkt is set to 1 over land ==> use surface tmask
786	!
787	! mbathy
788	tg_mbathy%d_value(:,:,:,:) = tg_ssmask%d_value(:,:,:,:) * &
789	& tg_mbkt%d_value(:,:,:,:)
790	!
791	IF( ll_domcfg ) tg_mbathy%c_name='bottom_level'
792	CALL mpp_add_var(tl_mppzgr, tg_mbathy)
793	CALL var_clean(tg_mbathy)
794
795	! misf
796	ALLOCATE(dl_tmp2D(jpi,jpj))
797	dl_tmp2D(:,:)=dp_fill
798
799	tl_misf =var_init('misf ',dl_tmp2D(:,:), id_type=NF90_INT)
800
801	DEALLOCATE(dl_tmp2D)
802	tl_misf%d_value(:,:,1,1) = tg_ssmask%d_value(:,:,1,1) * &
803	& tg_mikt%d_value(:,:,1,1)
804	!
805	IF( ll_domcfg ) tl_misf%c_name='top_level'
806	CALL mpp_add_var(tl_mppzgr, tl_misf)
807	CALL var_clean(tl_misf)
808
809	IF( .NOT. ll_domcfg )THEN
810	! isfdraft
811	tl_risfdep%d_value(:,:,:,:) = tl_risfdep%d_value(:,:,:,:) * &
812	& tg_mikt%d_value(:,:,:,:)
813
814	CALL mpp_add_var(tl_mppzgr, tl_risfdep)
815	CALL var_clean(tl_risfdep)
816	ENDIF
817
818	IF( ln_sco ) THEN ! s-coordinate
819
820	IF( .NOT. ll_domcfg )THEN
821	! hbatt
822	CALL mpp_add_var(tl_mppzgr, tg_hbatt)
823	CALL var_clean(tg_hbatt)
824	! hbatu
825	CALL mpp_add_var(tl_mppzgr, tg_hbatu)
826	CALL var_clean(tg_hbatu)
827	! hbatv
828	CALL mpp_add_var(tl_mppzgr, tg_hbatv)
829	CALL var_clean(tg_hbatv)
830	! hbatf
831	CALL mpp_add_var(tl_mppzgr, tg_hbatf)
832	CALL var_clean(tg_hbatf)
833
834	! scaling coef.
835	IF( .NOT. (tl_namz%l_s_sh94 .OR. tl_namz%l_s_sf12) )THEN
836	! gsigt
837	CALL mpp_add_var(tl_mppzgr, tg_gsigt)
838	CALL var_clean(tg_gsigt)
839	! gsigw
840	CALL mpp_add_var(tl_mppzgr, tg_gsigw)
841	CALL var_clean(tg_gsigw)
842	! gsi3w
843	CALL mpp_add_var(tl_mppzgr, tg_gsi3w)
844	CALL var_clean(tg_gsi3w)
845	! esigt
846	CALL mpp_add_var(tl_mppzgr, tg_esigt)
847	CALL var_clean(tg_esigt)
848	! esigw
849	CALL mpp_add_var(tl_mppzgr, tg_esigw)
850	CALL var_clean(tg_esigw)
851	ENDIF
852	ENDIF
853
854	! scale factors
855	! e3t_0
856	CALL mpp_add_var(tl_mppzgr, tg_e3t_0)
857	CALL var_clean(tg_e3t_0)
858	! e3u_0
859	CALL mpp_add_var(tl_mppzgr, tg_e3u_0)
860	CALL var_clean(tg_e3u_0)
861	! e3v_0
862	CALL mpp_add_var(tl_mppzgr, tg_e3v_0)
863	CALL var_clean(tg_e3v_0)
864	! e3w_0
865	CALL mpp_add_var(tl_mppzgr, tg_e3w_0)
866	CALL var_clean(tg_e3w_0)
867
868	! Max. grid stiffness ratio
869	! rx1
870	IF( ll_domcfg ) tg_rx1%c_name='stiffness'
871	CALL mpp_add_var(tl_mppzgr, tg_rx1)
872	CALL var_clean(tg_rx1)
873
874	! stretched system
875	! gdept_1d
876	CALL mpp_add_var(tl_mppzgr, tg_gdept_1d)
877	CALL var_clean(tg_gdept_1d)
878	! gdepw_1d
879	CALL mpp_add_var(tl_mppzgr, tg_gdepw_1d)
880	CALL var_clean(tg_gdepw_1d)
881
882	! gdept_0
883	CALL mpp_add_var(tl_mppzgr, tg_gdept_0)
884	CALL var_clean(tg_gdept_0)
885	! gdepw_0
886	CALL mpp_add_var(tl_mppzgr, tg_gdepw_0)
887	CALL var_clean(tg_gdepw_0)
888
889	ENDIF
890
891	IF( ln_zps ) THEN ! z-coordinate - partial steps
892
893	IF( ll_domcfg .OR. in_msh <= 6 ) THEN ! 3D vertical scale factors
894
895	! e3t_0
896	CALL mpp_add_var(tl_mppzgr, tg_e3t_0)
897	CALL var_clean(tg_e3t_0)
898	! e3u_0
899	CALL mpp_add_var(tl_mppzgr, tg_e3u_0)
900	CALL var_clean(tg_e3u_0)
901	! e3v_0
902	CALL mpp_add_var(tl_mppzgr, tg_e3v_0)
903	CALL var_clean(tg_e3v_0)
904	! e3w_0
905	CALL mpp_add_var(tl_mppzgr, tg_e3w_0)
906	CALL var_clean(tg_e3w_0)
907
908	ELSE
909
910	DO jj = 1,jpj
911	DO ji = 1,jpi
912	ik=tg_mbkt%d_value(ji,jj,1,1)
913	tg_e3tp%d_value(ji,jj,1,1) = tg_e3t_0%d_value(ji,jj,ik,1) * &
914	& tg_ssmask%d_value(ji,jj,1,1)
915	tg_e3wp%d_value(ji,jj,1,1) = tg_e3w_0%d_value(ji,jj,ik,1) * &
916	& tg_ssmask%d_value(ji,jj,1,1)
917	END DO
918	END DO
919	! e3t_ps
920	CALL mpp_add_var(tl_mppzgr, tg_e3tp)
921	CALL var_clean(tg_e3tp)
922	! e3w_ps
923	CALL mpp_add_var(tl_mppzgr, tg_e3wp)
924	CALL var_clean(tg_e3wp)
925
926	ENDIF ! 3D vertical scale factors
927
928	IF( ll_domcfg .OR. in_msh <= 3 ) THEN ! 3D depth
929
930	! gdept_0
931	CALL mpp_add_var(tl_mppzgr, tg_gdept_0)
932
933	! gdepu, gdepv
934	IF( .NOT. ll_domcfg )THEN
935	ALLOCATE(dl_tmp3D(jpi,jpj,jpk))
936	dl_tmp3D(:,:,:)=dp_fill
937
938	tl_gdepu=var_init('gdepu',dl_tmp3D(:,:,:), id_type=NF90_FLOAT)
939	tl_gdepv=var_init('gdepv',dl_tmp3D(:,:,:), id_type=NF90_FLOAT)
940
941	DEALLOCATE(dl_tmp3D)
942	DO jk = 1,jpk
943	DO jj = 1, jpj-1
944	DO ji = 1, jpi-1 ! vector opt.
945	tl_gdepu%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji ,jj ,jk,1) , &
946	& tg_gdept_0%d_value(ji+1,jj ,jk,1) )
947
948	tl_gdepv%d_value(ji,jj,jk,1) = MIN( tg_gdept_0%d_value(ji ,jj ,jk,1) , &
949	& tg_gdept_0%d_value(ji ,jj+1,jk,1) )
950	END DO
951	END DO
952	END DO
953	CALL lbc_lnk( tl_gdepu%d_value(:,:,:,1), 'U', in_perio, 1._dp )
954	CALL lbc_lnk( tl_gdepv%d_value(:,:,:,1), 'V', in_perio, 1._dp )
955
956	! gdepu
957	CALL mpp_add_var(tl_mppzgr, tl_gdepu)
958	CALL var_clean(tl_gdepu)
959	! gdepv
960	CALL mpp_add_var(tl_mppzgr, tl_gdepv)
961	CALL var_clean(tl_gdepv)
962	ENDIF
963
964	! clean
965	CALL var_clean(tg_gdept_0)
966
967	! gdepw_0
968	CALL mpp_add_var(tl_mppzgr, tg_gdepw_0)
969	CALL var_clean(tg_gdepw_0)
970
971	ELSE ! 2D bottom depth
972	ALLOCATE(dl_tmp2D(jpi,jpj))
973	dl_tmp2D(:,:)=dp_fill
974
975	tl_hdept=var_init('hdept',dl_tmp2D(:,:), id_type=NF90_INT)
976	tl_hdepw=var_init('hdepw',dl_tmp2D(:,:), id_type=NF90_INT)
977
978	DEALLOCATE(dl_tmp2D)
979	DO jj = 1,jpj
980	DO ji = 1,jpi
981	ik=tg_mbkt%d_value(ji,jj,1,1)
982	tl_hdept%d_value(ji,jj,1,1) = tg_gdept_0%d_value(ji,jj,ik ,1) * tg_ssmask%d_value(ji,jj,1,1)
983	tl_hdepw%d_value(ji,jj,1,1) = tg_gdepw_0%d_value(ji,jj,ik+1,1) * tg_ssmask%d_value(ji,jj,1,1)
984	END DO
985	END DO
986	! hdept
987	CALL mpp_add_var(tl_mppzgr, tl_hdept)
988	CALL var_clean(tl_hdept)
989	! hdepw
990	CALL mpp_add_var(tl_mppzgr, tl_hdepw)
991	CALL var_clean(tl_hdepw)
992
993	! clean
994	CALL var_clean(tg_gdept_0)
995
996	ENDIF ! 3D depth
997
998	ENDIF
999
1000	IF( ln_zps .OR. ln_zco )THEN ! z-coordinate
1001	! depth
1002	! gdept_1d
1003	CALL mpp_add_var(tl_mppzgr, tg_gdept_1d)
1004	CALL var_clean(tg_gdept_1d)
1005	! gdepw_1d
1006	CALL mpp_add_var(tl_mppzgr, tg_gdepw_1d)
1007	CALL var_clean(tg_gdepw_1d)
1008	! scale factors
1009	! e3t_1d
1010	CALL mpp_add_var(tl_mppzgr, tg_e3t_1d)
1011	CALL var_clean(tg_e3t_1d)
1012	! e3w_1d
1013	CALL mpp_add_var(tl_mppzgr, tg_e3w_1d)
1014	CALL var_clean(tg_e3w_1d)
1015	ENDIF
1016
1017	! define global attributes
1018	ALLOCATE(tl_gatt(ip_maxatt))
1019
1020	tl_gatt(:) = create__gloatt(cn_bathy,cn_coord,cn_isfdep,tl_namh,tl_namz)
1021
1022
1023	SELECT CASE ( MOD(in_msh, 3) )
1024	CASE ( 1 )
1025	! add some attribute
1026	tl_att=att_init("Created_by","SIREN create_meshmask")
1027	CALL mpp_add_att(tl_mppmsk, tl_att)
1028
1029	cl_date=date_print(date_now())
1030	tl_att=att_init("Creation_date",TRIM(cl_date))
1031	CALL mpp_add_att(tl_mppmsk, tl_att)
1032
1033	! add attribute periodicity
1034	il_attid=0
1035	IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
1036	il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'periodicity')
1037	ENDIF
1038	IF( in_perio >= 0 .AND. il_attid == 0 )THEN
1039	tl_att=att_init('periodicity',in_perio)
1040	CALL mpp_add_att(tl_mppmsk,tl_att)
1041	ENDIF
1042
1043	il_attid=0
1044	IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
1045	il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'ew_overlap')
1046	ENDIF
1047	IF( il_ew >= 0 .AND. il_attid == 0 )THEN
1048	tl_att=att_init('ew_overlap',il_ew)
1049	CALL mpp_add_att(tl_mppmsk,tl_att)
1050	ENDIF
1051
1052	ji=1
1053	DO WHILE( tl_gatt(ji)%c_name /= '' )
1054	CALL mpp_add_att(tl_mppmsk,tl_gatt(ji))
1055	ji=ji+1
1056	ENDDO
1057	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1058	! create file
1059	CALL iom_mpp_create(tl_mppmsk)
1060
1061	! write file
1062	CALL iom_mpp_write_file(tl_mppmsk)
1063	! close file
1064	CALL iom_mpp_close(tl_mppmsk)
1065
1066	! clean
1067	CALL mpp_clean(tl_mppmsk)
1068
1069	CASE ( 2 )
1070	! add some attribute
1071	tl_att=att_init("Created_by","SIREN create_meshmask")
1072	CALL mpp_add_att(tl_mppmsk, tl_att)
1073	CALL mpp_add_att(tl_mpphgr, tl_att)
1074
1075	cl_date=date_print(date_now())
1076	tl_att=att_init("Creation_date",TRIM(cl_date))
1077	CALL mpp_add_att(tl_mppmsk, tl_att)
1078	CALL mpp_add_att(tl_mpphgr, tl_att)
1079
1080	! add attribute periodicity
1081	il_attid=0
1082	IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
1083	il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'periodicity')
1084	ENDIF
1085	IF( in_perio >= 0 .AND. il_attid == 0 )THEN
1086	tl_att=att_init('periodicity',in_perio)
1087	CALL mpp_add_att(tl_mppmsk,tl_att)
1088	CALL mpp_add_att(tl_mpphgr,tl_att)
1089	ENDIF
1090
1091	il_attid=0
1092	IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
1093	il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'ew_overlap')
1094	ENDIF
1095	IF( il_ew >= 0 .AND. il_attid == 0 )THEN
1096	tl_att=att_init('ew_overlap',il_ew)
1097	CALL mpp_add_att(tl_mppmsk,tl_att)
1098	CALL mpp_add_att(tl_mpphgr,tl_att)
1099	ENDIF
1100
1101	ji=1
1102	DO WHILE( tl_gatt(ji)%c_name /= '' )
1103	CALL mpp_add_att(tl_mppmsk,tl_gatt(ji))
1104	CALL mpp_add_att(tl_mpphgr,tl_gatt(ji))
1105	ji=ji+1
1106	ENDDO
1107
1108	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1109	! create mask file
1110	!-----------------
1111	CALL iom_mpp_create(tl_mppmsk)
1112
1113	! write file
1114	CALL iom_mpp_write_file(tl_mppmsk)
1115	! close file
1116	CALL iom_mpp_close(tl_mppmsk)
1117
1118	! clean
1119	CALL mpp_clean(tl_mppmsk)
1120
1121	! create mesh file
1122	!-----------------
1123	CALL iom_mpp_create(tl_mpphgr)
1124
1125	! write file
1126	CALL iom_mpp_write_file(tl_mpphgr)
1127	! close file
1128	CALL iom_mpp_close(tl_mpphgr)
1129
1130	! clean
1131	CALL mpp_clean(tl_mpphgr)
1132
1133	CASE(0)
1134	! add some attribute
1135	tl_att=att_init("Created_by","SIREN create_meshmask")
1136	CALL mpp_add_att(tl_mppmsk, tl_att)
1137	CALL mpp_add_att(tl_mpphgr, tl_att)
1138	CALL mpp_add_att(tl_mppzgr, tl_att)
1139
1140	cl_date=date_print(date_now())
1141	tl_att=att_init("Creation_date",TRIM(cl_date))
1142	CALL mpp_add_att(tl_mppmsk, tl_att)
1143	CALL mpp_add_att(tl_mpphgr, tl_att)
1144	CALL mpp_add_att(tl_mppzgr, tl_att)
1145
1146	! add attribute periodicity
1147	il_attid=0
1148	IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
1149	il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'periodicity')
1150	ENDIF
1151	IF( in_perio >= 0 .AND. il_attid == 0 )THEN
1152	tl_att=att_init('periodicity',in_perio)
1153	CALL mpp_add_att(tl_mppmsk,tl_att)
1154	CALL mpp_add_att(tl_mpphgr,tl_att)
1155	CALL mpp_add_att(tl_mppzgr,tl_att)
1156	ENDIF
1157
1158	il_attid=0
1159	IF( ASSOCIATED(tl_mppmsk%t_proc(1)%t_att) )THEN
1160	il_attid=att_get_id(tl_mppmsk%t_proc(1)%t_att(:),'ew_overlap')
1161	ENDIF
1162	IF( il_ew >= 0 .AND. il_attid == 0 )THEN
1163	tl_att=att_init('ew_overlap',il_ew)
1164	CALL mpp_add_att(tl_mppmsk,tl_att)
1165	CALL mpp_add_att(tl_mpphgr,tl_att)
1166	CALL mpp_add_att(tl_mppzgr,tl_att)
1167	ENDIF
1168
1169	ji=1
1170	DO WHILE( tl_gatt(ji)%c_name /= '' )
1171	CALL mpp_add_att(tl_mppmsk,tl_gatt(ji))
1172	CALL mpp_add_att(tl_mpphgr,tl_gatt(ji))
1173	CALL mpp_add_att(tl_mppzgr,tl_gatt(ji))
1174	ji=ji+1
1175	ENDDO
1176
1177	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1178	! create mask file
1179	!-----------------
1180	CALL iom_mpp_create(tl_mppmsk)
1181
1182	! write file
1183	CALL iom_mpp_write_file(tl_mppmsk)
1184	! close file
1185	CALL iom_mpp_close(tl_mppmsk)
1186
1187	! clean
1188	WRITE(,) "CLEAN MSK"
1189	CALL mpp_clean(tl_mppmsk)
1190
1191	! create mesh_hgr file
1192	!-----------------
1193	CALL iom_mpp_create(tl_mpphgr)
1194
1195	! write file
1196	CALL iom_mpp_write_file(tl_mpphgr)
1197	! close file
1198	CALL iom_mpp_close(tl_mpphgr)
1199
1200	! clean
1201	WRITE(,) "CLEAN HGR"
1202	CALL mpp_clean(tl_mpphgr)
1203
1204	! create mesh_zgr file
1205	!-----------------
1206	WRITE(,) "CREATE ZGR"
1207	CALL iom_mpp_create(tl_mppzgr)
1208
1209	! write file
1210	WRITE(,) "WRITE ZGR"
1211	CALL iom_mpp_write_file(tl_mppzgr)
1212	! close file
1213	WRITE(,) "CLOSE ZGR"
1214	CALL iom_mpp_close(tl_mppzgr)
1215
1216	! clean
1217	WRITE(,) "CLEAN ZGR"
1218	CALL mpp_clean(tl_mppzgr)
1219
1220	CASE DEFAULT
1221	CALL logger_fatal("CREATE MESHMASK : something wrong with in_msh("//&
1222	& TRIM(fct_str(in_msh))//"), check your namelist.")
1223	END SELECT
1224
1225	! clean
1226	WRITE(,) "CLEAN"
1227	CALL att_clean(tl_att)
1228	CALL att_clean(tl_gatt)
1229
1230	DEALLOCATE(tl_gatt)
1231
1232	CALL grid_hgr_clean(ll_domcfg)
1233	CALL grid_zgr_clean(ln_sco)
1234	IF( ln_zps ) CALL grid_zgr_zps_clean()
1235	IF( ln_sco ) CALL grid_zgr_sco_clean()
1236	CALL var_clean_extra()
1237
1238	! close log file
1239	CALL logger_footer()
1240	CALL logger_close()
1241	CONTAINS
1242	!-------------------------------------------------------------------
1243	!> @brief This subroutine compute land/ocean mask arrays at tracer points, hori-
1244	!> zontal velocity points (u & v), vorticity points (f) and baro-
1245	!> tropic stream function points (b).
1246	!>
1247	!> @details
1248	!>
1249	!> ** Method : The ocean/land mask is computed from the basin bathy-
1250	!> metry in level (mbathy) which is defined or read in dommba.
1251	!> mbathy equals 0 over continental T-point
1252	!> and the number of ocean level over the ocean.
1253	!>
1254	!> At a given position (ji,jj,jk) the ocean/land mask is given by:
1255	!> t-point : 0. IF mbathy( ji ,jj) =< 0
1256	!> 1. IF mbathy( ji ,jj) >= jk
1257	!> u-point : 0. IF mbathy( ji ,jj) or mbathy(ji+1, jj ) =< 0
1258	!> 1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk.
1259	!> v-point : 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1) =< 0
1260	!> 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk.
1261	!> f-point : 0. IF mbathy( ji ,jj) or mbathy( ji ,jj+1)
1262	!> or mbathy(ji+1,jj) or mbathy(ji+1,jj+1) =< 0
1263	!> 1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1)
1264	!> and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk.
1265	!> b-point : the same definition as for f-point of the first ocean
1266	!> level (surface level) but with 0 along coastlines.
1267	!> tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
1268	!> rows/lines due to cyclic or North Fold boundaries as well
1269	!> as MPP halos.
1270	!>
1271	!> @WARNING do not set the lateral friction through the value of fmask along
1272	!> the coast and topography.
1273	!>
1274	!> N.B. If nperio not equal to 0, the land/ocean mask arrays
1275	!> are defined with the proper value at lateral domain boundaries,
1276	!> but bmask. indeed, bmask defined the domain over which the
1277	!> barotropic stream function is computed. this domain cannot
1278	!> contain identical columns because the matrix associated with
1279	!> the barotropic stream function equation is then no more inverti-
1280	!> ble. therefore bmask is set to 0 along lateral domain boundaries
1281	!> even IF nperio is not zero.
1282	!>
1283	!> In case of open boundaries (lk_bdy=T):
1284	!> - tmask is set to 1 on the points to be computed bay the open
1285	!> boundaries routines.
1286	!> - bmask is set to 0 on the open boundaries.
1287	!>
1288	!> ** Action : tmask : land/ocean mask at t-point (=0. or 1.)
1289	!> umask : land/ocean mask at u-point (=0. or 1.)
1290	!> vmask : land/ocean mask at v-point (=0. or 1.)
1291	!> fmask : land/ocean mask at f-point (=0. or 1.)
1292	!> bmask : land/ocean mask at barotropic stream
1293	!> function point (=0. or 1.) and set to 0 along lateral boundaries
1294	!> tmask_i : interior ocean mask
1295	!>
1296	!> @author J.Paul
1297	!> @date September, 2015 - rewrite from dom_msk
1298	!> @date October, 2016
1299	!> - do not use anymore special case for ORCA grid
1300	!>
1301	!> @param[in] td_nam
1302	!> @param[in] jpi
1303	!> @param[in] jpj
1304	!> @param[in] jpk
1305	!-------------------------------------------------------------------
1306	SUBROUTINE create__mask(td_nam,jpi,jpj,jpk,ld_domcfg)
1307	IMPLICIT NONE
1308	! Argument
1309	TYPE(TNAMH), INTENT(IN) :: td_nam
1310	INTEGER(i4), INTENT(IN) :: jpi
1311	INTEGER(i4), INTENT(IN) :: jpj
1312	INTEGER(i4), INTENT(IN) :: jpk
1313	LOGICAL , INTENT(IN) :: ld_domcfg
1314
1315	! local variable
1316	! INTEGER(i4) :: ii0, ii1 ! local integers
1317	! INTEGER(i4) :: ij0, ij1
1318	! INTEGER(i4) :: isrow
1319
1320	! INTEGER(i4), DIMENSION(:,:), ALLOCATABLE :: imsk
1321	REAL(dp) , DIMENSION(:,:), ALLOCATABLE :: zwf
1322
1323	! REAL(dp) , DIMENSION(:) , ALLOCATABLE :: dl_tpol
1324	! REAL(dp) , DIMENSION(:) , ALLOCATABLE :: dl_fpol
1325
1326	! loop indices
1327	INTEGER(i4) :: ji
1328	INTEGER(i4) :: jj
1329	INTEGER(i4) :: jk
1330	!----------------------------------------------------------------
1331
1332	! ALLOCATE( imsk(jpi,jpj) )
1333
1334	! ALLOCATE( dl_tpol(jpi) )
1335	! ALLOCATE( dl_fpol(jpi) )
1336
1337	CALL logger_info('dommsk : ocean mask ')
1338	CALL logger_info('~~~~~~')
1339	IF ( rn_shlat == 0. )THEN ; CALL logger_info(' ocean lateral free-slip ')
1340	ELSEIF( rn_shlat == 2. )THEN ; CALL logger_info(' ocean lateral no-slip ')
1341	ELSEIF( 0. < rn_shlat .AND. rn_shlat < 2. )THEN ; CALL logger_info(' ocean lateral partial-slip ')
1342	ELSEIF( 2. < rn_shlat )THEN ; CALL logger_info(' ocean lateral strong-slip ')
1343	ELSE ; CALL logger_info(' rn_shlat is negative = '//TRIM(fct_str(rn_shlat)))
1344	ENDIF
1345
1346	! 1. Ocean/land mask at t-point (computed from mbathy)
1347	! -----------------------------
1348	! N.B. tmask has already the right boundary conditions since mbathy is ok
1349	!
1350	tg_tmask%d_value(:,:,:,1) = 0._dp
1351	DO jk = 1, jpk
1352	DO jj = 1, jpj
1353	DO ji = 1, jpi
1354	IF( tg_mbathy%d_value(ji,jj,1,1) - REAL(jk,dp) + 0.1_dp >= 0._dp )THEN
1355	tg_tmask%d_value(ji,jj,jk,1) = 1._dp
1356	ENDIF
1357	ENDDO
1358	ENDDO
1359	ENDDO
1360
1361	! (ISF) define barotropic mask and mask the ice shelf point
1362	tg_ssmask%d_value(:,:,1,1)=tg_tmask%d_value(:,:,1,1) ! at this stage ice shelf is not masked
1363
1364	DO jk = 1, jpk
1365	DO jj = 1, jpj
1366	DO ji = 1, jpi
1367	IF( tg_misfdep%d_value(ji,jj,1,1) - REAL(jk,dp) - 0.1_dp >= 0._dp ) THEN
1368	tg_tmask%d_value(ji,jj,jk,1) = 0._dp
1369	END IF
1370	ENDDO
1371	ENDDO
1372	ENDDO
1373
1374	! ! Interior domain mask (used for global sum)
1375	! ! --------------------
1376	! tg_tmask_i%d_value(:,:,1,1) = tg_ssmask%d_value(:,:,1,1) ! (ISH) tmask_i = 1 even on the ice shelf
1377	!
1378	! tg_tmask_h%d_value(:,:,1,1) = 1._dp ! 0 on the halo and 1 elsewhere
1379	!
1380	! tg_tmask_h%d_value( 1 , : ,1,1) = 0._dp ! first columns
1381	! tg_tmask_h%d_value(jpi, : ,1,1) = 0._dp ! last columns
1382	! tg_tmask_h%d_value( : , 1 ,1,1) = 0._dp ! first rows
1383	! tg_tmask_h%d_value( : ,jpj,1,1) = 0._dp ! last rows
1384	!
1385	! ! north fold mask
1386	! ! ---------------
1387	! dl_tpol(1:jpi) = 1._dp
1388	! dl_fpol(1:jpi) = 1._dp
1389	! IF( td_nam%i_perio == 3 .OR. td_nam%i_perio == 4 )THEN ! T-point pivot
1390	! dl_tpol(jpi/2+1:jpi) = 0._dp
1391	! dl_fpol( 1 :jpi) = 0._dp
1392	! IF( mjg(nlej) == jpj ) THEN ! only half of the nlcj-1 row
1393	! DO ji = iif+1, iil-1
1394	! tg_tmask_h%d_value(ji,nlej-1,1,1) = tg_tmask_h%d_value(ji,nlej-1,1,1) * dl_tpol(mig(ji))
1395	! END DO
1396	! ENDIF
1397	! ENDIF
1398	!
1399	! tg_tmask_i%d_value(:,:,1,1) = tg_tmask_i%d_value(:,:,1,1) * tg_tmask_h%d_value(:,:,1,1)
1400	!
1401	! IF( td_nam%i_perio == 5 .OR. td_nam%i_perio == 6 )THEN ! F-point pivot
1402	! dl_tpol( 1 :jpi) = 0._dp
1403	! dl_fpol(jpi/2+1:jpi) = 0._dp
1404	! ENDIF
1405
1406	IF( .NOT. ld_domcfg )THEN
1407	! 2. Ocean/land mask at u-, v-, and z-points (computed from tmask)
1408	! -------------------------------------------
1409	DO jk = 1, jpk
1410	DO jj = 1, jpj-1
1411	DO ji = 1, jpi-1 ! vector loop
1412	tg_umask%d_value(ji,jj,jk,1) = tg_tmask%d_value(ji ,jj ,jk,1) * &
1413	& tg_tmask%d_value(ji+1,jj ,jk,1)
1414
1415	tg_vmask%d_value(ji,jj,jk,1) = tg_tmask%d_value(ji ,jj ,jk,1) * &
1416	& tg_tmask%d_value(ji ,jj+1,jk,1)
1417	!END DO
1418	!DO ji = 1, jpi-1 ! NO vector opt.
1419	tg_fmask%d_value(ji,jj,jk,1) = tg_tmask%d_value(ji ,jj ,jk,1) * &
1420	& tg_tmask%d_value(ji+1,jj ,jk,1) * &
1421	& tg_tmask%d_value(ji ,jj+1,jk,1) * &
1422	& tg_tmask%d_value(ji+1,jj+1,jk,1)
1423	ENDDO
1424	ENDDO
1425	ENDDO
1426
1427	! ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point
1428	! DO jj = 1, jpjm1
1429	! DO ji = 1, fs_jpim1 ! vector loop
1430	! tg_ssumask%d_value(ji,jj,1,1) = tg_ssmask%d_value(ji ,jj ,1,1) * &
1431	! & tg_ssmask%d_value(ji+1,jj ,1,1) * &
1432	! & MIN( 1._wp, SUM(tg_umask%d_value(ji,jj,:,1)) )
1433	! tg_ssvmask%d_value(ji,jj,1,1) = tg_ssmask%d_value(ji ,jj ,1,1) * &
1434	! & tg_ssmask%d_value(ji ,jj+1,1,1) * &
1435	! & MIN( 1._wp, SUM(tg_vmask%d_value(ji,jj,:,1)) )
1436	! END DO
1437	! DO ji = 1, jpim1 ! NO vector opt.
1438	! tg_ssfmask%d_value(ji,jj,1,1) = tg_ssmask%d_value(ji ,jj ,1,1) * &
1439	! & tg_ssmask%d_value(ji+1,jj ,1,1) * &
1440	! & tg_ssmask%d_value(ji ,jj+1,1,1) * &
1441	! & tg_ssmask%d_value(ji+1,jj+1,1,1) * &
1442	! & MIN( 1._wp, SUM(tg_fmask%d_value(ji,jj,:,1)) )
1443	! END DO
1444	! END DO
1445	CALL lbc_lnk( tg_umask%d_value (:,:,:,1), 'U', td_nam%i_perio, 1._dp ) ! Lateral boundary conditions
1446	CALL lbc_lnk( tg_vmask%d_value (:,:,:,1), 'V', td_nam%i_perio, 1._dp )
1447	CALL lbc_lnk( tg_fmask%d_value (:,:,:,1), 'F', td_nam%i_perio, 1._dp )
1448	! CALL lbc_lnk( tg_ssumask%d_value(:,:,:,1), 'U', td_nam%i_perio, 1._dp ) ! Lateral boundary conditions
1449	! CALL lbc_lnk( tg_ssvmask%d_value(:,:,:,1), 'V', td_nam%i_perio, 1._dp )
1450	! CALL lbc_lnk( tg_ssfmask%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp )
1451
1452	! 3. Ocean/land mask at wu-, wv- and w points
1453	!----------------------------------------------
1454	! tg_wmask%d_value (:,:,1,1) = tg_tmask%d_value(:,:,1,1) ! surface
1455	! tg_wumask%d_value(:,:,1,1) = tg_umask%d_value(:,:,1,1)
1456	! tg_wvmask%d_value(:,:,1,1) = tg_vmask%d_value(:,:,1,1)
1457	!
1458	! DO jk=2,jpk ! interior values
1459	! tg_wmask%d_value (:,:,jk,1) = tg_tmask%d_value(:,:,jk ,1) * &
1460	! & tg_tmask%d_value(:,:,jk-1,1)
1461	! tg_wumask%d_value(:,:,jk,1) = tg_umask%d_value(:,:,jk ,1) * &
1462	! & tg_umask%d_value(:,:,jk-1,1)
1463	! tg_wvmask%d_value(:,:,jk,1) = tg_vmask%d_value(:,:,jk ,1) * &
1464	! & tg_vmask%d_value(:,:,jk-1,1)
1465	! ENDDO
1466
1467	! Lateral boundary conditions on velocity (modify fmask)
1468	! ---------------------------------------
1469	ALLOCATE( zwf(jpi,jpj) )
1470	DO jk = 1, jpk
1471	zwf(:,:) = tg_fmask%d_value(:,:,jk,1)
1472	DO jj = 2, jpj-1
1473	DO ji = 2, jpi-1 ! vector opt.
1474	IF( tg_fmask%d_value(ji,jj,jk,1) == 0._dp )THEN
1475	tg_fmask%d_value(ji,jj,jk,1) = rn_shlat * &
1476	& MIN(1._dp , MAX(zwf(ji+1,jj), zwf(ji,jj+1), &
1477	& zwf(ji-1,jj), zwf(ji,jj-1)) )
1478	ENDIF
1479	END DO
1480	END DO
1481	DO jj = 2, jpj-1
1482	IF( tg_fmask%d_value(1,jj,jk,1) == 0._dp )THEN
1483	tg_fmask%d_value(1 ,jj,jk,1) = rn_shlat * &
1484	& MIN(1._dp, MAX(zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1)))
1485	ENDIF
1486	IF( tg_fmask%d_value(jpi,jj,jk,1) == 0._dp )THEN
1487	tg_fmask%d_value(jpi,jj,jk,1) = rn_shlat * &
1488	& MIN(1._wp, MAX(zwf(jpi,jj+1), zwf(jpi-1,jj), zwf(jpi,jj-1)))
1489	ENDIF
1490	END DO
1491	DO ji = 2, jpi-1
1492	IF( tg_fmask%d_value(ji,1,jk,1) == 0._dp )THEN
1493	tg_fmask%d_value(ji, 1 ,jk,1) = rn_shlat * &
1494	& MIN(1._dp, MAX(zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1)))
1495	ENDIF
1496	IF( tg_fmask%d_value(ji,jpj,jk,1) == 0._dp )THEN
1497	tg_fmask%d_value(ji,jpj,jk,1) = rn_shlat * &
1498	& MIN(1._dp, MAX(zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpj-1)))
1499	ENDIF
1500	END DO
1501	END DO
1502	DEALLOCATE( zwf )
1503
1504	! IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 2 )THEN ! ORCA_R2 configuration
1505	! ! ! Increased lateral friction near of some straits
1506	! IF( td_nam%i_cla == 0 ) THEN
1507	! ! Gibraltar strait : partial slip (fmask=0.5)
1508	! ij0 = 101 ; ij1 = 101
1509	! ii0 = 139 ; ii1 = 140
1510	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 0.5_dp
1511	!
1512	! ij0 = 102 ; ij1 = 102
1513	! ii0 = 139 ; ii1 = 140
1514	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 0.5_dp
1515	! !
1516	! !Bab el Mandeb : partial slip (fmask=1)
1517	! ij0 = 87 ; ij1 = 88
1518	! ii0 = 160 ; ii1 = 160
1519	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 1._dp
1520	!
1521	! ij0 = 88 ; ij1 = 88
1522	! ii0 = 159 ; ii1 = 159
1523	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 1._dp
1524	! !
1525	! ENDIF
1526	! ENDIF
1527	! !
1528	! IF( td_nam%c_cfg == "orca" .AND. td_nam%i_cfg == 1 )THEN ! ORCA R1 configuration
1529	! ! Increased lateral friction near of some straits
1530	! ! This dirty section will be suppressed by simplification process:
1531	! ! all this will come back in input files
1532	! ! Currently these hard-wired indices relate to configuration with
1533	! ! extend grid (jpjglo=332)
1534	! !
1535	! isrow = 332 - jpj
1536	! ! Gibraltar Strait
1537	! ii0 = 282 ; ii1 = 283
1538	! ij0 = 201 + isrow ; ij1 = 241 - isrow
1539	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1) = 2._dp
1540	!
1541	! ! Bhosporus Strait
1542	! ii0 = 314 ; ii1 = 315
1543	! ij0 = 208 + isrow ; ij1 = 248 - isrow
1544	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp
1545	!
1546	! ! Makassar Strait (Top)
1547	! ii0 = 48 ; ii1 = 48
1548	! ij0 = 149 + isrow ; ij1 = 190 - isrow
1549	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp
1550	!
1551	! ! Lombok Strait
1552	! ii0 = 44 ; ii1 = 44
1553	! ij0 = 124 + isrow ; ij1 = 165 - isrow
1554	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp
1555	!
1556	! ! Ombai Strait
1557	! ii0 = 53 ; ii1 = 53
1558	! ij0 = 124 + isrow ; ij1 = 165 - isrow
1559	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp
1560	!
1561	! ! Timor Passage
1562	! ii0 = 56 ; ii1 = 56
1563	! ij0 = 124 + isrow ; ij1 = 165 - isrow
1564	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 2._dp
1565	!
1566	! ! West Halmahera Strait
1567	! ii0 = 58 ; ii1 = 58
1568	! ij0 = 141 + isrow ; ij1 = 182 - isrow
1569	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp
1570	!
1571	! ! East Halmahera Strait
1572	! ii0 = 55 ; ii1 = 55
1573	! ij0 = 141 + isrow ; ij1 = 182 - isrow
1574	! tg_fmask%d_value(ii0:ii1,ij0:ij1,1:jpk,1 ) = 3._dp
1575	! !
1576	! ENDIF
1577	!
1578	CALL lbc_lnk( tg_fmask%d_value(:,:,:,1), 'F', td_nam%i_perio, 1._dp ) ! Lateral boundary conditions on fmask
1579
1580	! DEALLOCATE( imsk )
1581	ENDIF ! ld_domcfg
1582
1583	! DEALLOCATE( dl_tpol )
1584	! DEALLOCATE( dl_fpol )
1585
1586	END SUBROUTINE create__mask
1587	!-------------------------------------------------------------------
1588	!> @brief
1589	!> this function create array of global attributes.
1590	!>
1591	!> @author J.Paul
1592	!> @date October, 2016 - initial release
1593	!>
1594	!> @param[in] cd_bathy
1595	!> @param[in] cd_coord
1596	!> @param[in] cd_isfdep
1597	!> @param[in] td_namh
1598	!> @param[in] td_namz
1599	!-------------------------------------------------------------------
1600	FUNCTION create__gloatt(cd_bathy,cd_coord,cd_isfdep,td_namh,td_namz) RESULT(td_att)
1601	IMPLICIT NONE
1602	! Argument
1603	CHARACTER(LEN=*), INTENT(IN ) :: cd_bathy
1604	CHARACTER(LEN=*), INTENT(IN ) :: cd_coord
1605	CHARACTER(LEN=*), INTENT(IN ) :: cd_isfdep
1606	TYPE(TNAMH) , INTENT(IN ) :: td_namh
1607	TYPE(TNAMZ) , INTENT(IN ) :: td_namz
1608
1609	! function
1610	TYPE(TATT), DIMENSION(ip_maxatt) :: td_att
1611
1612	! loop indices
1613	INTEGER(i4) :: ji
1614	!----------------------------------------------------------------
1615
1616	ji=1 ; td_att(ji)=att_init("src_bathy",TRIM(cd_bathy))
1617	! horizontal grid
1618	ji=ji+1 ; td_att(ji)=att_init("in_mshhgr",td_namh%i_mshhgr)
1619	SELECT CASE(td_namh%i_mshhgr)
1620	CASE(0)
1621	ji=ji+1 ; td_att(ji)=att_init("src_coord",TRIM(cd_coord))
1622	CASE(1,4)
1623	ji=ji+1 ; td_att(ji)=att_init("ppglam0",td_namh%d_ppglam0)
1624	ji=ji+1 ; td_att(ji)=att_init("ppgphi0",td_namh%d_ppgphi0)
1625	CASE(2,3)
1626	ji=ji+1 ; td_att(ji)=att_init("ppglam0",td_namh%d_ppglam0)
1627	ji=ji+1 ; td_att(ji)=att_init("ppgphi0",td_namh%d_ppgphi0)
1628	ji=ji+1 ; td_att(ji)=att_init("ppe1_deg",td_namh%d_ppe1_deg)
1629	ji=ji+1 ; td_att(ji)=att_init("ppe2_deg",td_namh%d_ppe2_deg)
1630	END SELECT
1631
1632	IF( td_namz%l_isfcav )THEN
1633	ji=ji+1 ; td_att(ji)=att_init("ice_shelf_cavities","activated")
1634	ji=ji+1 ; td_att(ji)=att_init("src_isfdep",TRIM(cd_isfdep))
1635	ENDIF
1636	IF( td_namz%l_iscpl )THEN
1637	ji=ji+1 ; td_att(ji)=att_init("ice_sheet_coupling","activated")
1638	ENDIF
1639
1640	! vertical grid
1641	IF( td_namz%l_zco )THEN
1642	ji=ji+1 ; td_att(ji)=att_init("z_coord","full steps")
1643	ENDIF
1644	IF( td_namz%l_zps )THEN
1645	ji=ji+1 ; td_att(ji)=att_init("z_coord","partial steps")
1646	ENDIF
1647	IF( td_namz%l_sco )THEN
1648	IF( td_namz%l_s_sh94 )THEN
1649	ji=ji+1 ; td_att(ji)=att_init("z_coord","hybrid Song and Haidvogel 1994")
1650	ELSEIF( td_namz%l_s_sf12 )THEN
1651	ji=ji+1 ; td_att(ji)=att_init("z_coord","hybrid Siddorn and Furner 2012")
1652	ELSE
1653	ji=ji+1 ; td_att(ji)=att_init("z_coord","sigma")
1654	ENDIF
1655	ENDIF
1656	ji=ji+1 ; td_att(ji)=att_init("hmin",td_namz%d_hmin)
1657	IF( td_namz%l_isfcav ) ji=ji+1 ; td_att(ji)=att_init("isfhmin",td_namz%d_isfhmin)
1658
1659	! zco
1660	IF( td_namz%d_ppsur /= NF90_FILL_DOUBLE )THEN
1661	ji=ji+1 ; td_att(ji)=att_init("ppsur",td_namz%d_ppsur)
1662	ELSE
1663	ji=ji+1 ; td_att(ji)=att_init("ppsur","to_be_computed")
1664	ENDIF
1665	IF( td_namz%d_ppa0 /= NF90_FILL_DOUBLE )THEN
1666	ji=ji+1 ; td_att(ji)=att_init("ppa0",td_namz%d_ppa0)
1667	ELSE
1668	ji=ji+1 ; td_att(ji)=att_init("ppa0","to_be_computed")
1669	ENDIF
1670	IF( td_namz%d_ppa1 /= NF90_FILL_DOUBLE )THEN
1671	ji=ji+1 ; td_att(ji)=att_init("ppa1",td_namz%d_ppa1)
1672	ELSE
1673	ji=ji+1 ; td_att(ji)=att_init("ppa1","to_be_computed")
1674	ENDIF
1675
1676	ji=ji+1 ; td_att(ji)=att_init("ppkth",td_namz%d_ppkth)
1677	ji=ji+1 ; td_att(ji)=att_init("ppacr",td_namz%d_ppacr)
1678	ji=ji+1 ; td_att(ji)=att_init("ppdzmin",td_namz%d_ppdzmin)
1679	ji=ji+1 ; td_att(ji)=att_init("pphmax",td_namz%d_pphmax)
1680
1681	IF( td_namz%l_dbletanh )THEN
1682	ji=ji+1 ; td_att(ji)=att_init("ppa2",td_namz%d_ppa2)
1683	ji=ji+1 ; td_att(ji)=att_init("ppkth2",td_namz%d_ppkth2)
1684	ji=ji+1 ; td_att(ji)=att_init("ppacr2",td_namz%d_ppacr2)
1685	ENDIF
1686
1687	IF( td_namz%l_zps )THEN
1688	ji=ji+1 ; td_att(ji)=att_init("e3zps_min",td_namz%d_e3zps_min)
1689	ji=ji+1 ; td_att(ji)=att_init("e3zps_rat",td_namz%d_e3zps_rat)
1690	ENDIF
1691
1692	IF( td_namz%l_sco )THEN
1693	ji=ji+1 ; td_att(ji)=att_init("sbot_min",td_namz%d_sbot_min)
1694	ji=ji+1 ; td_att(ji)=att_init("sbot_max",td_namz%d_sbot_max)
1695	ji=ji+1 ; td_att(ji)=att_init("hc",td_namz%d_hc)
1696	IF( td_namz%l_s_sh94 )THEN
1697	ji=ji+1 ; td_att(ji)=att_init("rmax",td_namz%d_rmax)
1698	ji=ji+1 ; td_att(ji)=att_init("theta",td_namz%d_theta)
1699	ji=ji+1 ; td_att(ji)=att_init("thetb",td_namz%d_thetb)
1700	ji=ji+1 ; td_att(ji)=att_init("bb",td_namz%d_bb)
1701	ELSEIF( td_namz%l_s_sf12 )THEN
1702	IF( td_namz%l_sigcrit ) ji=ji+1 ; td_att(ji)=att_init("sigma below critical depth","activated")
1703	ji=ji+1 ; td_att(ji)=att_init("alpha",td_namz%d_alpha)
1704	ji=ji+1 ; td_att(ji)=att_init("efold",td_namz%d_efold)
1705	ji=ji+1 ; td_att(ji)=att_init("zs",td_namz%d_zs)
1706	ji=ji+1 ; td_att(ji)=att_init("zb_a",td_namz%d_zb_a)
1707	ji=ji+1 ; td_att(ji)=att_init("zb_b",td_namz%d_zb_b)
1708	ENDIF
1709	ENDIF
1710
1711	IF( td_namz%l_wd )THEN
1712	ji=ji+1 ; td_att(ji)=att_init("wetting_drying","activated")
1713	ENDIF
1714
1715	IF( td_namz%l_wd )THEN
1716	ji=ji+1 ; td_att(ji)=att_init("wdmin1",td_namz%d_wdmin1)
1717	ji=ji+1 ; td_att(ji)=att_init("wdmin2",td_namz%d_wdmin2)
1718	ji=ji+1 ; td_att(ji)=att_init("wdld",td_namz%d_wdld)
1719	ENDIF
1720
1721	END FUNCTION create__gloatt
1722
1723	END PROGRAM

Note: See TracBrowser for help on using the repository browser.

Download in other formats: