Context Navigation

iom.F90

Last change on this file was 6816, checked in by cetlod, 3 weeks ago
Improvment to be able to run NEMO configurations with xios2 and xios3
File size: 142.4 KB

Line
1	MODULE iom
2	!!======================================================================
3	!! * MODULE iom *
4	!! Input/Output manager : Library to read input files
5	!!======================================================================
6	!! History : 2.0 ! 2005-12 (J. Belier) Original code
7	!! 2.0 ! 2006-02 (S. Masson) Adaptation to NEMO
8	!! 3.0 ! 2007-07 (D. Storkey) Changes to iom_gettime
9	!! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add C1D case
10	!! 3.6 ! 2014-15 DIMG format removed
11	!! 3.6 ! 2015-15 (J. Harle) Added procedure to read REAL attributes
12	!! 4.0 ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields
13	!!----------------------------------------------------------------------
14
15	!!----------------------------------------------------------------------
16	!! iom_open : open a file read only
17	!! iom_close : close a file or all files opened by iom
18	!! iom_get : read a field (interfaced to several routines)
19	!! iom_varid : get the id of a variable in a file
20	!! iom_rstput : write a field in a restart file (interfaced to several routines)
21	!!----------------------------------------------------------------------
22	USE dom_oce ! ocean space and time domain
23	USE domutl !
24	USE flo_oce ! floats module declarations
25	USE lbclnk ! lateal boundary condition / mpp exchanges
26	USE iom_def ! iom variables definitions
27	USE iom_nf90 ! NetCDF format with native NetCDF library
28	USE in_out_manager ! I/O manager
29	USE lib_mpp ! MPP library
30	USE sbc_oce , ONLY : nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1
31	USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes
32	#if defined key_si3
33	USE ice , ONLY : jpl
34	#endif
35	USE phycst ! physical constants
36	USE dianam ! build name of file
37	#if defined key_xios
38	USE xios
39	# endif
40	USE ioipsl, ONLY : ju2ymds ! for calendar
41	USE crs ! Grid coarsening
42	#if defined key_top
43	USE trc, ONLY : profsed
44	#endif
45	USE lib_fortran
46	USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal
47	USE iom_nf90
48	USE netcdf
49
50	IMPLICIT NONE
51	PUBLIC ! must be public to be able to access iom_def through iom
52
53	#if defined key_xios
54	LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag
55	#else
56	LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag
57	#endif
58	PUBLIC iom_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var
59	PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put
60	PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val
61	PUBLIC iom_xios_setid
62
63	PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
64	PRIVATE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
65	PRIVATE iom_get_123d
66	PRIVATE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
67	PRIVATE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
68	PRIVATE iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
69	PRIVATE iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
70	#if defined key_xios
71	PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
72	PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate
73	PRIVATE iom_set_rst_context, iom_set_vars_active
74	# endif
75	PRIVATE set_xios_context
76	PRIVATE iom_set_rstw_active
77
78	INTERFACE iom_get
79	MODULE PROCEDURE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
80	MODULE PROCEDURE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
81	END INTERFACE
82	INTERFACE iom_getatt
83	MODULE PROCEDURE iom_g0d_iatt, iom_g1d_iatt, iom_g0d_ratt, iom_g1d_ratt, iom_g0d_catt
84	END INTERFACE
85	INTERFACE iom_putatt
86	MODULE PROCEDURE iom_p0d_iatt, iom_p1d_iatt, iom_p0d_ratt, iom_p1d_ratt, iom_p0d_catt
87	END INTERFACE
88	INTERFACE iom_rstput
89	MODULE PROCEDURE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
90	MODULE PROCEDURE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
91	END INTERFACE
92	INTERFACE iom_put
93	MODULE PROCEDURE iom_p0d_sp, iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
94	MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
95	END INTERFACE iom_put
96
97	!! * Substitutions
98	# include "do_loop_substitute.h90"
99	!!----------------------------------------------------------------------
100	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
101	!! $Id: iom.F90 15033 2021-06-21 10:24:45Z smasson $
102	!! Software governed by the CeCILL license (see ./LICENSE)
103	!!----------------------------------------------------------------------
104	CONTAINS
105
106	SUBROUTINE iom_init( cdname, kdid, ld_closedef )
107	!!----------------------------------------------------------------------
108	!! * ROUTINE *
109	!!
110	!! ** Purpose :
111	!!
112	!!----------------------------------------------------------------------
113	CHARACTER(len=*), INTENT(in) :: cdname
114	INTEGER , OPTIONAL, INTENT(in) :: kdid
115	LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef
116	#if defined key_xios
117	!
118	TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0)
119	TYPE(xios_date) :: start_date
120	CHARACTER(len=lc) :: clname, cltmpn
121	INTEGER :: irefyear, irefmonth, irefday
122	INTEGER :: ji
123	LOGICAL :: llrst_context ! is context related to restart
124	LOGICAL :: llrstr, llrstw
125	INTEGER :: inum
126	INTEGER :: iln
127	!
128	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds
129	REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries
130	LOGICAL :: ll_closedef
131	LOGICAL :: ll_exist
132	!!----------------------------------------------------------------------
133	!
134	ll_closedef = .TRUE.
135	IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef
136	!
137	ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) )
138	!
139	clname = TRIM(cdname)
140	IF ( .NOT. Agrif_Root() ) THEN
141	iln = INDEX(clname,'/', BACK=.TRUE.)
142	cltmpn = clname(1:iln)
143	clname = clname(iln+1:LEN_TRIM(clname))
144	clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
145	ENDIF
146
147	CALL xios_context_initialize(TRIM(clname), mpi_comm_oce)
148	CALL iom_swap( cdname )
149
150	llrstr = (cdname == cr_ocerst_cxt) .OR. (cdname == cr_icerst_cxt)
151	llrstr = llrstr .OR. (cdname == cr_ablrst_cxt)
152	llrstr = llrstr .OR. (cdname == cr_toprst_cxt)
153	llrstr = llrstr .OR. (cdname == cr_sedrst_cxt)
154
155	llrstw = (cdname == cw_ocerst_cxt) .OR. (cdname == cw_icerst_cxt)
156	llrstw = llrstw .OR. (cdname == cw_ablrst_cxt)
157	llrstw = llrstw .OR. (cdname == cw_toprst_cxt)
158	llrstw = llrstw .OR. (cdname == cw_sedrst_cxt)
159
160	llrst_context = llrstr .OR. llrstw
161
162	! Calendar type is now defined in xml file
163	IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear = 1900
164	IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01
165	IF (.NOT.(xios_getvar('ref_day' ,irefday ))) irefday = 01
166
167	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
168	CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), &
169	& start_date = xios_date( nyear, nmonth, nday,0,0,0) )
170	CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), &
171	& start_date = xios_date( nyear, nmonth, nday,0,0,0) )
172	CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), &
173	& start_date = xios_date( nyear, nmonth, nday,0,0,0) )
174	END SELECT
175
176	! horizontal grid definition
177	IF(.NOT.llrst_context) CALL set_scalar
178	!
179	IF( cdname == cxios_context ) THEN
180	CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. )
181	CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. )
182	CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. )
183	CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. )
184	CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. )
185	CALL set_grid_znl( gphit )
186	!
187	IF( ln_cfmeta ) THEN ! Add additional grid metadata
188	CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
189	CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp))
190	CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp))
191	CALL iom_set_domain_attr("grid_W", area = REAL( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
192	CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp))
193	CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
194	CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
195	CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
196	CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
197	CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif )
198	ENDIF
199	ENDIF
200	!
201	IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN
202	CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain
203	!
204	CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE., .FALSE. )
205	CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE., .FALSE. )
206	CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE., .FALSE. )
207	CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE., .FALSE. )
208	CALL set_grid_znl( gphit_crs )
209	!
210	CALL dom_grid_glo ! Return to parent grid domain
211	!
212	IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata
213	CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp))
214	CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0), dp))
215	CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0), dp))
216	CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp))
217	CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
218	CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs )
219	CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs )
220	CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
221	ENDIF
222	ENDIF
223	!
224	! vertical grid definition
225	IF(.NOT.llrst_context) THEN
226	CALL iom_set_axis_attr( "deptht", paxis = gdept_1d )
227	CALL iom_set_axis_attr( "depthu", paxis = gdept_1d )
228	CALL iom_set_axis_attr( "depthv", paxis = gdept_1d )
229	CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d )
230	CALL iom_set_axis_attr( "depthf", paxis = gdept_1d )
231
232	! ABL
233	IF( .NOT. ALLOCATED(ght_abl) ) THEN ! force definition for xml files (xios)
234	ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) ) ! default allocation needed by iom
235	ght_abl(:) = -1._wp ; ghw_abl(:) = -1._wp
236	e3t_abl(:) = -1._wp ; e3w_abl(:) = -1._wp
237	ENDIF
238	CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) )
239	CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) )
240
241	! Add vertical grid bounds
242	zt_bnds(2,: ) = gdept_1d(:)
243	zt_bnds(1,2:jpk ) = gdept_1d(1:jpkm1)
244	zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1)
245	zw_bnds(1,: ) = gdepw_1d(:)
246	zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk)
247	zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk)
248	CALL iom_set_axis_attr( "deptht", bounds=zw_bnds )
249	CALL iom_set_axis_attr( "depthu", bounds=zw_bnds )
250	CALL iom_set_axis_attr( "depthv", bounds=zw_bnds )
251	CALL iom_set_axis_attr( "depthw", bounds=zt_bnds )
252	CALL iom_set_axis_attr( "depthf", bounds=zw_bnds )
253
254	! ABL
255	za_bnds(1,:) = ghw_abl(1:jpkam1)
256	za_bnds(2,:) = ghw_abl(2:jpka )
257	CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds )
258	za_bnds(1,:) = ght_abl(2:jpka )
259	za_bnds(2,:) = ght_abl(2:jpka ) + e3w_abl(2:jpka)
260	CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds )
261
262	CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) )
263	# if defined key_si3
264	CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
265	! SIMIP diagnostics (4 main arctic straits)
266	! remove from si3 case to general case to use dct diagnostics over
267	! oce+ice
268	! CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) )
269	# endif
270	#if defined key_top
271	IF( ALLOCATED(profsed) ) CALL iom_set_axis_attr( "profsed", paxis = profsed )
272	#endif
273	CALL iom_set_axis_attr( "icbcla", class_num )
274	CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) ! strange syntaxe and idea...
275	CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea...
276	CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea...
277	! for diaprt, we need to define an axis which size can be 1 (default) or 5 (if the file subbasins.nc exists)
278	INQUIRE( FILE = 'subbasins.nc', EXIST = ll_exist )
279	nbasin = 1 + 4 * COUNT( (/ll_exist/) )
280	CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,nbasin) /) )
281	! Transport diagnostics diadct - max number of section 150 in diadct -> ! pb to ensure consistency here
282	IF( ln_diadct ) THEN
283	CALL iom_set_axis_attr( "nstrait" , (/ (REAL(ji,wp), ji=1,nb_sec) /) )
284	ELSE
285	CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) )
286	ENDIF
287	ENDIF
288	!
289	! automatic definitions of some of the xml attributs
290	IF(llrstr) THEN
291	IF(PRESENT(kdid)) THEN
292	CALL iom_set_rst_context(.TRUE.)
293	!set which fields will be read from restart file
294	CALL iom_set_vars_active(kdid)
295	ELSE
296	CALL ctl_stop( 'iom_init:', 'restart read with XIOS: missing pointer to NETCDF file' )
297	ENDIF
298	ELSE IF(llrstw) THEN
299	CALL iom_set_rstw_file(iom_file(kdid)%name)
300	ELSE
301	CALL set_xmlatt
302	ENDIF
303	!
304	! set time step length
305	dtime%second = rn_Dt
306	CALL xios_set_timestep( dtime )
307	!
308	! conditional closure of context definition
309	IF ( ll_closedef ) CALL iom_init_closedef
310	!
311	DEALLOCATE( zt_bnds, zw_bnds )
312	!
313	#endif
314	!
315	END SUBROUTINE iom_init
316
317	SUBROUTINE iom_init_closedef(cdname)
318	!!----------------------------------------------------------------------
319	!! * SUBROUTINE iom_init_closedef *
320	!!----------------------------------------------------------------------
321	!!
322	!! ** Purpose : Closure of context definition
323	!!
324	!!----------------------------------------------------------------------
325	CHARACTER(len=*), OPTIONAL, INTENT(IN) :: cdname
326	#if defined key_xios
327	LOGICAL :: llrstw
328
329	llrstw = .FALSE.
330	IF(PRESENT(cdname)) THEN
331	llrstw = (cdname == cw_ocerst_cxt)
332	llrstw = llrstw .OR. (cdname == cw_icerst_cxt)
333	llrstw = llrstw .OR. (cdname == cw_ablrst_cxt)
334	llrstw = llrstw .OR. (cdname == cw_toprst_cxt)
335	llrstw = llrstw .OR. (cdname == cw_sedrst_cxt)
336	ENDIF
337
338	IF( llrstw ) THEN
339	!set names of the fields in restart file IF using XIOS to write data
340	CALL iom_set_rst_context(.FALSE.)
341	CALL xios_close_context_definition()
342	ELSE
343	CALL xios_close_context_definition()
344	CALL xios_update_calendar( 0 )
345	ENDIF
346	#else
347	IF( .FALSE. ) WRITE(numout,*) 'iom_init_closedef: should not see this' ! useless statement to avoid compilation warnings
348	#endif
349
350	END SUBROUTINE iom_init_closedef
351
352	SUBROUTINE iom_set_vars_active(idnum)
353	!!---------------------------------------------------------------------
354	!! * SUBROUTINE iom_set_vars_active *
355	!!
356	!! ** Purpose : define filename in XIOS context for reading file,
357	!! enable variables present in a file for reading with XIOS
358	!! id of the file is assumed to be rrestart.
359	!!---------------------------------------------------------------------
360	INTEGER, INTENT(IN) :: idnum
361
362	#if defined key_xios
363	INTEGER :: ndims, nvars, natts, unlimitedDimId, dimlen, xtype,mdims
364	TYPE(xios_field) :: field_hdl
365	TYPE(xios_file) :: file_hdl
366	TYPE(xios_filegroup) :: filegroup_hdl
367	INTEGER :: dimids(4), jv,i, idim
368	CHARACTER(LEN=256) :: clinfo ! info character
369	INTEGER, ALLOCATABLE :: indimlens(:)
370	CHARACTER(LEN=nf90_max_name), ALLOCATABLE :: indimnames(:)
371	CHARACTER(LEN=nf90_max_name) :: dimname, varname
372	INTEGER :: iln
373	CHARACTER(LEN=lc) :: fname
374	LOGICAL :: lmeta
375	!metadata in restart file for restart read with XIOS
376	INTEGER, PARAMETER :: NMETA = 11
377	CHARACTER(LEN=lc) :: meta(NMETA)
378
379
380	meta(1) = "nav_lat"
381	meta(2) = "nav_lon"
382	meta(3) = "nav_lev"
383	meta(4) = "time_instant"
384	meta(5) = "time_instant_bounds"
385	meta(6) = "time_counter"
386	meta(7) = "time_counter_bounds"
387	meta(8) = "x"
388	meta(9) = "y"
389	meta(10) = "numcat"
390	meta(11) = "nav_hgt"
391
392	clinfo = ' iom_set_vars_active, file: '//TRIM(iom_file(idnum)%name)
393
394	iln = INDEX( iom_file(idnum)%name, '.nc' )
395	!XIOS doee not need .nc
396	IF(iln > 0) THEN
397	fname = iom_file(idnum)%name(1:iln-1)
398	ELSE
399	fname = iom_file(idnum)%name
400	ENDIF
401
402	!set name of the restart file and enable available fields
403	CALL xios_get_handle("file_definition", filegroup_hdl )
404	CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart')
405	CALL xios_set_file_attr( "rrestart", name=fname, type="one_file", &
406	par_access="collective", enabled=.TRUE., mode="read", &
407	output_freq=xios_timestep )
408
409	CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, ndims, nvars, natts ), clinfo )
410	ALLOCATE(indimlens(ndims), indimnames(ndims))
411	CALL iom_nf90_check( nf90_inquire(iom_file(idnum)%nfid, unlimitedDimId = unlimitedDimId ), clinfo )
412
413	DO idim = 1, ndims
414	CALL iom_nf90_check( nf90_inquire_dimension(iom_file(idnum)%nfid, idim, dimname, dimlen ), clinfo )
415	indimlens(idim) = dimlen
416	indimnames(idim) = dimname
417	ENDDO
418
419	DO jv =1, nvars
420	lmeta = .FALSE.
421	CALL iom_nf90_check( nf90_inquire_variable(iom_file(idnum)%nfid, jv, varname, xtype, ndims, dimids, natts ), clinfo )
422	DO i = 1, NMETA
423	IF(varname == meta(i)) THEN
424	lmeta = .TRUE.
425	ENDIF
426	ENDDO
427	IF(.NOT.lmeta) THEN
428	CALL xios_add_child(file_hdl, field_hdl, varname)
429	mdims = ndims
430
431	IF(ANY(dimids(1:ndims) == unlimitedDimId)) THEN
432	mdims = mdims - 1
433	ENDIF
434
435	IF(mdims == 3) THEN
436	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, &
437	domain_ref="grid_N", &
438	axis_ref=iom_axis(indimlens(dimids(mdims))), &
439	prec = 8, operation = "instant" )
440	ELSEIF(mdims == 2) THEN
441	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, &
442	domain_ref="grid_N", prec = 8, &
443	operation = "instant" )
444	ELSEIF(mdims == 1) THEN
445	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, &
446	axis_ref=iom_axis(indimlens(dimids(mdims))), &
447	prec = 8, operation = "instant" )
448	ELSEIF(mdims == 0) THEN
449	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = varname, &
450	scalar_ref = "grid_scalar", prec = 8, &
451	operation = "instant" )
452	ELSE
453	WRITE(ctmp1,*) 'iom_set_vars_active: variable ', TRIM(varname) ,' incorrect number of dimensions'
454	CALL ctl_stop( 'iom_set_vars_active:', ctmp1 )
455	ENDIF
456	ENDIF
457	ENDDO
458	DEALLOCATE(indimlens, indimnames)
459	#endif
460	END SUBROUTINE iom_set_vars_active
461
462	SUBROUTINE iom_set_rstw_file(cdrst_file)
463	!!---------------------------------------------------------------------
464	!! * SUBROUTINE iom_set_rstw_file *
465	!!
466	!! ** Purpose : define file name in XIOS context for writing restart
467	!!---------------------------------------------------------------------
468	CHARACTER(len=*) :: cdrst_file
469	#if defined key_xios
470	TYPE(xios_file) :: file_hdl
471	TYPE(xios_filegroup) :: filegroup_hdl
472
473	!set name of the restart file and enable available fields
474	IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ', TRIM(cdrst_file)
475	CALL xios_get_handle("file_definition", filegroup_hdl )
476	CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart')
477	IF(nxioso.eq.1) THEN
478	CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,&
479	mode="write", output_freq=xios_timestep)
480	IF(lwp) write(numout,*) 'OPEN ', TRIM(cdrst_file), ' in one_file mode'
481	ELSE
482	CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,&
483	mode="write", output_freq=xios_timestep)
484	IF(lwp) write(numout,*) 'OPEN ', TRIM(cdrst_file), ' in multiple_file mode'
485	ENDIF
486	CALL xios_set_file_attr( "wrestart", name=TRIM(cdrst_file))
487	#endif
488	END SUBROUTINE iom_set_rstw_file
489
490
491	SUBROUTINE iom_set_rstw_active(sdfield, rd0, rs0, rd1, rs1, rd2, rs2, rd3, rs3)
492	!!---------------------------------------------------------------------
493	!! * SUBROUTINE iom_set_rstw_active *
494	!!
495	!! ** Purpose : define file name in XIOS context for writing restart
496	!! enable variables present in restart file for writing
497	!!---------------------------------------------------------------------
498	!sets enabled = .TRUE. for each field in restart file
499	CHARACTER(len = *), INTENT(IN) :: sdfield
500	REAL(dp), OPTIONAL, INTENT(IN) :: rd0
501	REAL(sp), OPTIONAL, INTENT(IN) :: rs0
502	REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rd1
503	REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:) :: rs1
504	REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rd2
505	REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :) :: rs2
506	REAL(dp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rd3
507	REAL(sp), OPTIONAL, INTENT(IN), DIMENSION(:, :, :) :: rs3
508	#if defined key_xios
509	TYPE(xios_field) :: field_hdl
510	TYPE(xios_file) :: file_hdl
511
512	CALL xios_get_handle("wrestart", file_hdl)
513	!define fields for restart context
514	CALL xios_add_child(file_hdl, field_hdl, sdfield)
515
516	IF(PRESENT(rd3)) THEN
517	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
518	domain_ref = "grid_N", &
519	axis_ref = iom_axis(size(rd3, 3)), &
520	prec = 8, operation = "instant" )
521	ELSEIF(PRESENT(rs3)) THEN
522	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
523	domain_ref = "grid_N", &
524	axis_ref = iom_axis(size(rd3, 3)), &
525	prec = 4, operation = "instant" )
526	ELSEIF(PRESENT(rd2)) THEN
527	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
528	domain_ref = "grid_N", prec = 8, &
529	operation = "instant" )
530	ELSEIF(PRESENT(rs2)) THEN
531	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
532	domain_ref = "grid_N", prec = 4, &
533	operation = "instant" )
534	ELSEIF(PRESENT(rd1)) THEN
535	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
536	axis_ref = iom_axis(size(rd1, 1)), &
537	prec = 8, operation = "instant" )
538	ELSEIF(PRESENT(rs1)) THEN
539	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
540	axis_ref = iom_axis(size(rd1, 1)), &
541	prec = 4, operation = "instant" )
542	ELSEIF(PRESENT(rd0)) THEN
543	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
544	scalar_ref = "grid_scalar", prec = 8, &
545	operation = "instant" )
546	ELSEIF(PRESENT(rs0)) THEN
547	CALL xios_set_attr (field_hdl, enabled = .TRUE., name = sdfield, &
548	scalar_ref = "grid_scalar", prec = 4, &
549	operation = "instant" )
550	ENDIF
551	#endif
552	END SUBROUTINE iom_set_rstw_active
553
554	FUNCTION iom_axis(idlev) result(axis_ref)
555	!!---------------------------------------------------------------------
556	!! * FUNCTION iom_axis *
557	!!
558	!! ** Purpose : Used for grid definition when XIOS is used to read/write
559	!! restart. Returns axis corresponding to the number of levels
560	!! given as an input variable. Axes are defined in routine
561	!! iom_set_rst_context
562	!!---------------------------------------------------------------------
563	INTEGER, INTENT(IN) :: idlev
564	CHARACTER(len=lc) :: axis_ref
565	CHARACTER(len=12) :: str
566	IF(idlev == jpk) THEN
567	axis_ref="nav_lev"
568	ELSEIF(idlev == jpka) THEN
569	axis_ref="nav_hgt"
570	#if defined key_si3
571	ELSEIF(idlev == jpl) THEN
572	axis_ref="numcat"
573	#endif
574	ELSE
575	write(str, *) idlev
576	CALL ctl_stop( 'iom_axis', 'Definition for axis with '//TRIM(ADJUSTL(str))//' levels missing')
577	ENDIF
578	END FUNCTION iom_axis
579
580	FUNCTION iom_xios_setid(cdname) result(kid)
581	!!---------------------------------------------------------------------
582	!! * FUNCTION *
583	!!
584	!! ** Purpose : this function returns first available id to keep information about file
585	!! sets filename in iom_file structure and sets name
586	!! of XIOS context depending on cdcomp
587	!! corresponds to iom_nf90_open
588	!!---------------------------------------------------------------------
589	CHARACTER(len=*), INTENT(in ) :: cdname ! File name
590	INTEGER :: kid ! identifier of the opened file
591	INTEGER :: jl
592
593	kid = 0
594	DO jl = jpmax_files, 1, -1
595	IF( iom_file(jl)%nfid == 0 ) kid = jl
596	ENDDO
597
598	iom_file(kid)%name = TRIM(cdname)
599	iom_file(kid)%nfid = 1
600	iom_file(kid)%nvars = 0
601	iom_file(kid)%irec = -1
602
603	END FUNCTION iom_xios_setid
604
605	SUBROUTINE iom_set_rst_context(ld_rstr)
606	!!---------------------------------------------------------------------
607	!! * SUBROUTINE iom_set_rst_context *
608	!!
609	!! ** Purpose : Define domain, axis and grid for restart (read/write)
610	!! context
611	!!
612	!!---------------------------------------------------------------------
613	LOGICAL, INTENT(IN) :: ld_rstr
614	INTEGER :: ji
615	#if defined key_xios
616	TYPE(xios_domaingroup) :: domaingroup_hdl
617	TYPE(xios_domain) :: domain_hdl
618	TYPE(xios_axisgroup) :: axisgroup_hdl
619	TYPE(xios_axis) :: axis_hdl
620	TYPE(xios_scalar) :: scalar_hdl
621	TYPE(xios_scalargroup) :: scalargroup_hdl
622
623	CALL xios_get_handle("domain_definition",domaingroup_hdl)
624	CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")
625	CALL set_grid("N", glamt, gphit, .TRUE., ld_rstr)
626
627	CALL xios_get_handle("axis_definition",axisgroup_hdl)
628	CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev")
629	!AGRIF fails to compile when unit= is in call to xios_set_axis_attr
630	! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down")
631	CALL xios_set_axis_attr( "nav_lev", long_name = "Vertical levels in meters", positive = "down")
632	CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d )
633	#if defined key_si3
634	CALL xios_add_child(axisgroup_hdl, axis_hdl, "numcat")
635	CALL iom_set_axis_attr( "numcat", (/ (REAL(ji,wp), ji=1,jpl) /) )
636	#endif
637	CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_hgt")
638	CALL iom_set_axis_attr( "nav_hgt", (/ (REAL(ji,wp), ji=1,jpka) /) )
639	CALL xios_get_handle("scalar_definition", scalargroup_hdl)
640	CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar")
641	#endif
642	END SUBROUTINE iom_set_rst_context
643
644
645	SUBROUTINE set_xios_context(kdid, cdcont)
646	!!---------------------------------------------------------------------
647	!! * SUBROUTINE iom_set_rst_context *
648	!!
649	!! ** Purpose : set correct XIOS context based on kdid
650	!!
651	!!---------------------------------------------------------------------
652	INTEGER, INTENT(IN) :: kdid ! Identifier of the file
653	CHARACTER(LEN=lc), INTENT(OUT) :: cdcont ! name of the context for XIOS read/write
654
655	cdcont = "NONE"
656
657	IF(lrxios) THEN
658	IF(kdid == numror) THEN
659	cdcont = cr_ocerst_cxt
660	ELSEIF(kdid == numrir) THEN
661	cdcont = cr_icerst_cxt
662	ELSEIF(kdid == numrar) THEN
663	cdcont = cr_ablrst_cxt
664	ELSEIF(kdid == numrtr) THEN
665	cdcont = cr_toprst_cxt
666	ELSEIF(kdid == numrsr) THEN
667	cdcont = cr_sedrst_cxt
668	ENDIF
669	ENDIF
670
671	IF(lwxios) THEN
672	IF(kdid == numrow) THEN
673	cdcont = cw_ocerst_cxt
674	ELSEIF(kdid == numriw) THEN
675	cdcont = cw_icerst_cxt
676	ELSEIF(kdid == numraw) THEN
677	cdcont = cw_ablrst_cxt
678	ELSEIF(kdid == numrtw) THEN
679	cdcont = cw_toprst_cxt
680	ELSEIF(kdid == numrsw) THEN
681	cdcont = cw_sedrst_cxt
682	ENDIF
683	ENDIF
684	END SUBROUTINE set_xios_context
685
686
687	SUBROUTINE iom_swap( cdname )
688	!!---------------------------------------------------------------------
689	!! * SUBROUTINE iom_swap *
690	!!
691	!! ** Purpose : swap context between different agrif grid for xmlio_server
692	!!---------------------------------------------------------------------
693	CHARACTER(len=*), INTENT(in) :: cdname
694	CHARACTER(len=256) :: clname, cltmpn
695	INTEGER :: iln
696	#if defined key_xios
697	TYPE(xios_context) :: nemo_hdl
698
699	clname = TRIM(cdname)
700	IF ( .NOT. Agrif_Root() ) THEN
701	iln = INDEX(clname,'/', BACK=.TRUE.)
702	cltmpn = clname(1:iln)
703	clname = clname(iln+1:LEN_TRIM(clname))
704	clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
705	ENDIF
706	!
707	CALL xios_get_handle(clname,nemo_hdl)
708	!
709	CALL xios_set_current_context(nemo_hdl)
710	#endif
711	!
712	END SUBROUTINE iom_swap
713
714
715	SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev, cdcomp )
716	!!---------------------------------------------------------------------
717	!! * SUBROUTINE iom_open *
718	!!
719	!! ** Purpose : open an input file (return 0 if not found)
720	!!---------------------------------------------------------------------
721	CHARACTER(len=*), INTENT(in ) :: cdname ! File name
722	INTEGER , INTENT( out) :: kiomid ! iom identifier of the opened file
723	LOGICAL , INTENT(in ), OPTIONAL :: ldwrt ! open in write modeb (default = .FALSE.)
724	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.)
725	LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
726	INTEGER , INTENT(in ), OPTIONAL :: kdlev ! number of vertical levels
727	CHARACTER(len=3), INTENT(in ), OPTIONAL :: cdcomp ! name of component calling iom_nf90_open
728	!
729	CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu]
730	CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode)
731	CHARACTER(LEN=10) :: clsuffix ! ".nc"
732	CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits)
733	CHARACTER(LEN=256) :: clinfo ! info character
734	LOGICAL :: llok ! check the existence
735	LOGICAL :: llwrt ! local definition of ldwrt
736	LOGICAL :: llstop ! local definition of ldstop
737	LOGICAL :: lliof ! local definition of ldiof
738	INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits)
739	INTEGER :: iln, ils ! lengths of character
740	INTEGER :: istop !
741	! local number of points for x,y dimensions
742	! position of first local point for x,y dimensions
743	! position of last local point for x,y dimensions
744	! start halo size for x,y dimensions
745	! end halo size for x,y dimensions
746	!---------------------------------------------------------------------
747	! Initializations and control
748	! =============
749	kiomid = -1
750	clinfo = ' iom_open ~~~ '
751	istop = nstop
752	! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
753	! (could be done when defining iom_file in f95 but not in f90)
754	IF( Agrif_Root() ) THEN
755	IF( iom_open_init == 0 ) THEN
756	iom_file(:)%nfid = 0
757	iom_open_init = 1
758	ENDIF
759	ENDIF
760	! do we read or write the file?
761	IF( PRESENT(ldwrt) ) THEN ; llwrt = ldwrt
762	ELSE ; llwrt = .FALSE.
763	ENDIF
764	! do we call ctl_stop if we try to open a non-existing file in read mode?
765	IF( PRESENT(ldstop) ) THEN ; llstop = ldstop
766	ELSE ; llstop = .TRUE.
767	ENDIF
768	! are we using interpolation on the fly?
769	IF( PRESENT(ldiof) ) THEN ; lliof = ldiof
770	ELSE ; lliof = .FALSE.
771	ENDIF
772	! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
773	! =============
774	clname = TRIM(cdname)
775	IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
776	iln = INDEX(clname,'/', BACK=.TRUE.)
777	cltmpn = clname(1:iln)
778	clname = clname(iln+1:LEN_TRIM(clname))
779	clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
780	ENDIF
781	! which suffix should we use?
782	clsuffix = '.nc'
783	! Add the suffix if needed
784	iln = LEN_TRIM(clname)
785	ils = LEN_TRIM(clsuffix)
786	IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 ) &
787	& clname = TRIM(clname)//TRIM(clsuffix)
788	cltmpn = clname ! store this name
789	! try to find if the file to be opened already exist
790	! =============
791	INQUIRE( FILE = clname, EXIST = llok )
792	IF( .NOT.llok ) THEN
793	! we try to add the cpu number to the name
794	WRITE(clcpu,*) narea-1
795
796	clcpu = TRIM(ADJUSTL(clcpu))
797	iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
798	clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
799	icnt = 0
800	INQUIRE( FILE = clname, EXIST = llok )
801	! we try different formats for the cpu number by adding 0
802	DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
803	clcpu = "0"//TRIM(clcpu)
804	clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
805	INQUIRE( FILE = clname, EXIST = llok )
806	icnt = icnt + 1
807	END DO
808	ELSE
809	lxios_sini = .TRUE.
810	ENDIF
811	! Open the NetCDF file
812	! =============
813	! do we have some free file identifier?
814	IF( MINVAL(iom_file(:)%nfid) /= 0 ) &
815	& CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
816	! if no file was found...
817	IF( .NOT. llok ) THEN
818	IF( .NOT. llwrt ) THEN ! we are in read mode
819	IF( llstop ) THEN ; CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
820	ELSE ; istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file
821	ENDIF
822	ELSE ! we are in write mode so we
823	clname = cltmpn ! get back the file name without the cpu number
824	ENDIF
825	ELSE
826	IF( llwrt .AND. .NOT. ln_clobber ) THEN ! we stop as we want to write in a new file
827	CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
828	istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file
829	ELSEIF( llwrt ) THEN ! the file exists and we are in write mode with permission to
830	clname = cltmpn ! overwrite so get back the file name without the cpu number
831	ENDIF
832	ENDIF
833	IF( istop == nstop ) THEN ! no error within this routine
834	CALL iom_nf90_open( clname, kiomid, llwrt, llok, kdlev = kdlev, cdcomp = cdcomp )
835	ENDIF
836	!
837	END SUBROUTINE iom_open
838
839
840	SUBROUTINE iom_close( kiomid )
841	!!--------------------------------------------------------------------
842	!! * SUBROUTINE iom_close *
843	!!
844	!! ** Purpose : close an input file, or all files opened by iom
845	!!--------------------------------------------------------------------
846	INTEGER, INTENT(inout), OPTIONAL :: kiomid ! iom identifier of the file to be closed
847	! ! return 0 when file is properly closed
848	! ! No argument: all files opened by iom are closed
849
850	INTEGER :: jf ! dummy loop indices
851	INTEGER :: i_s, i_e ! temporary integer
852	CHARACTER(LEN=100) :: clinfo ! info character
853	!---------------------------------------------------------------------
854	!
855	IF( iom_open_init == 0 ) RETURN ! avoid to use iom_file(jf)%nfid that us not yet initialized
856	!
857	clinfo = ' iom_close ~~~ '
858	IF( PRESENT(kiomid) ) THEN
859	i_s = kiomid
860	i_e = kiomid
861	ELSE
862	i_s = 1
863	i_e = jpmax_files
864	ENDIF
865
866	IF( i_s > 0 ) THEN
867	DO jf = i_s, i_e
868	IF( iom_file(jf)%nfid > 0 ) THEN
869	CALL iom_nf90_close( jf )
870	iom_file(jf)%nfid = 0 ! free the id
871	IF( PRESENT(kiomid) ) kiomid = 0 ! return 0 as id to specify that the file was closed
872	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
873	ELSEIF( PRESENT(kiomid) ) THEN
874	WRITE(ctmp1,*) '--->', kiomid
875	CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
876	ENDIF
877	END DO
878	ENDIF
879	!
880	END SUBROUTINE iom_close
881
882
883	FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop )
884	!!-----------------------------------------------------------------------
885	!! * FUNCTION iom_varid *
886	!!
887	!! ** Purpose : get the id of a variable in a file (return 0 if not found)
888	!!-----------------------------------------------------------------------
889	INTEGER , INTENT(in ) :: kiomid ! file Identifier
890	CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable
891	INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of each dimension
892	INTEGER , INTENT( out), OPTIONAL :: kndims ! number of dimensions
893	LOGICAL , INTENT( out), OPTIONAL :: lduld ! true if the last dimension is unlimited (time)
894	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if looking for non-existing variable (default = .TRUE.)
895	!
896	INTEGER :: iom_varid, iiv, i_nvd
897	LOGICAL :: ll_fnd
898	CHARACTER(LEN=100) :: clinfo ! info character
899	LOGICAL :: llstop ! local definition of ldstop
900	!!-----------------------------------------------------------------------
901	iom_varid = 0 ! default definition
902	! do we call ctl_stop if we look for non-existing variable?
903	IF( PRESENT(ldstop) ) THEN ; llstop = ldstop
904	ELSE ; llstop = .TRUE.
905	ENDIF
906	!
907	IF( kiomid > 0 ) THEN
908	clinfo = 'iom_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
909	IF( iom_file(kiomid)%nfid == 0 ) THEN
910	CALL ctl_stop( TRIM(clinfo), 'the file is not open' )
911	ELSE
912	ll_fnd = .FALSE.
913	iiv = 0
914	!
915	DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
916	iiv = iiv + 1
917	ll_fnd = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
918	END DO
919	!
920	IF( .NOT.ll_fnd ) THEN
921	iiv = iiv + 1
922	IF( iiv <= jpmax_vars ) THEN
923	iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims, lduld )
924	ELSE
925	CALL ctl_stop( TRIM(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name, &
926	& 'increase the parameter jpmax_vars')
927	ENDIF
928	IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' )
929	ELSE
930	iom_varid = iiv
931	IF( PRESENT(kdimsz) ) THEN
932	i_nvd = iom_file(kiomid)%ndims(iiv)
933	IF( i_nvd <= size(kdimsz) ) THEN
934	kdimsz(1:i_nvd) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
935	ELSE
936	WRITE(ctmp1,*) i_nvd, size(kdimsz)
937	CALL ctl_stop( TRIM(clinfo), 'error in kdimsz size'//TRIM(ctmp1) )
938	ENDIF
939	ENDIF
940	IF( PRESENT(kndims) ) kndims = iom_file(kiomid)%ndims(iiv)
941	IF( PRESENT( lduld) ) lduld = iom_file(kiomid)%luld( iiv)
942	ENDIF
943	ENDIF
944	ENDIF
945	!
946	END FUNCTION iom_varid
947
948
949	!!----------------------------------------------------------------------
950	!! INTERFACE iom_get
951	!!----------------------------------------------------------------------
952	SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime )
953	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
954	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
955	REAL(sp) , INTENT( out) :: pvar ! read field
956	REAL(dp) :: ztmp_pvar ! tmp var to read field
957	INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
958	!
959	INTEGER :: idvar ! variable id
960	INTEGER :: idmspc ! number of spatial dimensions
961	INTEGER , DIMENSION(1) :: itime ! record number
962	CHARACTER(LEN=100) :: clinfo ! info character
963	CHARACTER(LEN=100) :: clname ! file name
964	CHARACTER(LEN=1) :: cldmspc !
965	CHARACTER(LEN=lc) :: context
966	!
967	CALL set_xios_context(kiomid, context)
968
969	IF(context == "NONE") THEN ! read data using default library
970	itime = 1
971	IF( PRESENT(ktime) ) itime = ktime
972	!
973	clname = iom_file(kiomid)%name
974	clinfo = ' iom_g0d, file: '//TRIM(clname)//', var: '//TRIM(cdvar)
975	!
976	IF( kiomid > 0 ) THEN
977	idvar = iom_varid( kiomid, cdvar )
978	IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
979	idmspc = iom_file ( kiomid )%ndims( idvar )
980	IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1
981	WRITE(cldmspc , fmt='(i1)') idmspc
982	IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
983	& 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
984	& 'Use ncwa -a to suppress the unnecessary dimensions' )
985	CALL iom_nf90_get( kiomid, idvar, ztmp_pvar, itime )
986	pvar = ztmp_pvar
987	ENDIF
988	ENDIF
989	ELSE
990	#if defined key_xios
991	IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', TRIM(cdvar)
992	CALL iom_swap(context)
993	CALL xios_recv_field( TRIM(cdvar), pvar)
994	CALL iom_swap(cxios_context)
995	#else
996	WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//TRIM(clname)//', var:'//TRIM(cdvar)
997	CALL ctl_stop( 'iom_g0d', ctmp1 )
998	#endif
999	ENDIF
1000	END SUBROUTINE iom_g0d_sp
1001
1002	SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime )
1003	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1004	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
1005	REAL(dp) , INTENT( out) :: pvar ! read field
1006	INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
1007	!
1008	INTEGER :: idvar ! variable id
1009	INTEGER :: idmspc ! number of spatial dimensions
1010	INTEGER , DIMENSION(1) :: itime ! record number
1011	CHARACTER(LEN=100) :: clinfo ! info character
1012	CHARACTER(LEN=100) :: clname ! file name
1013	CHARACTER(LEN=1) :: cldmspc !
1014	CHARACTER(LEN=lc) :: context
1015	!
1016	CALL set_xios_context(kiomid, context)
1017
1018	IF(context == "NONE") THEN ! read data using default library
1019	itime = 1
1020	IF( PRESENT(ktime) ) itime = ktime
1021	!
1022	clname = iom_file(kiomid)%name
1023	clinfo = ' iom_g0d, file: '//TRIM(clname)//', var: '//TRIM(cdvar)
1024	!
1025	IF( kiomid > 0 ) THEN
1026	idvar = iom_varid( kiomid, cdvar )
1027	IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
1028	idmspc = iom_file ( kiomid )%ndims( idvar )
1029	IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1
1030	WRITE(cldmspc , fmt='(i1)') idmspc
1031	IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
1032	& 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
1033	& 'Use ncwa -a to suppress the unnecessary dimensions' )
1034	CALL iom_nf90_get( kiomid, idvar, pvar, itime )
1035	ENDIF
1036	ENDIF
1037	ELSE
1038	#if defined key_xios
1039	IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', TRIM(cdvar)
1040	CALL iom_swap(context)
1041	CALL xios_recv_field( TRIM(cdvar), pvar)
1042	CALL iom_swap(cxios_context)
1043	#else
1044	WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//TRIM(clname)//', var:'//TRIM(cdvar)
1045	CALL ctl_stop( 'iom_g0d', ctmp1 )
1046	#endif
1047	ENDIF
1048	END SUBROUTINE iom_g0d_dp
1049
1050	SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
1051	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1052	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
1053	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
1054	REAL(sp) , INTENT( out), DIMENSION(:) :: pvar ! read field
1055	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
1056	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading
1057	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis
1058	!
1059	IF( kiomid > 0 ) THEN
1060	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvsp1d = pvar, &
1061	& ktime = ktime, kstart = kstart, kcount = kcount )
1062	ENDIF
1063	END SUBROUTINE iom_g1d_sp
1064
1065
1066	SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
1067	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1068	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
1069	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
1070	REAL(dp) , INTENT( out), DIMENSION(:) :: pvar ! read field
1071	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
1072	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading
1073	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis
1074	!
1075	IF( kiomid > 0 ) THEN
1076	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvdp1d = pvar, &
1077	& ktime = ktime, kstart = kstart, kcount = kcount)
1078	ENDIF
1079	END SUBROUTINE iom_g1d_dp
1080
1081	SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount)
1082	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1083	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
1084	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
1085	REAL(sp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field
1086	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
1087	CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
1088	REAL(sp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold
1089	INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
1090	INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading
1091	INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis
1092	!
1093	IF( kiomid > 0 ) THEN
1094	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvsp2d = pvar, &
1095	& cd_type = cd_type, psgn_sp = psgn, kfill = kfill, &
1096	& ktime = ktime, kstart = kstart, kcount = kcount )
1097	ENDIF
1098	END SUBROUTINE iom_g2d_sp
1099
1100	SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount)
1101	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1102	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
1103	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
1104	REAL(dp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field
1105	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
1106	CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
1107	REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.): (not) change sign across the north fold
1108	INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
1109	INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kstart ! start axis position of the reading
1110	INTEGER , INTENT(in ), DIMENSION(2), OPTIONAL :: kcount ! number of points in each axis
1111	!
1112	IF( kiomid > 0 ) THEN
1113	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvdp2d = pvar, &
1114	& cd_type = cd_type, psgn_dp = psgn, kfill = kfill, &
1115	& ktime = ktime, kstart = kstart, kcount = kcount )
1116	ENDIF
1117	END SUBROUTINE iom_g2d_dp
1118
1119	SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount )
1120	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1121	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
1122	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
1123	REAL(sp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field
1124	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
1125	CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
1126	REAL(sp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold
1127	INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
1128	INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading
1129	INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis
1130	!
1131	IF( kiomid > 0 ) THEN
1132	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvsp3d = pvar, &
1133	& cd_type = cd_type, psgn_sp = psgn, kfill = kfill, &
1134	& ktime = ktime, kstart = kstart, kcount = kcount )
1135	ENDIF
1136	END SUBROUTINE iom_g3d_sp
1137
1138	SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount )
1139	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1140	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
1141	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
1142	REAL(dp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field
1143	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
1144	CHARACTER(len=1), INTENT(in ) , OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
1145	REAL(dp) , INTENT(in ) , OPTIONAL :: psgn ! -1.(1.) : (not) change sign across the north fold
1146	INTEGER , INTENT(in ) , OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
1147	INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kstart ! start axis position of the reading
1148	INTEGER , INTENT(in ), DIMENSION(3), OPTIONAL :: kcount ! number of points in each axis
1149	!
1150	IF( kiomid > 0 ) THEN
1151	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar, pvdp3d = pvar, &
1152	& cd_type = cd_type, psgn_dp = psgn, kfill = kfill, &
1153	& ktime = ktime, kstart = kstart, kcount = kcount )
1154	ENDIF
1155	END SUBROUTINE iom_g3d_dp
1156
1157	!!----------------------------------------------------------------------
1158
1159	SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pvsp1d, pvsp2d, pvsp3d, pvdp1d, pvdp2d, pvdp3d, &
1160	& ktime , cd_type, psgn_sp, psgn_dp, kfill, kstart, kcount )
1161	!!-----------------------------------------------------------------------
1162	!! * ROUTINE iom_get_123d *
1163	!!
1164	!! ** Purpose : read a 1D/2D/3D variable
1165	!!
1166	!! ** Method : read ONE record at each CALL
1167	!!-----------------------------------------------------------------------
1168	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1169	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
1170	CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable
1171	REAL(sp), DIMENSION(:) , INTENT( out), OPTIONAL :: pvsp1d ! read field (1D case), single precision
1172	REAL(sp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pvsp2d ! read field (2D case), single precision
1173	REAL(sp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pvsp3d ! read field (3D case), single precision
1174	REAL(dp), DIMENSION(:) , INTENT( out), OPTIONAL :: pvdp1d ! read field (1D case), double precision
1175	REAL(dp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pvdp2d ! read field (2D case), double precision
1176	REAL(dp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pvdp3d ! read field (3D case), double precision
1177	INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
1178	CHARACTER(len=1) , INTENT(in ), OPTIONAL :: cd_type ! nature of grid-points (T, U, V, F, W)
1179	REAL(sp) , INTENT(in ), OPTIONAL :: psgn_sp ! -1.(1.) : (not) change sign across the north fold
1180	REAL(dp) , INTENT(in ), OPTIONAL :: psgn_dp ! -1.(1.) : (not) change sign across the north fold
1181	INTEGER , INTENT(in ), OPTIONAL :: kfill ! value of kfillmode in lbc_lbk
1182	INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis
1183	INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis
1184	!
1185	LOGICAL :: llok ! true if ok!
1186	INTEGER :: jl ! loop on number of dimension
1187	INTEGER :: idom ! type of domain
1188	INTEGER :: idvar ! id of the variable
1189	INTEGER :: inbdim ! number of dimensions of the variable
1190	INTEGER :: idmspc ! number of spatial dimensions
1191	INTEGER :: itime ! record number
1192	INTEGER :: istop ! temporary value of nstop
1193	INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes
1194	INTEGER :: ji, jj ! loop counters
1195	INTEGER :: irankpv !
1196	INTEGER :: ind1, ind2 ! substring index
1197	INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis
1198	INTEGER, DIMENSION(jpmax_dims) :: icnt ! number of value to read along each axis
1199	INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable
1200	INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable
1201	REAL(sp) :: zscf_sp, zofs_sp ! sacle_factor and add_offset, single precision
1202	REAL(dp) :: zscf_dp, zofs_dp ! sacle_factor and add_offset, double precision
1203	REAL(sp) :: zsgn_sp ! local value of psgn, single precision
1204	REAL(dp) :: zsgn_dp ! local value of psgn, double precision
1205	INTEGER :: itmp ! temporary integer
1206	CHARACTER(LEN=256) :: clinfo ! info character
1207	CHARACTER(LEN=256) :: clname ! file name
1208	CHARACTER(LEN=1) :: clrankpv, cldmspc !
1209	CHARACTER(LEN=1) :: cl_type ! local value of cd_type
1210	LOGICAL :: ll_only3rd ! T => if kstart, kcount present then only use values for 3rd spatial dimension.
1211	LOGICAL :: llis1d, llis2d, llis3d
1212	LOGICAL :: llsp ! use single precision
1213	INTEGER :: inlev ! number of levels for 3D data
1214	!---------------------------------------------------------------------
1215	CHARACTER(LEN=lc) :: context
1216	!
1217	CALL set_xios_context(kiomid, context)
1218	!
1219	llsp = PRESENT(pvsp1d) .OR. PRESENT(pvsp2d) .OR. PRESENT(pvsp3d)
1220	IF( llsp ) THEN
1221	llis1d = PRESENT(pvsp1d) ; IF( llis1d ) ishape(1:1) = SHAPE(pvsp1d)
1222	llis2d = PRESENT(pvsp2d) ; IF( llis2d ) ishape(1:2) = SHAPE(pvsp2d)
1223	llis3d = PRESENT(pvsp3d) ; IF( llis3d ) ishape(1:3) = SHAPE(pvsp3d)
1224	ELSE
1225	llis1d = PRESENT(pvdp1d) ; IF( llis1d ) ishape(1:1) = SHAPE(pvdp1d)
1226	llis2d = PRESENT(pvdp2d) ; IF( llis2d ) ishape(1:2) = SHAPE(pvdp2d)
1227	llis3d = PRESENT(pvdp3d) ; IF( llis3d ) ishape(1:3) = SHAPE(pvdp3d)
1228	ENDIF
1229	inlev = -1
1230	IF( llis3d ) inlev = ishape(3)
1231	!
1232	idom = kdom
1233	istop = nstop
1234	!
1235	IF(context == "NONE") THEN
1236	clname = iom_file(kiomid)%name ! esier to read
1237	clinfo = ' iom_get_123d, file: '//TRIM(clname)//', var: '//TRIM(cdvar)
1238	! check kcount and kstart optionals parameters...
1239	IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(TRIM(clinfo), 'kcount present needs kstart present')
1240	IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(TRIM(clinfo), 'kstart present needs kcount present')
1241	IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_auto_xy ) &
1242	& CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy')
1243	IF( idom == jpdom_auto_xy .AND. .NOT. PRESENT(kstart) ) &
1244	& CALL ctl_stop(TRIM(clinfo), 'idom = jpdom_auto_xy requires kstart to be present')
1245	!
1246	! Search for the variable in the data base (eventually actualize data)
1247	!
1248	idvar = iom_varid( kiomid, cdvar )
1249	IF( idvar > 0 ) THEN
1250	!
1251	idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) ! to write iom_file(kiomid)%dimsz in a shorter way
1252	inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file
1253	idmspc = inbdim ! number of spatial dimensions in the file
1254	IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1
1255	IF( idmspc > 3 ) CALL ctl_stop(TRIM(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')
1256	!
1257	! Identify the domain in case of jpdom_auto definition
1258	IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN
1259	idom = jpdom_global ! default
1260	! else: if the file name finishes with _xxxx.nc with xxxx any number
1261	ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
1262	ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
1263	IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF
1264	ENDIF
1265	!
1266	! check the consistency between input array and data rank in the file
1267	!
1268	! initializations
1269	itime = 1
1270	IF( PRESENT(ktime) ) itime = ktime
1271	!
1272	irankpv = 1 * COUNT( (/ llis1d /) ) + 2 * COUNT( (/ llis2d /) ) + 3 * COUNT( (/ llis3d /) )
1273	WRITE(clrankpv, fmt='(i1)') irankpv
1274	WRITE(cldmspc , fmt='(i1)') idmspc
1275	!
1276	IF( idmspc < irankpv ) THEN ! it seems we want to read more than we can...
1277	IF( llis3d .AND. idmspc == 2 ) THEN ! 3D input array from 2D spatial data in the file:
1278	llok = inlev == 1 ! -> 3rd dimension must be equal to 1
1279	ELSEIF( llis3d .AND. idmspc == 1 ) THEN ! 3D input array from 1D spatial data in the file:
1280	llok = inlev == 1 .AND. ishape(2) == 1 ! -> 2nd and 3rd dimensions must be equal to 1
1281	ELSEIF( llis3d .AND. idmspc == 2 ) THEN ! 2D input array from 1D spatial data in the file:
1282	llok = ishape(2) == 1 ! -> 2nd dimension must be equal to 1
1283	ELSE
1284	llok = .FALSE.
1285	ENDIF
1286	IF( .NOT. llok ) CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', &
1287	& '=> cannot read a true '//clrankpv//'D array from this file...' )
1288	ELSEIF( idmspc == irankpv ) THEN
1289	IF( llis1d .AND. idom /= jpdom_unknown ) &
1290	& CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
1291	ELSEIF( idmspc > irankpv ) THEN ! it seems we want to read less than we should...
1292	IF( llis2d .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
1293	CALL ctl_warn( TRIM(clinfo), '2D array input but 3 spatial dimensions in the file...' , &
1294	& 'As the size of the z dimension is 1 and as we try to read the first record, ', &
1295	& 'we accept this case, even if there is a possible mix-up between z and time dimension' )
1296	idmspc = idmspc - 1
1297	!!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation
1298	!ELSE
1299	! CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,', &
1300	! & 'we do not accept data with '//cldmspc//' spatial dimensions' , &
1301	! & 'Use ncwa -a to suppress the unnecessary dimensions' )
1302	ENDIF
1303	ENDIF
1304	!
1305	! definition of istart and icnt
1306	!
1307	icnt (:) = 1 ! default definition (simple way to deal with special cases listed above)
1308	istart(:) = 1 ! default definition (simple way to deal with special cases listed above)
1309	istart(idmspc+1) = itime ! temporal dimenstion
1310	!
1311	IF( idom == jpdom_unknown ) THEN
1312	IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN
1313	istart(1:idmspc) = kstart(1:idmspc)
1314	icnt (1:idmspc) = kcount(1:idmspc)
1315	ELSE
1316	icnt (1:idmspc) = idimsz(1:idmspc)
1317	ENDIF
1318	ELSE ! not a 1D array as pv(sd)p1d requires jpdom_unknown
1319	! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0
1320	IF( idom == jpdom_global ) istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /)
1321	icnt(1:2) = (/ Ni_0, Nj_0 /)
1322	IF( llis3d ) THEN
1323	IF( idom == jpdom_auto_xy ) THEN
1324	istart(3) = kstart(3)
1325	icnt (3) = kcount(3)
1326	ELSE
1327	icnt (3) = inlev
1328	ENDIF
1329	ENDIF
1330	ENDIF
1331	!
1332	! check that istart and icnt can be used with this file
1333	!-
1334	DO jl = 1, jpmax_dims
1335	itmp = istart(jl)+icnt(jl)-1
1336	IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
1337	WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
1338	WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl)
1339	CALL ctl_stop( TRIM(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )
1340	ENDIF
1341	END DO
1342	!
1343	! check that icnt matches the input array
1344	!-
1345	IF( idom == jpdom_unknown ) THEN
1346	ctmp1 = 'd'
1347	ELSE ! we must redefine ishape as we don't read the full array
1348	IF( llis2d ) THEN
1349	IF( llsp ) THEN ; ishape(1:2) = SHAPE(pvsp2d(Nis0:Nie0,Njs0:Nje0 ))
1350	ELSE ; ishape(1:2) = SHAPE(pvdp2d(Nis0:Nie0,Njs0:Nje0 ))
1351	ENDIF
1352	ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)'
1353	ENDIF
1354	IF( llis3d ) THEN
1355	IF( llsp ) THEN ; ishape(1:3) = SHAPE(pvsp3d(Nis0:Nie0,Njs0:Nje0,:))
1356	ELSE ; ishape(1:3) = SHAPE(pvdp3d(Nis0:Nie0,Njs0:Nje0,:))
1357	ENDIF
1358	ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)'
1359	ENDIF
1360	ENDIF
1361	DO jl = 1, irankpv
1362	WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
1363	IF( llsp ) THEN
1364	IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pvsp'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
1365	ELSE
1366	IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pvdp'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
1367	ENDIF
1368	END DO
1369
1370	ENDIF
1371
1372	! read the data
1373	!-
1374	IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...
1375	!
1376	! find the right index of the array to be read
1377	IF( idom /= jpdom_unknown ) THEN ; ix1 = Nis0 ; ix2 = Nie0 ; iy1 = Njs0 ; iy2 = Nje0
1378	ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
1379	ENDIF
1380
1381	CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &
1382	& pvsp1d, pvsp2d, pvsp3d, pvdp1d, pvdp2d, pvdp3d )
1383
1384	IF( istop == nstop ) THEN ! no additional errors until this point...
1385	IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
1386
1387	cl_type = 'T'
1388	IF( PRESENT(cd_type) ) cl_type = cd_type
1389	IF( llsp ) THEN
1390	zsgn_sp = 1._sp
1391	IF( PRESENT(psgn_sp) ) zsgn_sp = psgn_sp
1392	IF( llis2d .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1393	CALL lbc_lnk( 'iom', pvsp2d, cl_type, zsgn_sp, kfillmode = kfill )
1394	ELSEIF( llis3d .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1395	CALL lbc_lnk( 'iom', pvsp3d, cl_type, zsgn_sp, kfillmode = kfill )
1396	ENDIF
1397	ELSE
1398	zsgn_dp = 1._dp
1399	IF( PRESENT(psgn_dp) ) zsgn_dp = psgn_dp
1400	IF( llis2d .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1401	CALL lbc_lnk( 'iom', pvdp2d, cl_type, zsgn_dp, kfillmode = kfill )
1402	ELSEIF( llis3d .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1403	CALL lbc_lnk( 'iom', pvdp3d, cl_type, zsgn_dp, kfillmode = kfill )
1404	ENDIF
1405	ENDIF
1406	!--- overlap areas and extra hallows (mpp)
1407	!
1408	ELSE
1409	! return if istop == nstop is false
1410	RETURN
1411	ENDIF
1412	ELSE
1413	! return if statment idvar > 0 .AND. istop == nstop is false
1414	RETURN
1415	ENDIF
1416	!
1417	ELSE ! read using XIOS. Only if key_xios is defined
1418	#if defined key_xios
1419	!would be good to be able to check which context is active and swap only if current is not restart
1420	idvar = iom_varid( kiomid, cdvar )
1421	CALL iom_swap(context)
1422	IF( llsp ) THEN
1423	zsgn_sp = 1._sp ; IF( PRESENT(psgn_sp) ) zsgn_sp = psgn_sp
1424	ELSE
1425	zsgn_dp = 1._dp ; IF( PRESENT(psgn_dp) ) zsgn_dp = psgn_dp
1426	ENDIF
1427	cl_type = 'T'
1428	IF( PRESENT(cd_type) ) cl_type = cd_type
1429
1430	IF( llis3d ) THEN
1431	IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar)
1432	IF( llsp ) THEN ; CALL xios_recv_field( TRIM(cdvar), pvsp3d )
1433	ELSE ; CALL xios_recv_field( TRIM(cdvar), pvdp3d )
1434	ENDIF
1435	IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1436	IF( llsp ) THEN ; CALL lbc_lnk( 'iom', pvsp3d, cl_type, zsgn_sp, kfillmode = kfill)
1437	ELSE ; CALL lbc_lnk( 'iom', pvdp3d, cl_type, zsgn_dp, kfillmode = kfill)
1438	ENDIF
1439	ENDIF
1440	ELSEIF( llis2d ) THEN
1441	IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar)
1442	IF( llsp ) THEN ; CALL xios_recv_field( TRIM(cdvar), pvsp2d )
1443	ELSE ; CALL xios_recv_field( TRIM(cdvar), pvdp2d )
1444	ENDIF
1445	IF(idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN
1446	IF( llsp ) THEN ; CALL lbc_lnk('iom', pvsp2d, cl_type, zsgn_sp, kfillmode = kfill)
1447	ELSE ; CALL lbc_lnk('iom', pvdp2d, cl_type, zsgn_dp, kfillmode = kfill)
1448	ENDIF
1449	ENDIF
1450	ELSEIF( llis1d ) THEN
1451	IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar)
1452	IF( llsp ) THEN ; CALL xios_recv_field( TRIM(cdvar), pvsp1d )
1453	ELSE ; CALL xios_recv_field( TRIM(cdvar), pvdp1d )
1454	ENDIF
1455	ENDIF
1456	CALL iom_swap(cxios_context)
1457	#else
1458	istop = istop + 1
1459	clinfo = 'Can not use XIOS in iom_get_123d, file: '//TRIM(clname)//', var:'//TRIM(cdvar)
1460	#endif
1461	ENDIF
1462
1463	!--- Apply scale_factor and offset
1464	IF( llsp ) THEN
1465	zscf_sp = iom_file(kiomid)%scf(idvar) ! scale factor
1466	zofs_sp = iom_file(kiomid)%ofs(idvar) ! offset
1467	IF( llis1d ) THEN
1468	IF( zscf_sp /= 1._sp ) pvsp1d(: ) = pvsp1d(: ) * zscf_sp
1469	IF( zofs_sp /= 0._sp ) pvsp1d(: ) = pvsp1d(: ) + zofs_sp
1470	ELSEIF( llis2d ) THEN
1471	IF( zscf_sp /= 1._sp ) pvsp2d(:,: ) = pvsp2d(:,: ) * zscf_sp
1472	IF( zofs_sp /= 0._sp ) pvsp2d(:,: ) = pvsp2d(:,: ) + zofs_sp
1473	ELSEIF( llis3d ) THEN
1474	IF( zscf_sp /= 1._sp ) pvsp3d(:,:,:) = pvsp3d(:,:,:) * zscf_sp
1475	IF( zofs_sp /= 0._sp ) pvsp3d(:,:,:) = pvsp3d(:,:,:) + zofs_sp
1476	ENDIF
1477	ELSE
1478	zscf_dp = iom_file(kiomid)%scf(idvar) ! scale factor
1479	zofs_dp = iom_file(kiomid)%ofs(idvar) ! offset
1480	IF( llis1d ) THEN
1481	IF( zscf_dp /= 1._dp ) pvdp1d(: ) = pvdp1d(: ) * zscf_dp
1482	IF( zofs_dp /= 0._dp ) pvdp1d(: ) = pvdp1d(: ) + zofs_dp
1483	ELSEIF( llis2d ) THEN
1484	IF( zscf_dp /= 1._dp ) pvdp2d(:,: ) = pvdp2d(:,: ) * zscf_dp
1485	IF( zofs_dp /= 0._dp ) pvdp2d(:,: ) = pvdp2d(:,: ) + zofs_dp
1486	ELSEIF( llis3d ) THEN
1487	IF( zscf_dp /= 1._dp ) pvdp3d(:,:,:) = pvdp3d(:,:,:) * zscf_dp
1488	IF( zofs_dp /= 0._dp ) pvdp3d(:,:,:) = pvdp3d(:,:,:) + zofs_dp
1489	ENDIF
1490	ENDIF
1491	!
1492	END SUBROUTINE iom_get_123d
1493
1494	SUBROUTINE iom_get_var( cdname, z2d)
1495	CHARACTER(LEN=*), INTENT(in ) :: cdname
1496	REAL(wp), DIMENSION(jpi,jpj) :: z2d
1497	#if defined key_xios
1498	IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN
1499	z2d(:,:) = 0._wp
1500	CALL xios_recv_field( cdname, z2d)
1501	ENDIF
1502	#else
1503	IF( .FALSE. ) WRITE(numout,*) cdname, z2d ! useless test to avoid compilation warnings
1504	#endif
1505	END SUBROUTINE iom_get_var
1506
1507
1508	FUNCTION iom_getszuld ( kiomid )
1509	!!-----------------------------------------------------------------------
1510	!! * FUNCTION iom_getszuld *
1511	!!
1512	!! ** Purpose : get the size of the unlimited dimension in a file
1513	!! (return -1 if not found)
1514	!!-----------------------------------------------------------------------
1515	INTEGER, INTENT(in ) :: kiomid ! file Identifier
1516	!
1517	INTEGER :: iom_getszuld
1518	!!-----------------------------------------------------------------------
1519	iom_getszuld = -1
1520	IF( kiomid > 0 ) THEN
1521	IF( iom_file(kiomid)%iduld > 0 ) iom_getszuld = iom_file(kiomid)%lenuld
1522	ENDIF
1523	END FUNCTION iom_getszuld
1524
1525
1526	!!----------------------------------------------------------------------
1527	!! INTERFACE iom_chkatt
1528	!!----------------------------------------------------------------------
1529	SUBROUTINE iom_chkatt( kiomid, cdatt, llok, ksize, cdvar )
1530	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1531	CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute
1532	LOGICAL , INTENT( out) :: llok ! Error code
1533	INTEGER , INTENT( out), OPTIONAL :: ksize ! Size of the attribute array
1534	CHARACTER(len=*), INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1535	!
1536	IF( kiomid > 0 ) THEN
1537	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_chkatt( kiomid, cdatt, llok, ksize=ksize, cdvar=cdvar )
1538	ENDIF
1539	!
1540	END SUBROUTINE iom_chkatt
1541
1542	!!----------------------------------------------------------------------
1543	!! INTERFACE iom_getatt
1544	!!----------------------------------------------------------------------
1545	SUBROUTINE iom_g0d_iatt( kiomid, cdatt, katt0d, cdvar )
1546	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1547	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1548	INTEGER , INTENT( out) :: katt0d ! read field
1549	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1550	!
1551	IF( kiomid > 0 ) THEN
1552	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, katt0d = katt0d, cdvar=cdvar )
1553	ENDIF
1554	END SUBROUTINE iom_g0d_iatt
1555
1556	SUBROUTINE iom_g1d_iatt( kiomid, cdatt, katt1d, cdvar )
1557	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1558	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1559	INTEGER, DIMENSION(:) , INTENT( out) :: katt1d ! read field
1560	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1561	!
1562	IF( kiomid > 0 ) THEN
1563	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, katt1d = katt1d, cdvar=cdvar )
1564	ENDIF
1565	END SUBROUTINE iom_g1d_iatt
1566
1567	SUBROUTINE iom_g0d_ratt( kiomid, cdatt, patt0d, cdvar )
1568	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1569	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1570	REAL(wp) , INTENT( out) :: patt0d ! read field
1571	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1572	!
1573	IF( kiomid > 0 ) THEN
1574	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, patt0d = patt0d, cdvar=cdvar )
1575	ENDIF
1576	END SUBROUTINE iom_g0d_ratt
1577
1578	SUBROUTINE iom_g1d_ratt( kiomid, cdatt, patt1d, cdvar )
1579	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1580	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1581	REAL(wp), DIMENSION(:), INTENT( out) :: patt1d ! read field
1582	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1583	!
1584	IF( kiomid > 0 ) THEN
1585	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, patt1d = patt1d, cdvar=cdvar )
1586	ENDIF
1587	END SUBROUTINE iom_g1d_ratt
1588
1589	SUBROUTINE iom_g0d_catt( kiomid, cdatt, cdatt0d, cdvar )
1590	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1591	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1592	CHARACTER(len=*) , INTENT( out) :: cdatt0d ! read field
1593	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1594	!
1595	IF( kiomid > 0 ) THEN
1596	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_getatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
1597	ENDIF
1598	END SUBROUTINE iom_g0d_catt
1599
1600
1601	!!----------------------------------------------------------------------
1602	!! INTERFACE iom_putatt
1603	!!----------------------------------------------------------------------
1604	SUBROUTINE iom_p0d_iatt( kiomid, cdatt, katt0d, cdvar )
1605	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1606	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1607	INTEGER , INTENT(in ) :: katt0d ! written field
1608	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1609	!
1610	IF( kiomid > 0 ) THEN
1611	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, katt0d = katt0d, cdvar=cdvar )
1612	ENDIF
1613	END SUBROUTINE iom_p0d_iatt
1614
1615	SUBROUTINE iom_p1d_iatt( kiomid, cdatt, katt1d, cdvar )
1616	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1617	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1618	INTEGER, DIMENSION(:) , INTENT(in ) :: katt1d ! written field
1619	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1620	!
1621	IF( kiomid > 0 ) THEN
1622	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, katt1d = katt1d, cdvar=cdvar )
1623	ENDIF
1624	END SUBROUTINE iom_p1d_iatt
1625
1626	SUBROUTINE iom_p0d_ratt( kiomid, cdatt, patt0d, cdvar )
1627	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1628	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1629	REAL(wp) , INTENT(in ) :: patt0d ! written field
1630	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1631	!
1632	IF( kiomid > 0 ) THEN
1633	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, patt0d = patt0d, cdvar=cdvar )
1634	ENDIF
1635	END SUBROUTINE iom_p0d_ratt
1636
1637	SUBROUTINE iom_p1d_ratt( kiomid, cdatt, patt1d, cdvar )
1638	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1639	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1640	REAL(wp), DIMENSION(:), INTENT(in ) :: patt1d ! written field
1641	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1642	!
1643	IF( kiomid > 0 ) THEN
1644	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, patt1d = patt1d, cdvar=cdvar )
1645	ENDIF
1646	END SUBROUTINE iom_p1d_ratt
1647
1648	SUBROUTINE iom_p0d_catt( kiomid, cdatt, cdatt0d, cdvar )
1649	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1650	CHARACTER(len=*) , INTENT(in ) :: cdatt ! Name of the attribute
1651	CHARACTER(len=*) , INTENT(in ) :: cdatt0d ! written field
1652	CHARACTER(len=*) , INTENT(in ), OPTIONAL :: cdvar ! Name of the variable
1653	!
1654	IF( kiomid > 0 ) THEN
1655	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_nf90_putatt( kiomid, cdatt, cdatt0d = cdatt0d, cdvar=cdvar )
1656	ENDIF
1657	END SUBROUTINE iom_p0d_catt
1658
1659
1660	!!----------------------------------------------------------------------
1661	!! INTERFACE iom_rstput
1662	!!----------------------------------------------------------------------
1663	SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1664	INTEGER , INTENT(in) :: kt ! ocean time-step
1665	INTEGER , INTENT(in) :: kwrite ! writing time-step
1666	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1667	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1668	REAL(sp) , INTENT(in) :: pvar ! written field
1669	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1670	!
1671	LOGICAL :: llx ! local xios write flag
1672	INTEGER :: ivid ! variable id
1673	CHARACTER(LEN=lc) :: context
1674	!
1675	CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp0d = pvar )
1676	!
1677	END SUBROUTINE iom_rp0d_sp
1678
1679	SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1680	INTEGER , INTENT(in) :: kt ! ocean time-step
1681	INTEGER , INTENT(in) :: kwrite ! writing time-step
1682	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1683	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1684	REAL(dp) , INTENT(in) :: pvar ! written field
1685	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1686	!
1687	LOGICAL :: llx ! local xios write flag
1688	INTEGER :: ivid ! variable id
1689	CHARACTER(LEN=lc) :: context
1690	!
1691	CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvdp0d = pvar )
1692	!
1693	END SUBROUTINE iom_rp0d_dp
1694
1695
1696	SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1697	INTEGER , INTENT(in) :: kt ! ocean time-step
1698	INTEGER , INTENT(in) :: kwrite ! writing time-step
1699	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1700	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1701	REAL(sp) , INTENT(in), DIMENSION( :) :: pvar ! written field
1702	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1703	!
1704	LOGICAL :: llx ! local xios write flag
1705	INTEGER :: ivid ! variable id
1706	CHARACTER(LEN=lc) :: context
1707	!
1708	CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp1d = pvar )
1709	!
1710	END SUBROUTINE iom_rp1d_sp
1711
1712	SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1713	INTEGER , INTENT(in) :: kt ! ocean time-step
1714	INTEGER , INTENT(in) :: kwrite ! writing time-step
1715	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1716	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1717	REAL(dp) , INTENT(in), DIMENSION( :) :: pvar ! written field
1718	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1719	!
1720	LOGICAL :: llx ! local xios write flag
1721	INTEGER :: ivid ! variable id
1722	CHARACTER(LEN=lc) :: context
1723	!
1724	CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvdp1d = pvar )
1725	!
1726	END SUBROUTINE iom_rp1d_dp
1727
1728
1729	SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1730	INTEGER , INTENT(in) :: kt ! ocean time-step
1731	INTEGER , INTENT(in) :: kwrite ! writing time-step
1732	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1733	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1734	REAL(sp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field
1735	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1736	!
1737	LOGICAL :: llx
1738	INTEGER :: ivid ! variable id
1739	CHARACTER(LEN=lc) :: context
1740	!
1741	CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp2d = pvar )
1742	!
1743	END SUBROUTINE iom_rp2d_sp
1744
1745	SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1746	INTEGER , INTENT(in) :: kt ! ocean time-step
1747	INTEGER , INTENT(in) :: kwrite ! writing time-step
1748	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1749	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1750	REAL(dp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field
1751	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1752	!
1753	LOGICAL :: llx
1754	INTEGER :: ivid ! variable id
1755	CHARACTER(LEN=lc) :: context
1756	!
1757	CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvdp2d = pvar )
1758	!
1759	END SUBROUTINE iom_rp2d_dp
1760
1761
1762	SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1763	INTEGER , INTENT(in) :: kt ! ocean time-step
1764	INTEGER , INTENT(in) :: kwrite ! writing time-step
1765	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1766	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1767	REAL(sp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field
1768	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1769	!
1770	LOGICAL :: llx ! local xios write flag
1771	INTEGER :: ivid ! variable id
1772	CHARACTER(LEN=lc) :: context
1773	!
1774	CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp3d = pvar )
1775	!
1776	END SUBROUTINE iom_rp3d_sp
1777
1778	SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype )
1779	INTEGER , INTENT(in) :: kt ! ocean time-step
1780	INTEGER , INTENT(in) :: kwrite ! writing time-step
1781	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1782	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1783	REAL(dp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field
1784	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1785	!
1786	LOGICAL :: llx ! local xios write flag
1787	INTEGER :: ivid ! variable id
1788	CHARACTER(LEN=lc) :: context
1789	!
1790	CALL iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvdp3d = pvar )
1791	!
1792	END SUBROUTINE iom_rp3d_dp
1793
1794	SUBROUTINE iom_rp0123d( kt, kwrite, kiomid, cdvar, ktype, pvsp0d, pvsp1d, pvsp2d, pvsp3d, pvdp0d, pvdp1d, pvdp2d, pvdp3d )
1795	INTEGER , INTENT(in) :: kt ! ocean time-step
1796	INTEGER , INTENT(in) :: kwrite ! writing time-step
1797	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1798	CHARACTER(len=*) , INTENT(in) :: cdvar ! time axis name
1799	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1800	REAL(sp) , INTENT(in), OPTIONAL :: pvsp0d ! read field (0D case), single precision
1801	REAL(sp), DIMENSION(:) , INTENT(in), OPTIONAL :: pvsp1d ! read field (1D case), single precision
1802	REAL(sp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: pvsp2d ! read field (2D case), single precision
1803	REAL(sp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: pvsp3d ! read field (3D case), single precision
1804	REAL(dp) , INTENT(in), OPTIONAL :: pvdp0d ! read field (0D case), double precision
1805	REAL(dp), DIMENSION(:) , INTENT(in), OPTIONAL :: pvdp1d ! read field (1D case), double precision
1806	REAL(dp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: pvdp2d ! read field (2D case), double precision
1807	REAL(dp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: pvdp3d ! read field (3D case), double precision
1808	!
1809	LOGICAL :: llx ! local xios write flag
1810	INTEGER :: ivid ! variable id
1811	CHARACTER(LEN=lc) :: context
1812	!
1813	CALL set_xios_context(kiomid, context)
1814
1815	llx = .NOT. (context == "NONE")
1816
1817	IF( llx ) THEN
1818	#ifdef key_xios
1819	IF( kt == kwrite ) THEN
1820	IF(lwp) write(numout,*) 'RESTART: write (XIOS) ',TRIM(cdvar)
1821	CALL iom_swap(context)
1822	IF( PRESENT(pvsp0d) ) CALL iom_put(TRIM(cdvar), pvsp0d)
1823	IF( PRESENT(pvsp1d) ) CALL iom_put(TRIM(cdvar), pvsp1d)
1824	IF( PRESENT(pvsp2d) ) CALL iom_put(TRIM(cdvar), pvsp2d)
1825	IF( PRESENT(pvsp3d) ) CALL iom_put(TRIM(cdvar), pvsp3d)
1826	IF( PRESENT(pvdp0d) ) CALL iom_put(TRIM(cdvar), pvdp0d)
1827	IF( PRESENT(pvdp1d) ) CALL iom_put(TRIM(cdvar), pvdp1d)
1828	IF( PRESENT(pvdp2d) ) CALL iom_put(TRIM(cdvar), pvdp2d)
1829	IF( PRESENT(pvdp3d) ) CALL iom_put(TRIM(cdvar), pvdp3d)
1830	CALL iom_swap(cxios_context)
1831	ELSE
1832	IF(lwp) write(numout,*) 'RESTART: define (XIOS)',TRIM(cdvar)
1833	CALL iom_swap(context)
1834	CALL iom_set_rstw_active( TRIM(cdvar), rs0 = pvsp0d, rs1 = pvsp1d, rs2 = pvsp2d, rs3 = pvsp3d &
1835	& , rd0 = pvdp0d, rd1 = pvdp1d, rd2 = pvdp2d, rd3 = pvdp3d )
1836	CALL iom_swap(cxios_context)
1837	ENDIF
1838	#endif
1839	ELSE
1840	IF( kiomid > 0 ) THEN
1841	IF( iom_file(kiomid)%nfid > 0 ) THEN
1842	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1843	CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pvsp0d, pvsp1d, pvsp2d, pvsp3d, &
1844	& pvdp0d, pvdp1d, pvdp2d, pvdp3d )
1845	ENDIF
1846	ENDIF
1847	ENDIF
1848	END SUBROUTINE iom_rp0123d
1849
1850
1851	SUBROUTINE iom_delay_rst( cdaction, cdcpnt, kncid )
1852	!!---------------------------------------------------------------------
1853	!! Routine iom_delay_rst: used read/write restart related to mpp_delay
1854	!!
1855	!!---------------------------------------------------------------------
1856	CHARACTER(len=*), INTENT(in ) :: cdaction !
1857	CHARACTER(len=*), INTENT(in ) :: cdcpnt
1858	INTEGER , INTENT(in ) :: kncid
1859	!
1860	INTEGER :: ji
1861	INTEGER :: indim
1862	LOGICAL :: llattexist
1863	REAL(wp), ALLOCATABLE, DIMENSION(:) :: zreal1d
1864	!!---------------------------------------------------------------------
1865	!
1866	! ===================================
1867	IF( TRIM(cdaction) == 'READ' ) THEN ! read restart related to mpp_delay !
1868	! ===================================
1869	DO ji = 1, nbdelay
1870	IF ( c_delaycpnt(ji) == cdcpnt ) THEN
1871	CALL iom_chkatt( kncid, 'DELAY_'//c_delaylist(ji), llattexist, indim )
1872	IF( llattexist ) THEN
1873	ALLOCATE( todelay(ji)%z1d(indim) )
1874	CALL iom_getatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
1875	ndelayid(ji) = 0 ! set to 0 to specify that the value was read in the restart
1876	ENDIF
1877	ENDIF
1878	END DO
1879	! ====================================
1880	ELSE ! write restart related to mpp_delay !
1881	! ====================================
1882	DO ji = 1, nbdelay ! save only ocean delayed global communication variables
1883	IF ( c_delaycpnt(ji) == cdcpnt ) THEN
1884	IF( ASSOCIATED(todelay(ji)%z1d) ) THEN
1885	CALL mpp_delay_rcv(ji) ! make sure %z1d is received
1886	CALL iom_putatt( kncid, 'DELAY_'//c_delaylist(ji), todelay(ji)%z1d(:) )
1887	ENDIF
1888	ENDIF
1889	END DO
1890	!
1891	ENDIF
1892
1893	END SUBROUTINE iom_delay_rst
1894
1895
1896
1897	!!----------------------------------------------------------------------
1898	!! INTERFACE iom_put
1899	!!----------------------------------------------------------------------
1900	SUBROUTINE iom_p0d_sp( cdname, pfield0d )
1901	CHARACTER(LEN=*), INTENT(in) :: cdname
1902	REAL(sp) , INTENT(in) :: pfield0d
1903	!! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson
1904	#if defined key_xios
1905	!!clem zz(:,:)=pfield0d
1906	!!clem CALL xios_send_field(cdname, zz)
1907	CALL xios_send_field(cdname, (/pfield0d/))
1908	#else
1909	IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings
1910	#endif
1911	END SUBROUTINE iom_p0d_sp
1912
1913	SUBROUTINE iom_p0d_dp( cdname, pfield0d )
1914	CHARACTER(LEN=*), INTENT(in) :: cdname
1915	REAL(dp) , INTENT(in) :: pfield0d
1916	!! REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson
1917	#if defined key_xios
1918	!!clem zz(:,:)=pfield0d
1919	!!clem CALL xios_send_field(cdname, zz)
1920	CALL xios_send_field(cdname, (/pfield0d/))
1921	#else
1922	IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings
1923	#endif
1924	END SUBROUTINE iom_p0d_dp
1925
1926
1927	SUBROUTINE iom_p1d_sp( cdname, pfield1d )
1928	CHARACTER(LEN=*) , INTENT(in) :: cdname
1929	REAL(sp), DIMENSION(:), INTENT(in) :: pfield1d
1930	#if defined key_xios
1931	CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
1932	#else
1933	IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings
1934	#endif
1935	END SUBROUTINE iom_p1d_sp
1936
1937	SUBROUTINE iom_p1d_dp( cdname, pfield1d )
1938	CHARACTER(LEN=*) , INTENT(in) :: cdname
1939	REAL(dp), DIMENSION(:), INTENT(in) :: pfield1d
1940	#if defined key_xios
1941	CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
1942	#else
1943	IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings
1944	#endif
1945	END SUBROUTINE iom_p1d_dp
1946
1947	SUBROUTINE iom_p2d_sp( cdname, pfield2d )
1948	CHARACTER(LEN=*) , INTENT(in) :: cdname
1949	REAL(sp), DIMENSION(:,:), INTENT(in) :: pfield2d
1950	IF( iom_use(cdname) ) THEN
1951	#if defined key_xios
1952	IF( is_tile(pfield2d) == 1 ) THEN
1953	ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
1954	CALL xios_send_field( cdname, pfield2d )
1955	ENDIF
1956	#else
1957	WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
1958	#endif
1959	ENDIF
1960	END SUBROUTINE iom_p2d_sp
1961
1962	SUBROUTINE iom_p2d_dp( cdname, pfield2d )
1963	CHARACTER(LEN=*) , INTENT(in) :: cdname
1964	REAL(dp), DIMENSION(:,:), INTENT(in) :: pfield2d
1965	IF( iom_use(cdname) ) THEN
1966	#if defined key_xios
1967	IF( is_tile(pfield2d) == 1 ) THEN
1968	ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
1969	CALL xios_send_field( cdname, pfield2d )
1970	ENDIF
1971	#else
1972	WRITE(numout,*) pfield2d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
1973	#endif
1974	ENDIF
1975	END SUBROUTINE iom_p2d_dp
1976
1977	SUBROUTINE iom_p3d_sp( cdname, pfield3d )
1978	CHARACTER(LEN=*) , INTENT(in) :: cdname
1979	REAL(sp), DIMENSION(:,:,:), INTENT(in) :: pfield3d
1980	IF( iom_use(cdname) ) THEN
1981	#if defined key_xios
1982	IF( is_tile(pfield3d) == 1 ) THEN
1983	ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
1984	CALL xios_send_field( cdname, pfield3d )
1985	ENDIF
1986	#else
1987	WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
1988	#endif
1989	ENDIF
1990	END SUBROUTINE iom_p3d_sp
1991
1992	SUBROUTINE iom_p3d_dp( cdname, pfield3d )
1993	CHARACTER(LEN=*) , INTENT(in) :: cdname
1994	REAL(dp), DIMENSION(:,:,:), INTENT(in) :: pfield3d
1995	IF( iom_use(cdname) ) THEN
1996	#if defined key_xios
1997	IF( is_tile(pfield3d) == 1 ) THEN
1998	ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
1999	CALL xios_send_field( cdname, pfield3d )
2000	ENDIF
2001	#else
2002	WRITE(numout,*) pfield3d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
2003	#endif
2004	ENDIF
2005	END SUBROUTINE iom_p3d_dp
2006
2007	SUBROUTINE iom_p4d_sp( cdname, pfield4d )
2008	CHARACTER(LEN=*) , INTENT(in) :: cdname
2009	REAL(sp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d
2010	IF( iom_use(cdname) ) THEN
2011	#if defined key_xios
2012	IF( is_tile(pfield4d) == 1 ) THEN
2013	ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
2014	CALL xios_send_field( cdname, pfield4d )
2015	ENDIF
2016	#else
2017	WRITE(numout,*) pfield4d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
2018	#endif
2019	ENDIF
2020	END SUBROUTINE iom_p4d_sp
2021
2022	SUBROUTINE iom_p4d_dp( cdname, pfield4d )
2023	CHARACTER(LEN=*) , INTENT(in) :: cdname
2024	REAL(dp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d
2025	IF( iom_use(cdname) ) THEN
2026	#if defined key_xios
2027	IF( is_tile(pfield4d) == 1 ) THEN
2028	ELSE IF( .NOT. l_istiled .OR. ntile == nijtile ) THEN
2029	CALL xios_send_field( cdname, pfield4d )
2030	ENDIF
2031	#else
2032	WRITE(numout,*) pfield4d ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings
2033	#endif
2034	ENDIF
2035	END SUBROUTINE iom_p4d_dp
2036
2037	#if defined key_xios
2038	!!----------------------------------------------------------------------
2039	!! 'key_xios' XIOS interface
2040	!!----------------------------------------------------------------------
2041
2042	SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, &
2043	& data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, &
2044	& ntiles, tile_ibegin, tile_jbegin, tile_ni, tile_nj, &
2045	& tile_data_ibegin, tile_data_jbegin, tile_data_ni, tile_data_nj, &
2046	& nvertex, bounds_lon, bounds_lat, area )
2047	!!----------------------------------------------------------------------
2048	!!----------------------------------------------------------------------
2049	CHARACTER(LEN=*) , INTENT(in) :: cdid
2050	INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj
2051	INTEGER, DIMENSION(:) , OPTIONAL, INTENT(in) :: tile_ibegin, tile_jbegin, tile_ni, tile_nj
2052	INTEGER, DIMENSION(:) , OPTIONAL, INTENT(in) :: tile_data_ibegin, tile_data_jbegin, tile_data_ni, tile_data_nj
2053	INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj
2054	INTEGER , OPTIONAL, INTENT(in) :: nvertex, ntiles
2055	REAL(dp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue
2056	REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area
2057	LOGICAL , DIMENSION(:) , OPTIONAL, INTENT(in) :: mask
2058	!!----------------------------------------------------------------------
2059	!
2060	IF( xios_is_valid_domain (cdid) ) THEN
2061	CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
2062	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
2063	& lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, &
2064	& bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
2065	ENDIF
2066	IF( xios_is_valid_domaingroup(cdid) ) THEN
2067	CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
2068	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
2069	& lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, &
2070	& bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
2071	ENDIF
2072	!
2073	CALL xios_solve_inheritance()
2074	!
2075	END SUBROUTINE iom_set_domain_attr
2076
2077
2078	SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj )
2079	!!----------------------------------------------------------------------
2080	!!----------------------------------------------------------------------
2081	CHARACTER(LEN=*), INTENT(in) :: cdid
2082	INTEGER , INTENT(in) :: ibegin, jbegin, ni, nj
2083	!
2084	TYPE(xios_gridgroup) :: gridgroup_hdl
2085	TYPE(xios_grid) :: grid_hdl
2086	TYPE(xios_domain) :: domain_hdl
2087	TYPE(xios_axis) :: axis_hdl
2088	CHARACTER(LEN=64) :: cldomrefid ! domain_ref name
2089	CHARACTER(len=1) :: cl1 ! last character of this name
2090	!!----------------------------------------------------------------------
2091	!
2092	IF( xios_is_valid_zoom_domain(cdid) ) THEN
2093	! define the zoom_domain attributs
2094	CALL xios_set_zoom_domain_attr( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj )
2095	! define a new 2D grid with this new domain
2096	CALL xios_get_handle("grid_definition", gridgroup_hdl )
2097	CALL xios_add_child(gridgroup_hdl, grid_hdl, TRIM(cdid)//'_2D' ) ! add a new 2D grid to grid_definition
2098	CALL xios_add_child(grid_hdl, domain_hdl, TRIM(cdid) ) ! add its domain
2099	! define a new 3D grid with this new domain
2100	CALL xios_add_child(gridgroup_hdl, grid_hdl, TRIM(cdid)//'_3D' ) ! add a new 3D grid to grid_definition
2101	CALL xios_add_child(grid_hdl, domain_hdl, TRIM(cdid) ) ! add its domain
2102	! vertical axis
2103	cl1 = cdid(LEN_TRIM(cdid):) ! last letter of cdid
2104	cl1 = CHAR(ICHAR(cl1)+32) ! from upper to lower case
2105	CALL xios_add_child(grid_hdl, axis_hdl, 'depth'//cl1) ! add its axis
2106	ENDIF
2107	!
2108	END SUBROUTINE iom_set_zoom_domain_attr
2109
2110
2111	SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
2112	!!----------------------------------------------------------------------
2113	!!----------------------------------------------------------------------
2114	CHARACTER(LEN=*) , INTENT(in) :: cdid
2115	REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis
2116	REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds
2117	!!----------------------------------------------------------------------
2118	IF( PRESENT(paxis) ) THEN
2119	IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) )
2120	IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) )
2121	ENDIF
2122	IF( PRESENT(bounds) ) THEN
2123	IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=real(bounds, dp) )
2124	IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=real(bounds, dp) )
2125	ELSE
2126	IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid)
2127	IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid)
2128	END IF
2129	CALL xios_solve_inheritance()
2130	END SUBROUTINE iom_set_axis_attr
2131
2132
2133	SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
2134	!!----------------------------------------------------------------------
2135	!!----------------------------------------------------------------------
2136	CHARACTER(LEN=*) , INTENT(in) :: cdid
2137	TYPE(xios_duration), OPTIONAL, INTENT(in) :: freq_op
2138	TYPE(xios_duration), OPTIONAL, INTENT(in) :: freq_offset
2139	!!----------------------------------------------------------------------
2140	IF( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset )
2141	IF( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset )
2142	CALL xios_solve_inheritance()
2143	END SUBROUTINE iom_set_field_attr
2144
2145
2146	SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
2147	!!----------------------------------------------------------------------
2148	!!----------------------------------------------------------------------
2149	CHARACTER(LEN=*) , INTENT(in) :: cdid
2150	CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix
2151	!!----------------------------------------------------------------------
2152	IF( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix )
2153	IF( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
2154	CALL xios_solve_inheritance()
2155	END SUBROUTINE iom_set_file_attr
2156
2157
2158	SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
2159	!!----------------------------------------------------------------------
2160	!!----------------------------------------------------------------------
2161	CHARACTER(LEN=*) , INTENT(in ) :: cdid
2162	CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix
2163	TYPE(xios_duration), OPTIONAL , INTENT(out) :: output_freq
2164	LOGICAL :: llexist1,llexist2,llexist3
2165	!---------------------------------------------------------------------
2166	IF( PRESENT( name ) ) name = '' ! default values
2167	IF( PRESENT( name_suffix ) ) name_suffix = ''
2168	IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0)
2169	IF( xios_is_valid_file (cdid) ) THEN
2170	CALL xios_solve_inheritance()
2171	CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
2172	IF(llexist1) CALL xios_get_file_attr ( cdid, name = name )
2173	IF(llexist2) CALL xios_get_file_attr ( cdid, name_suffix = name_suffix )
2174	IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq )
2175	ENDIF
2176	IF( xios_is_valid_filegroup(cdid) ) THEN
2177	CALL xios_solve_inheritance()
2178	CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
2179	IF(llexist1) CALL xios_get_filegroup_attr( cdid, name = name )
2180	IF(llexist2) CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
2181	IF(llexist3) CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
2182	ENDIF
2183	END SUBROUTINE iom_get_file_attr
2184
2185
2186	SUBROUTINE iom_set_grid_attr( cdid, mask )
2187	!!----------------------------------------------------------------------
2188	!!----------------------------------------------------------------------
2189	CHARACTER(LEN=*) , INTENT(in) :: cdid
2190	LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask
2191	!!----------------------------------------------------------------------
2192	IF( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask )
2193	IF( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask )
2194	CALL xios_solve_inheritance()
2195	END SUBROUTINE iom_set_grid_attr
2196
2197	SUBROUTINE iom_setkt( kt, cdname )
2198	!!----------------------------------------------------------------------
2199	!!----------------------------------------------------------------------
2200	INTEGER , INTENT(in) :: kt
2201	CHARACTER(LEN=*), INTENT(in) :: cdname
2202	!!----------------------------------------------------------------------
2203	CALL iom_swap( cdname ) ! swap to cdname context
2204	CALL xios_update_calendar(kt)
2205	IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( cxios_context ) ! return back to nemo context
2206	END SUBROUTINE iom_setkt
2207
2208	SUBROUTINE iom_context_finalize( cdname )
2209	!!----------------------------------------------------------------------
2210	!!----------------------------------------------------------------------
2211	CHARACTER(LEN=*), INTENT(in) :: cdname
2212	CHARACTER(LEN=120) :: clname
2213	CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode)
2214	INTEGER :: iln
2215	!!----------------------------------------------------------------------
2216	clname = TRIM(cdname)
2217	IF ( .NOT. Agrif_Root() ) THEN
2218	iln = INDEX(clname,'/', BACK=.TRUE.)
2219	cltmpn = clname(1:iln)
2220	clname = clname(iln+1:LEN_TRIM(clname))
2221	clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
2222	ENDIF
2223
2224	IF( xios_is_valid_context(clname) ) THEN
2225	CALL iom_swap( cdname ) ! swap to cdname context
2226	CALL xios_context_finalize() ! finalize the context
2227	IF( cdname /= cxios_context ) CALL iom_swap( cxios_context ) ! return back to nemo context
2228	ENDIF
2229	!
2230	END SUBROUTINE iom_context_finalize
2231
2232
2233	SUBROUTINE set_grid( cdgrd, plon, plat, ldxios, ldrxios )
2234	!!----------------------------------------------------------------------
2235	!! * ROUTINE set_grid *
2236	!!
2237	!! ** Purpose : define horizontal grids
2238	!!----------------------------------------------------------------------
2239	CHARACTER(LEN=1) , INTENT(in) :: cdgrd
2240	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon
2241	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
2242	!
2243	REAL(wp), DIMENSION(A2D(0),jpk) :: zmask
2244	INTEGER :: jn
2245	INTEGER, DIMENSION(nijtile) :: ini, inj, idb
2246	LOGICAL, INTENT(IN) :: ldxios, ldrxios
2247	!!----------------------------------------------------------------------
2248	!
2249	! nn_hls halo points
2250	CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0)
2251	CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = -nn_hls, data_ni=jpi, data_jbegin = -nn_hls, data_nj=jpj)
2252
2253	! Inner domain only
2254	CALL iom_set_domain_attr("grid_"//cdgrd//"_inner", ni_glo = Ni0glo, nj_glo = Nj0glo, &
2255	& ibegin = mig0(Nis0) - 1, jbegin = mjg0(Njs0) - 1, ni = Ni_0, nj = Nj_0)
2256	CALL iom_set_domain_attr("grid_"//cdgrd//"_inner", data_dim=2, data_ibegin = 0, data_ni=Ni_0, data_jbegin = 0, data_nj=Nj_0)
2257
2258	IF( ln_tile ) THEN
2259	DO jn = 1, nijtile
2260	ini(jn) = ntei_a(jn) - ntsi_a(jn) + 1 ! Tile size in i and j
2261	inj(jn) = ntej_a(jn) - ntsj_a(jn) + 1
2262	idb(jn) = -nn_hls ! Tile data offset (halo size)
2263	END DO
2264
2265	! Data includes all halo points
2266	CALL iom_set_domain_attr("grid_"//cdgrd, ntiles=nijtile, &
2267	& tile_ibegin=ntsi_a(1:nijtile) - nn_hls - 1, tile_jbegin=ntsj_a(1:nijtile) - nn_hls - 1, &
2268	& tile_ni=ini(:), tile_nj=inj(:), &
2269	& tile_data_ibegin=idb(:), tile_data_jbegin=idb(:), &
2270	& tile_data_ni=ini(:) - 2 * idb(:), tile_data_nj=inj(:) - 2 * idb(:))
2271	! Data contains no halo points
2272	idb(:) = 0
2273	CALL iom_set_domain_attr("grid_"//cdgrd//"_inner", ntiles=nijtile, &
2274	& tile_ibegin=ntsi_a(1:nijtile) - nn_hls - 1, tile_jbegin=ntsj_a(1:nijtile) - nn_hls - 1, &
2275	& tile_ni=ini(:), tile_nj=inj(:), &
2276	& tile_data_ibegin=idb(:), tile_data_jbegin=idb(:), &
2277	& tile_data_ni=ini(:) - 2 * idb(:), tile_data_nj=inj(:) - 2 * idb(:))
2278	ENDIF
2279
2280	!don't define lon and lat for restart reading context.
2281	IF ( .NOT.ldrxios ) &
2282	CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp), &
2283	& latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp ))
2284	!
2285	IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN
2286	! mask land points, keep values on coast line -> specific mask for U, V and W points
2287	SELECT CASE ( cdgrd )
2288	CASE('T') ; zmask(:,:,:) = tmask(Nis0 :Nie0 , Njs0:Nje0,:)
2289	CASE('U') ; zmask(:,:,:) = tmask(Nis0 :Nie0 , Njs0:Nje0,:) + tmask(Nis0+1:Nie0+1, Njs0 :Nje0 ,:)
2290	CASE('V') ; zmask(:,:,:) = tmask(Nis0 :Nie0 , Njs0:Nje0,:) + tmask(Nis0 :Nie0 , Njs0+1:Nje0+1,:)
2291	CASE('F') ; zmask(:,:,:) = tmask(Nis0 :Nie0 , Njs0:Nje0,:) + tmask(Nis0 :Nie0 , Njs0+1:Nje0+1,:) &
2292	& + tmask(Nis0+1:Nie0+1, Njs0:Nje0,:) + tmask(Nis0+1:Nie0+1, Njs0+1:Nje0+1,:)
2293	CASE('W') ; zmask(:,:,2:jpk) = tmask(Nis0:Nie0, Njs0:Nje0,1:jpkm1) + tmask(Nis0:Nie0, Njs0:Nje0,2:jpk)
2294	zmask(:,:,1 ) = tmask(Nis0:Nie0, Njs0:Nje0,1)
2295	END SELECT
2296	!
2297	CALL iom_set_domain_attr( "grid_"//cdgrd , mask=RESHAPE(zmask(:,:,1),(/Ni_0*Nj_0 /)) /= 0. )
2298	CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D" , mask=RESHAPE(zmask(:,:,:),(/Ni_0,Nj_0,jpk/)) /= 0. )
2299	CALL iom_set_domain_attr( "grid_"//cdgrd//"_inner" , mask=RESHAPE(zmask(:,:,1),(/Ni_0*Nj_0 /)) /= 0. )
2300	CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D_inner", mask=RESHAPE(zmask(:,:,:),(/Ni_0,Nj_0,jpk/)) /= 0. )
2301	ENDIF
2302	!
2303	END SUBROUTINE set_grid
2304
2305	SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
2306	!!----------------------------------------------------------------------
2307	!! * ROUTINE set_grid_bounds *
2308	!!
2309	!! ** Purpose : define horizontal grid corners
2310	!!
2311	!!----------------------------------------------------------------------
2312	CHARACTER(LEN=1) , INTENT(in) :: cdgrd
2313	REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coord. of a contiguous vertex of cell (i,j)
2314	REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j)
2315	!
2316	INTEGER :: ji, jj, jn
2317	INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
2318	! ! represents the
2319	! bottom-left corner of
2320	! cell (i,j)
2321	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j)
2322	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells
2323	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells
2324	!!----------------------------------------------------------------------
2325	!
2326	ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) )
2327	!
2328	! Offset of coordinate representing bottom-left corner
2329	SELECT CASE ( TRIM(cdgrd) )
2330	CASE ('T', 'W') ; icnr = -1 ; jcnr = -1
2331	CASE ('U') ; icnr = 0 ; jcnr = -1
2332	CASE ('V') ; icnr = -1 ; jcnr = 0
2333	CASE ('F') ; icnr = 0 ; jcnr = 0
2334	END SELECT
2335	!
2336	z_fld(:,:) = 1._wp
2337	CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp ) ! Working array for location of northfold
2338	!
2339	! Cell vertices that can be defined
2340	DO_2D( 0, 0, 0, 0 )
2341	z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left
2342	z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right
2343	z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
2344	z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left
2345	z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left
2346	z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right
2347	z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
2348	z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left
2349	END_2D
2350	!
2351	DO_2D( 0, 0, 0, 0 )
2352	IF( z_fld(ji,jj) == -1. ) THEN
2353	z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
2354	z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
2355	z_bnds(:,ji,jj,:) = z_rot(:,:)
2356	ENDIF
2357	END_2D
2358	!
2359	CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp), &
2360	& bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 )
2361	!
2362	DEALLOCATE( z_bnds, z_fld, z_rot )
2363	!
2364	END SUBROUTINE set_grid_bounds
2365
2366	SUBROUTINE set_grid_znl( plat )
2367	!!----------------------------------------------------------------------
2368	!! * ROUTINE set_grid_znl *
2369	!!
2370	!! ** Purpose : define grids for zonal mean
2371	!!
2372	!!----------------------------------------------------------------------
2373	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
2374	!
2375	INTEGER :: ix, iy
2376	REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon
2377	!!----------------------------------------------------------------------
2378	!
2379	ALLOCATE( zlon(Ni_0*Nj_0) ) ; zlon(:) = 0._wp
2380	!
2381	! CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots)
2382	CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)
2383	CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0)
2384	CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = -nn_hls, data_ni = jpi, data_jbegin = -nn_hls, data_nj = jpj)
2385	CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp), &
2386	& latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))
2387	CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj0glo)
2388	!
2389	CALL iom_update_file_name('ptr')
2390	!
2391	END SUBROUTINE set_grid_znl
2392
2393
2394	SUBROUTINE set_scalar
2395	!!----------------------------------------------------------------------
2396	!! * ROUTINE set_scalar *
2397	!!
2398	!! ** Purpose : define fake grids for scalar point
2399	!!
2400	!!----------------------------------------------------------------------
2401	REAL(dp), DIMENSION(1) :: zz = 1.
2402	!!----------------------------------------------------------------------
2403	!
2404	CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1)
2405	CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
2406	!
2407	zz = REAL( narea, wp )
2408	CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
2409	!
2410	END SUBROUTINE set_scalar
2411
2412
2413	SUBROUTINE set_xmlatt
2414	!!----------------------------------------------------------------------
2415	!! * ROUTINE set_xmlatt *
2416	!!
2417	!! ** Purpose : automatic definitions of some of the xml attributs...
2418	!!
2419	!!----------------------------------------------------------------------
2420	CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name
2421	CHARACTER(len=256) :: clsuff ! suffix name
2422	CHARACTER(len=1) :: cl1 ! 1 character
2423	CHARACTER(len=2) :: cl2 ! 2 characters
2424	CHARACTER(len=3) :: cl3 ! 3 characters
2425	INTEGER :: ji, jg ! loop counters
2426	INTEGER :: ix, iy ! i-,j- index
2427	REAL(wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings
2428	REAL(wp) ,DIMENSION( 7) :: zlattao ! latitudes of tao moorings
2429	REAL(wp) ,DIMENSION( 4) :: zlonrama ! longitudes of rama moorings
2430	REAL(wp) ,DIMENSION(11) :: zlatrama ! latitudes of rama moorings
2431	REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings
2432	REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings
2433	TYPE(xios_duration) :: f_op, f_of
2434	!!----------------------------------------------------------------------
2435	!
2436	! frequency of the call of iom_put (attribut: freq_op)
2437	f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
2438	f_op%timestep = 2 ; f_of%timestep = 0 ; CALL iom_set_field_attr('trendT_even' , freq_op=f_op, freq_offset=f_of)
2439	f_op%timestep = 2 ; f_of%timestep = -1 ; CALL iom_set_field_attr('trendT_odd' , freq_op=f_op, freq_offset=f_of)
2440	f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of)
2441	f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of)
2442	f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ABL' , freq_op=f_op, freq_offset=f_of)
2443	IF( ln_diadct ) THEN
2444	f_op%timestep = nn_dctwri ; f_of%timestep = 0 ; CALL iom_set_field_attr('DCT' , freq_op=f_op, freq_offset=f_of)
2445	ENDIF
2446
2447	! output file names (attribut: name)
2448	DO ji = 1, 9
2449	WRITE(cl1,'(i1)') ji
2450	CALL iom_update_file_name('file'//cl1)
2451	END DO
2452	DO ji = 1, 99
2453	WRITE(cl2,'(i2.2)') ji
2454	CALL iom_update_file_name('file'//cl2)
2455	END DO
2456	DO ji = 1, 999
2457	WRITE(cl3,'(i3.3)') ji
2458	CALL iom_update_file_name('file'//cl3)
2459	END DO
2460
2461	! Zooms...
2462	clgrd = (/ 'T', 'U', 'W' /)
2463	DO jg = 1, SIZE(clgrd) ! grid type
2464	cl1 = clgrd(jg)
2465	! Equatorial section (attributs: jbegin, ni, name_suffix)
2466	CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 )
2467	CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 )
2468	CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff )
2469	CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
2470	CALL iom_update_file_name('Eq'//cl1)
2471	END DO
2472	! TAO moorings (attributs: ibegin, jbegin, name_suffix)
2473	zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
2474	zlattao = (/ -8.0, -5.0, -2.0, 0.0, 2.0, 5.0, 8.0 /)
2475	CALL set_mooring( zlontao, zlattao )
2476	! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
2477	zlonrama = (/ 55.0, 67.0, 80.5, 90.0 /)
2478	zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
2479	CALL set_mooring( zlonrama, zlatrama )
2480	! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
2481	zlonpira = (/ -38.0, -23.0, -10.0 /)
2482	zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
2483	CALL set_mooring( zlonpira, zlatpira )
2484	!
2485	END SUBROUTINE set_xmlatt
2486
2487
2488	SUBROUTINE set_mooring( plon, plat )
2489	!!----------------------------------------------------------------------
2490	!! * ROUTINE set_mooring *
2491	!!
2492	!! ** Purpose : automatic definitions of moorings xml attributs...
2493	!!
2494	!!----------------------------------------------------------------------
2495	REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring
2496	!
2497	!!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name
2498	CHARACTER(len=1),DIMENSION(1) :: clgrd = (/ 'T' /) ! suffix name
2499	CHARACTER(len=256) :: clname ! file name
2500	CHARACTER(len=256) :: clsuff ! suffix name
2501	CHARACTER(len=1) :: cl1 ! 1 character
2502	CHARACTER(len=6) :: clon,clat ! name of longitude, latitude
2503	INTEGER :: ji, jj, jg ! loop counters
2504	INTEGER :: ix, iy ! i-,j- index
2505	REAL(wp) :: zlon, zlat
2506	!!----------------------------------------------------------------------
2507	DO jg = 1, SIZE(clgrd)
2508	cl1 = clgrd(jg)
2509	DO ji = 1, SIZE(plon)
2510	DO jj = 1, SIZE(plat)
2511	zlon = plon(ji)
2512	zlat = plat(jj)
2513	! modifications for RAMA moorings
2514	IF( zlon == 67. .AND. zlat == 15. ) zlon = 65.
2515	IF( zlon == 90. .AND. zlat <= -4. ) zlon = 95.
2516	IF( zlon == 95. .AND. zlat == -4. ) zlat = -5.
2517	! modifications for PIRATA moorings
2518	IF( zlon == -38. .AND. zlat == -19. ) zlon = -34.
2519	IF( zlon == -38. .AND. zlat == -14. ) zlon = -32.
2520	IF( zlon == -38. .AND. zlat == -8. ) zlon = -30.
2521	IF( zlon == -38. .AND. zlat == 0. ) zlon = -35.
2522	IF( zlon == -23. .AND. zlat == 20. ) zlat = 21.
2523	IF( zlon == -10. .AND. zlat == -14. ) zlat = -10.
2524	IF( zlon == -10. .AND. zlat == -8. ) zlat = -6.
2525	IF( zlon == -10. .AND. zlat == 4. ) THEN ; zlon = 0. ; zlat = 0. ; ENDIF
2526	CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
2527	IF( zlon >= 0. ) THEN
2528	IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT( zlon), 'e'
2529	ELSE ; WRITE(clon, '(f5.1,a)') zlon , 'e'
2530	ENDIF
2531	ELSE
2532	IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT(-zlon), 'w'
2533	ELSE ; WRITE(clon, '(f5.1,a)') -zlon , 'w'
2534	ENDIF
2535	ENDIF
2536	IF( zlat >= 0. ) THEN
2537	IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT( zlat), 'n'
2538	ELSE ; WRITE(clat, '(f4.1,a)') zlat , 'n'
2539	ENDIF
2540	ELSE
2541	IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT(-zlat), 's'
2542	ELSE ; WRITE(clat, '(f4.1,a)') -zlat , 's'
2543	ENDIF
2544	ENDIF
2545	clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
2546	CALL iom_set_zoom_domain_attr(TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1, ni=1, nj=1)
2547
2548	CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff )
2549	CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
2550	CALL iom_update_file_name(TRIM(clname)//cl1)
2551	END DO
2552	END DO
2553	END DO
2554
2555	END SUBROUTINE set_mooring
2556
2557
2558	SUBROUTINE iom_update_file_name( cdid )
2559	!!----------------------------------------------------------------------
2560	!! * ROUTINE iom_update_file_name *
2561	!!
2562	!! ** Purpose :
2563	!!
2564	!!----------------------------------------------------------------------
2565	CHARACTER(LEN=*) , INTENT(in) :: cdid
2566	!
2567	CHARACTER(LEN=256) :: clname, cltmpn
2568	CHARACTER(LEN=20) :: clfreq
2569	CHARACTER(LEN=20) :: cldate
2570	INTEGER :: idx
2571	INTEGER :: jn, iln
2572	INTEGER :: itrlen
2573	INTEGER :: iyear, imonth, iday, isec
2574	REAL(dp) :: zsec
2575	LOGICAL :: llexist
2576	TYPE(xios_duration) :: output_freq
2577	!!----------------------------------------------------------------------
2578	!
2579	DO jn = 1, 2
2580	!
2581	output_freq = xios_duration(0,0,0,0,0,0)
2582	IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq )
2583	IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname )
2584	!
2585	IF ( TRIM(clname) /= '' ) THEN
2586	!
2587	idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
2588	DO WHILE ( idx /= 0 )
2589	clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
2590	idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
2591	END DO
2592	!
2593	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
2594	DO WHILE ( idx /= 0 )
2595	IF ( output_freq%timestep /= 0) THEN
2596	WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts'
2597	itrlen = LEN_TRIM(ADJUSTL(clfreq))
2598	ELSE IF ( output_freq%second /= 0 ) THEN
2599	WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s'
2600	itrlen = LEN_TRIM(ADJUSTL(clfreq))
2601	ELSE IF ( output_freq%minute /= 0 ) THEN
2602	WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi'
2603	itrlen = LEN_TRIM(ADJUSTL(clfreq))
2604	ELSE IF ( output_freq%hour /= 0 ) THEN
2605	WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'
2606	itrlen = LEN_TRIM(ADJUSTL(clfreq))
2607	ELSE IF ( output_freq%day /= 0 ) THEN
2608	WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d'
2609	itrlen = LEN_TRIM(ADJUSTL(clfreq))
2610	ELSE IF ( output_freq%month /= 0 ) THEN
2611	WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m'
2612	itrlen = LEN_TRIM(ADJUSTL(clfreq))
2613	ELSE IF ( output_freq%year /= 0 ) THEN
2614	WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y'
2615	itrlen = LEN_TRIM(ADJUSTL(clfreq))
2616	ELSE
2617	CALL ctl_stop('error in the name of file id '//TRIM(cdid), &
2618	& ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
2619	ENDIF
2620	clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
2621	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
2622	END DO
2623	!
2624	idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
2625	DO WHILE ( idx /= 0 )
2626	cldate = iom_sdate( fjulday - rn_Dt / rday )
2627	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
2628	idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
2629	END DO
2630	!
2631	idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
2632	DO WHILE ( idx /= 0 )
2633	cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. )
2634	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
2635	idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
2636	END DO
2637	!
2638	idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
2639	DO WHILE ( idx /= 0 )
2640	cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
2641	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
2642	idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
2643	END DO
2644	!
2645	idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
2646	DO WHILE ( idx /= 0 )
2647	cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
2648	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
2649	idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
2650	END DO
2651	!
2652	IF( (jn ==1).AND.(.NOT. Agrif_Root())) THEN
2653	iln = INDEX(clname,'/', BACK=.TRUE.)
2654	cltmpn = clname(1:iln)
2655	clname = clname(iln+1:LEN_TRIM(clname))
2656	clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
2657	ENDIF
2658	IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname )
2659	IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname )
2660	!
2661	ENDIF
2662	!
2663	END DO
2664	!
2665	END SUBROUTINE iom_update_file_name
2666
2667
2668	FUNCTION iom_sdate( pjday, ld24, ldfull )
2669	!!----------------------------------------------------------------------
2670	!! * ROUTINE iom_sdate *
2671	!!
2672	!! ** Purpose : send back the date corresponding to the given julian day
2673	!!----------------------------------------------------------------------
2674	REAL(dp), INTENT(in ) :: pjday ! julian day
2675	LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00
2676	LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss
2677	!
2678	CHARACTER(LEN=20) :: iom_sdate
2679	CHARACTER(LEN=50) :: clfmt ! format used to write the date
2680	INTEGER :: iyear, imonth, iday, ihour, iminute, isec
2681	REAL(dp) :: zsec
2682	LOGICAL :: ll24, llfull
2683	!!----------------------------------------------------------------------
2684	!
2685	IF( PRESENT(ld24) ) THEN ; ll24 = ld24
2686	ELSE ; ll24 = .FALSE.
2687	ENDIF
2688	!
2689	IF( PRESENT(ldfull) ) THEN ; llfull = ldfull
2690	ELSE ; llfull = .FALSE.
2691	ENDIF
2692	!
2693	CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
2694	isec = NINT(zsec)
2695	!
2696	IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day
2697	CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec )
2698	isec = 86400
2699	ENDIF
2700	!
2701	IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date
2702	ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
2703	ENDIF
2704	!
2705	!$AGRIF_DO_NOT_TREAT
2706	! needed in the conv
2707	IF( llfull ) THEN
2708	clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
2709	ihour = isec / 3600
2710	isec = MOD(isec, 3600)
2711	iminute = isec / 60
2712	isec = MOD(isec, 60)
2713	WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec ! date of the end of run
2714	ELSE
2715	WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run
2716	ENDIF
2717	!$AGRIF_END_DO_NOT_TREAT
2718	!
2719	END FUNCTION iom_sdate
2720
2721	#else
2722	!!----------------------------------------------------------------------
2723	!! NOT 'key_xios' a few dummy routines
2724	!!----------------------------------------------------------------------
2725	SUBROUTINE iom_setkt( kt, cdname )
2726	INTEGER , INTENT(in):: kt
2727	CHARACTER(LEN=*), INTENT(in) :: cdname
2728	IF( .FALSE. ) WRITE(numout,*) kt, cdname ! useless test to avoid compilation warnings
2729	END SUBROUTINE iom_setkt
2730
2731	SUBROUTINE iom_context_finalize( cdname )
2732	CHARACTER(LEN=*), INTENT(in) :: cdname
2733	IF( .FALSE. ) WRITE(numout,*) cdname ! useless test to avoid compilation warnings
2734	END SUBROUTINE iom_context_finalize
2735
2736	SUBROUTINE iom_update_file_name( cdid )
2737	CHARACTER(LEN=*), INTENT(in) :: cdid
2738	IF( .FALSE. ) WRITE(numout,*) cdid ! useless test to avoid compilation warnings
2739	END SUBROUTINE iom_update_file_name
2740
2741	#endif
2742
2743	LOGICAL FUNCTION iom_use( cdname )
2744	CHARACTER(LEN=*), INTENT(in) :: cdname
2745	#if defined key_xios
2746	iom_use = xios_field_is_active( cdname )
2747	#else
2748	iom_use = .FALSE.
2749	#endif
2750	END FUNCTION iom_use
2751
2752	SUBROUTINE iom_miss_val( cdname, pmiss_val )
2753	CHARACTER(LEN=*), INTENT(in ) :: cdname
2754	REAL(wp) , INTENT(out) :: pmiss_val
2755	REAL(dp) :: ztmp_pmiss_val
2756	#if defined key_xios
2757	! get missing value
2758	CALL xios_get_field_attr( cdname, default_value = ztmp_pmiss_val )
2759	pmiss_val = ztmp_pmiss_val
2760	#else
2761	IF( .FALSE. ) WRITE(numout,*) cdname, pmiss_val ! useless test to avoid compilation warnings
2762	IF( .FALSE. ) pmiss_val = 0._wp ! useless assignment to avoid compilation warnings
2763	#endif
2764	END SUBROUTINE iom_miss_val
2765
2766	!!======================================================================
2767	END MODULE iom

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

Context Navigation

source: CONFIG/UNIFORM/v6/NEMO_v6.5/SOURCES/iom.F90

Download in other formats: