Context Navigation

iom.F90 @ 12340

Last change on this file since 12340 was 12340, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.

Property svn:keywords set to Id

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

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

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

Context Navigation

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/iom.F90 @ 12340

Download in other formats: