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 @ 13750

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

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

Download in other formats: