Context Navigation

iom.F90 @ 12377

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

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

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

Download in other formats: