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

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

iom.F90 in NEMO/branches/2020/dev_12905_xios_restart/src/OCE/IOM – NEMO

Context Navigation

source: NEMO/branches/2020/dev_12905_xios_restart/src/OCE/IOM/iom.F90 @ 13727

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

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

Download in other formats: