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

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

iom.F90 in branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/IOM – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 @ 7924

Last change on this file since 7924 was 7924, checked in by andmirek, 7 years ago
first commit with XIOS restart read functionality
File size: 107.0 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	!!--------------------------------------------------------------------
11
12	!!--------------------------------------------------------------------
13	!! iom_open : open a file read only
14	!! iom_close : close a file or all files opened by iom
15	!! iom_get : read a field (interfaced to several routines)
16	!! iom_gettime : read the time axis cdvar in the file
17	!! iom_varid : get the id of a variable in a file
18	!! iom_rstput : write a field in a restart file (interfaced to several routines)
19	!!--------------------------------------------------------------------
20	USE dom_oce ! ocean space and time domain
21	USE c1d ! 1D vertical configuration
22	USE flo_oce ! floats module declarations
23	USE lbclnk ! lateal boundary condition / mpp exchanges
24	USE iom_def ! iom variables definitions
25	USE iom_ioipsl ! NetCDF format with IOIPSL library
26	USE iom_nf90 ! NetCDF format with native NetCDF library
27	USE iom_rstdimg ! restarts access direct format "dimg" style...
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 ! ocean space and time domain
32	USE trc_oce, ONLY : nn_dttrc ! !: frequency of step on passive tracers
33	USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes
34	#if defined key_lim3
35	USE ice , ONLY : jpl
36	#elif defined key_lim2
37	USE par_ice_2
38	#endif
39	USE domngb ! ocean space and time domain
40	USE phycst ! physical constants
41	USE dianam ! build name of file
42	USE xios
43	# endif
44	USE ioipsl, ONLY : ju2ymds ! for calendar
45	USE crs ! Grid coarsening
46
47	IMPLICIT NONE
48	PUBLIC ! must be public to be able to access iom_def through iom
49
50	#if defined key_iomput
51	LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag
52	#else
53	LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag
54	#endif
55	INTEGER, PRIVATE, PARAMETER :: max_rst_fields = 85 ! maximum number of variables in a restart file
56	PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
57	PUBLIC iom_getatt, iom_use, iom_context_finalize
58
59	PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
60	PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
61	PRIVATE iom_p1d, iom_p2d, iom_p3d
62	#if defined key_iomput
63	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
64	PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
65	PRIVATE set_active_rst_fields
66	# endif
67
68	INTERFACE iom_get
69	MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
70	END INTERFACE
71	INTERFACE iom_getatt
72	MODULE PROCEDURE iom_g0d_intatt
73	END INTERFACE
74	INTERFACE iom_rstput
75	MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
76	END INTERFACE
77	INTERFACE iom_put
78	MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
79	END INTERFACE
80
81	!!----------------------------------------------------------------------
82	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
83	!! $Id$
84	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
85	!!----------------------------------------------------------------------
86
87	CONTAINS
88
89	SUBROUTINE iom_init( cdname )
90	!!----------------------------------------------------------------------
91	!! * ROUTINE *
92	!!
93	!! ** Purpose :
94	!!
95	!!----------------------------------------------------------------------
96	CHARACTER(len=*), INTENT(in) :: cdname
97	#if defined key_iomput
98	#if ! defined key_xios2
99	TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0)
100	CHARACTER(len=19) :: cldate
101	#else
102	TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0)
103	TYPE(xios_date) :: start_date
104	#endif
105	CHARACTER(len=10) :: clname
106	INTEGER :: ji
107	!
108	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds
109	!!----------------------------------------------------------------------
110	#if ! defined key_xios2
111	ALLOCATE( z_bnds(jpk,2) )
112	#else
113	ALLOCATE( z_bnds(2,jpk) )
114	#endif
115
116	clname = cdname
117	IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
118	CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
119	CALL iom_swap( cdname )
120
121	! calendar parameters
122	#if ! defined key_xios2
123	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
124	CASE ( 1) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian")
125	CASE ( 0) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap")
126	CASE (30) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360")
127	END SELECT
128	WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday
129	CALL xios_set_context_attr(TRIM(clname), start_date=cldate )
130	#else
131	! Calendar type is now defined in xml file
132	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
133	CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), &
134	& start_date = xios_date(nyear,nmonth,nday,0,0,0) )
135	CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(1900,01,01,00,00,00), &
136	& start_date = xios_date(nyear,nmonth,nday,0,0,0) )
137	CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(1900,01,01,00,00,00), &
138	& start_date = xios_date(nyear,nmonth,nday,0,0,0) )
139	END SELECT
140	#endif
141	! horizontal grid definition
142
143	CALL set_scalar
144
145	IF( TRIM(cdname) == TRIM(cxios_context) .OR. TRIM(cdname) == TRIM(rxios_context)) THEN
146	CALL set_grid( "T", glamt, gphit )
147	CALL set_grid( "U", glamu, gphiu )
148	CALL set_grid( "V", glamv, gphiv )
149	CALL set_grid( "W", glamt, gphit )
150	CALL set_grid_znl( gphit )
151	!
152	IF( ln_cfmeta ) THEN ! Add additional grid metadata
153	CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej))
154	CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej))
155	CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej))
156	CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej))
157	CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
158	CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
159	CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
160	CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
161	ENDIF
162	ENDIF
163
164	IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN
165	CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain
166	!
167	CALL set_grid( "T", glamt_crs, gphit_crs )
168	CALL set_grid( "U", glamu_crs, gphiu_crs )
169	CALL set_grid( "V", glamv_crs, gphiv_crs )
170	CALL set_grid( "W", glamt_crs, gphit_crs )
171	CALL set_grid_znl( gphit_crs )
172	!
173	CALL dom_grid_glo ! Return to parent grid domain
174	!
175	IF( ln_cfmeta ) THEN ! Add additional grid metadata
176	CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej))
177	CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej))
178	CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej))
179	CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej))
180	CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
181	CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs )
182	CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs )
183	CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs )
184	ENDIF
185	ENDIF
186
187	! vertical grid definition
188	CALL iom_set_axis_attr( "deptht", paxis = gdept_1d )
189	CALL iom_set_axis_attr( "depthu", paxis = gdept_1d )
190	CALL iom_set_axis_attr( "depthv", paxis = gdept_1d )
191	CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d )
192
193	! Add vertical grid bounds
194	#if ! defined key_xios2
195	z_bnds(: ,1) = gdepw_1d(:)
196	z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk)
197	z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk)
198	#else
199	z_bnds(1 ,:) = gdepw_1d(:)
200	z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk)
201	z_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk)
202	#endif
203
204	CALL iom_set_axis_attr( "deptht", bounds=z_bnds )
205	CALL iom_set_axis_attr( "depthu", bounds=z_bnds )
206	CALL iom_set_axis_attr( "depthv", bounds=z_bnds )
207
208	#if ! defined key_xios2
209	z_bnds(: ,2) = gdept_1d(:)
210	z_bnds(2:jpk,1) = gdept_1d(1:jpkm1)
211	z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1)
212	#else
213	z_bnds(2,: ) = gdept_1d(:)
214	z_bnds(1,2:jpk) = gdept_1d(1:jpkm1)
215	z_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1)
216	#endif
217	CALL iom_set_axis_attr( "depthw", bounds=z_bnds )
218
219
220	# if defined key_floats
221	CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )
222	# endif
223	#if defined key_lim3 \|\| defined key_lim2
224	CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
225	#endif
226	CALL iom_set_axis_attr( "icbcla", class_num )
227	CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )
228	CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )
229
230	! automatic definitions of some of the xml attributs
231	IF( TRIM(cdname) == TRIM(rxios_context)) THEN
232	CALL set_active_rst_fields
233	ELSE
234	CALL set_xmlatt
235	ENDIF
236
237	CALL set_1point
238
239	! end file definition
240	dtime%second = rdt
241	CALL xios_set_timestep(dtime)
242	CALL xios_close_context_definition()
243
244	CALL xios_update_calendar(0)
245
246	DEALLOCATE( z_bnds )
247
248	#endif
249
250	END SUBROUTINE iom_init
251
252	SUBROUTINE set_active_rst_fields
253	!sets enabled = .TRUE. for each field in restart file
254	CHARACTER(len=30),DIMENSION(max_rst_fields) :: rst_fields
255	INTEGER :: i
256
257	rst_fields(:)="NO_NAME"
258
259	rst_fields(1)="rdt"
260	rst_fields(2)="rdttra1"
261	rst_fields(3)="un"
262	rst_fields(4)="ub"
263	rst_fields(5)="vn"
264	rst_fields(6)="vb"
265	rst_fields(7)="tn"
266	rst_fields(8)="tb"
267	rst_fields(9)="sn"
268	rst_fields(10)="sb"
269	rst_fields(11)="sshn"
270	rst_fields(12)="sshb"
271	rst_fields(13)="hdivn"
272	rst_fields(14)="hdivb"
273	rst_fields(15)="rhop"
274	rst_fields(16)="rotn"
275	rst_fields(17)="rotb"
276	rst_fields(18)="kt"
277	rst_fields(19)="ndastp"
278	rst_fields(20)="adatrj"
279	rst_fields(21)="utau_b"
280	rst_fields(22)="vtau_b"
281	rst_fields(23)="qns_b"
282	rst_fields(24)="emp_b"
283	rst_fields(25)="sfx_b"
284	rst_fields(26)="en"
285	rst_fields(27)="avt"
286	rst_fields(28)="avm"
287	rst_fields(29)="avmu"
288	rst_fields(30)="avmv"
289	rst_fields(31)="dissl"
290	rst_fields(32)="sbc_hc_b"
291	rst_fields(33)="sbc_sc_b"
292	rst_fields(34)="qsr_hc_b"
293	rst_fields(35)="gcx"
294	rst_fields(36)="gcxb"
295	rst_fields(37)="fraqsr_1lev"
296	rst_fields(38)="greenland_icesheet_mass"
297	rst_fields(39)="greenland_icesheet_timelapsed"
298	rst_fields(40)="greenland_icesheet_mass_roc"
299	rst_fields(41)="antarctica_icesheet_mass"
300	rst_fields(42)="antarctica_icesheet_timelapsed"
301	rst_fields(43)="antarctica_icesheet_mass_roc"
302	rst_fields(44)="rhd"
303	rst_fields(45)="frc_v"
304	rst_fields(46)="frc_t"
305	rst_fields(47)="frc_s"
306	rst_fields(48)="frc_wn_t"
307	rst_fields(49)="frc_wn_s"
308	rst_fields(50)="ssh_ini"
309	rst_fields(51)="e3t_ini"
310	rst_fields(52)="hc_loc_ini"
311	rst_fields(53)="sc_loc_ini"
312	rst_fields(54)="ssh_hc_loc_ini"
313	rst_fields(55)="ssh_sc_loc_ini"
314	rst_fields(56)="fse3t_b"
315	rst_fields(57)="fse3t_n"
316	rst_fields(58)="tilde_e3t_b"
317	rst_fields(59)="tilde_e3t_n"
318	rst_fields(60)="hdiv_lf"
319	rst_fields(61)="ub2_b"
320	rst_fields(62)="vb2_b"
321	rst_fields(63)="sshbb_e"
322	rst_fields(64)="ubb_e"
323	rst_fields(65)="vbb_e"
324	rst_fields(66)="sshb_e"
325	rst_fields(67)="ub_e"
326	rst_fields(68)="vb_e"
327	rst_fields(69)="fwf_isf_b"
328	rst_fields(70)="isf_sc_b"
329	rst_fields(71)="isf_hc_b"
330	rst_fields(72)="ssh_ibb"
331	rst_fields(73)="rnf_b"
332	rst_fields(74)="rnf_hc_b"
333	rst_fields(75)="rnf_sc_b"
334	rst_fields(76)="nn_fsbc"
335	rst_fields(77)="ssu_m"
336	rst_fields(78)="ssv_m"
337	rst_fields(79)="sst_m"
338	rst_fields(80)="sss_m"
339	rst_fields(81)="ssh_m"
340	rst_fields(82)="e3t_m"
341	rst_fields(83)="frq_m"
342	rst_fields(84)="avmb"
343	rst_fields(85)="avtb"
344
345	DO i = 1, max_rst_fields
346	IF( TRIM(rst_fields(i)) /= "NO_NAME") THEN
347	IF( iom_varid( numror, TRIM(rst_fields(i)), ldstop = .FALSE. ) > 0 ) THEN
348	IF ( xios_is_valid_field( TRIM(rst_fields(i)) ) ) &
349	& CALL xios_set_field_attr ( TRIM(rst_fields(i)), enabled = .TRUE. )
350	ENDIF
351	ENDIF
352	END DO
353
354	END SUBROUTINE set_active_rst_fields
355
356	SUBROUTINE iom_swap( cdname )
357	!!---------------------------------------------------------------------
358	!! * SUBROUTINE iom_swap *
359	!!
360	!! ** Purpose : swap context between different agrif grid for xmlio_server
361	!!---------------------------------------------------------------------
362	CHARACTER(len=*), INTENT(in) :: cdname
363	#if defined key_iomput
364	TYPE(xios_context) :: nemo_hdl
365	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
366	CALL xios_get_handle(TRIM(cdname),nemo_hdl)
367	ELSE
368	CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
369	ENDIF
370	!
371	CALL xios_set_current_context(nemo_hdl)
372	#endif
373	!
374	END SUBROUTINE iom_swap
375
376
377	SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
378	!!---------------------------------------------------------------------
379	!! * SUBROUTINE iom_open *
380	!!
381	!! ** Purpose : open an input file (return 0 if not found)
382	!!---------------------------------------------------------------------
383	CHARACTER(len=*), INTENT(in ) :: cdname ! File name
384	INTEGER , INTENT( out) :: kiomid ! iom identifier of the opened file
385	LOGICAL , INTENT(in ), OPTIONAL :: ldwrt ! open in write modeb (default = .FALSE.)
386	INTEGER , INTENT(in ), OPTIONAL :: kdom ! Type of domain to be written (default = jpdom_local_noovlap)
387	INTEGER , INTENT(in ), OPTIONAL :: kiolib ! library used to open the file (default = jpnf90)
388	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.)
389	LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
390
391	CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu]
392	CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode)
393	CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg"
394	CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits)
395	CHARACTER(LEN=256) :: clinfo ! info character
396	LOGICAL :: llok ! check the existence
397	LOGICAL :: llwrt ! local definition of ldwrt
398	LOGICAL :: llnoov ! local definition to read overlap
399	LOGICAL :: llstop ! local definition of ldstop
400	LOGICAL :: lliof ! local definition of ldiof
401	INTEGER :: iolib ! library do we use to open the file
402	INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits)
403	INTEGER :: iln, ils ! lengths of character
404	INTEGER :: idom ! type of domain
405	INTEGER :: istop !
406	INTEGER, DIMENSION(2,5) :: idompar ! domain parameters:
407	! local number of points for x,y dimensions
408	! position of first local point for x,y dimensions
409	! position of last local point for x,y dimensions
410	! start halo size for x,y dimensions
411	! end halo size for x,y dimensions
412	!---------------------------------------------------------------------
413	! Initializations and control
414	! =============
415	kiomid = -1
416	clinfo = ' iom_open ~~~ '
417	istop = nstop
418	! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
419	! (could be done when defining iom_file in f95 but not in f90)
420	IF( Agrif_Root() ) THEN
421	IF( iom_open_init == 0 ) THEN
422	iom_file(:)%nfid = 0
423	iom_open_init = 1
424	ENDIF
425	ENDIF
426	! do we read or write the file?
427	IF( PRESENT(ldwrt) ) THEN ; llwrt = ldwrt
428	ELSE ; llwrt = .FALSE.
429	ENDIF
430	! do we call ctl_stop if we try to open a non-existing file in read mode?
431	IF( PRESENT(ldstop) ) THEN ; llstop = ldstop
432	ELSE ; llstop = .TRUE.
433	ENDIF
434	! what library do we use to open the file?
435	IF( PRESENT(kiolib) ) THEN ; iolib = kiolib
436	ELSE ; iolib = jpnf90
437	ENDIF
438	! are we using interpolation on the fly?
439	IF( PRESENT(ldiof) ) THEN ; lliof = ldiof
440	ELSE ; lliof = .FALSE.
441	ENDIF
442	! do we read the overlap
443	! ugly patch SM+JMM+RB to overwrite global definition in some cases
444	llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
445	! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
446	! =============
447	clname = trim(cdname)
448	IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
449	iln = INDEX(clname,'/')
450	cltmpn = clname(1:iln)
451	clname = clname(iln+1:LEN_TRIM(clname))
452	clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
453	ENDIF
454	! which suffix should we use?
455	SELECT CASE (iolib)
456	CASE (jpioipsl ) ; clsuffix = '.nc'
457	CASE (jpnf90 ) ; clsuffix = '.nc'
458	CASE (jprstdimg) ; clsuffix = '.dimg'
459	CASE DEFAULT ; clsuffix = ''
460	CALL ctl_stop( TRIM(clinfo), 'accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
461	END SELECT
462	! Add the suffix if needed
463	iln = LEN_TRIM(clname)
464	ils = LEN_TRIM(clsuffix)
465	IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 ) &
466	& clname = TRIM(clname)//TRIM(clsuffix)
467	cltmpn = clname ! store this name
468	! try to find if the file to be opened already exist
469	! =============
470	INQUIRE( FILE = clname, EXIST = llok )
471	IF( .NOT.llok ) THEN
472	! we try to add the cpu number to the name
473	IF( iolib == jprstdimg ) THEN ; WRITE(clcpu,*) narea
474	ELSE ; WRITE(clcpu,*) narea-1
475	ENDIF
476	clcpu = TRIM(ADJUSTL(clcpu))
477	iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
478	clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
479	icnt = 0
480	INQUIRE( FILE = clname, EXIST = llok )
481	! we try different formats for the cpu number by adding 0
482	DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
483	clcpu = "0"//trim(clcpu)
484	clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
485	INQUIRE( FILE = clname, EXIST = llok )
486	icnt = icnt + 1
487	END DO
488	ELSE
489	lxios_sini = .TRUE.
490	ENDIF
491	IF( llwrt ) THEN
492	! check the domain definition
493	! JMM + SM: ugly patch before getting the new version of lib_mpp)
494	! idom = jpdom_local_noovlap ! default definition
495	IF( llnoov ) THEN ; idom = jpdom_local_noovlap ! default definition
496	ELSE ; idom = jpdom_local_full ! default definition
497	ENDIF
498	IF( PRESENT(kdom) ) idom = kdom
499	! create the domain informations
500	! =============
501	SELECT CASE (idom)
502	CASE (jpdom_local_full)
503	idompar(:,1) = (/ jpi , jpj /)
504	idompar(:,2) = (/ nimpp , njmpp /)
505	idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1 /)
506	idompar(:,4) = (/ nldi - 1 , nldj - 1 /)
507	idompar(:,5) = (/ jpi - nlei , jpj - nlej /)
508	CASE (jpdom_local_noextra)
509	idompar(:,1) = (/ nlci , nlcj /)
510	idompar(:,2) = (/ nimpp , njmpp /)
511	idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
512	idompar(:,4) = (/ nldi - 1 , nldj - 1 /)
513	idompar(:,5) = (/ nlci - nlei , nlcj - nlej /)
514	CASE (jpdom_local_noovlap)
515	idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
516	idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
517	idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
518	idompar(:,4) = (/ 0 , 0 /)
519	idompar(:,5) = (/ 0 , 0 /)
520	CASE DEFAULT
521	CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
522	END SELECT
523	ENDIF
524	! Open the NetCDF or RSTDIMG file
525	! =============
526	! do we have some free file identifier?
527	IF( MINVAL(iom_file(:)%nfid) /= 0 ) &
528	& CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
529	! if no file was found...
530	IF( .NOT. llok ) THEN
531	IF( .NOT. llwrt ) THEN ! we are in read mode
532	IF( llstop ) THEN ; CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
533	ELSE ; istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file
534	ENDIF
535	ELSE ! we are in write mode so we
536	clname = cltmpn ! get back the file name without the cpu number
537	ENDIF
538	ELSE
539	IF( llwrt .AND. .NOT. ln_clobber ) THEN ! we stop as we want to write in a new file
540	CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
541	istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file
542	ELSEIF( llwrt ) THEN ! the file exists and we are in write mode with permission to
543	clname = cltmpn ! overwrite so get back the file name without the cpu number
544	ENDIF
545	ENDIF
546	IF( istop == nstop ) THEN ! no error within this routine
547	SELECT CASE (iolib)
548	CASE (jpioipsl ) ; CALL iom_ioipsl_open( clname, kiomid, llwrt, llok, idompar )
549	CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar )
550	CASE (jprstdimg) ; CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )
551	CASE DEFAULT
552	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
553	END SELECT
554	ENDIF
555	!
556	END SUBROUTINE iom_open
557
558
559	SUBROUTINE iom_close( kiomid )
560	!!--------------------------------------------------------------------
561	!! * SUBROUTINE iom_close *
562	!!
563	!! ** Purpose : close an input file, or all files opened by iom
564	!!--------------------------------------------------------------------
565	INTEGER, INTENT(inout), OPTIONAL :: kiomid ! iom identifier of the file to be closed
566	! ! return 0 when file is properly closed
567	! ! No argument: all files opened by iom are closed
568
569	INTEGER :: jf ! dummy loop indices
570	INTEGER :: i_s, i_e ! temporary integer
571	CHARACTER(LEN=100) :: clinfo ! info character
572	!---------------------------------------------------------------------
573	!
574	clinfo = ' iom_close ~~~ '
575	IF( PRESENT(kiomid) ) THEN
576	i_s = kiomid
577	i_e = kiomid
578	ELSE
579	i_s = 1
580	i_e = jpmax_files
581	ENDIF
582
583	IF( i_s > 0 ) THEN
584	DO jf = i_s, i_e
585	IF( iom_file(jf)%nfid > 0 ) THEN
586	SELECT CASE (iom_file(jf)%iolib)
587	CASE (jpioipsl ) ; CALL iom_ioipsl_close( jf )
588	CASE (jpnf90 ) ; CALL iom_nf90_close( jf )
589	CASE (jprstdimg) ; CALL iom_rstdimg_close( jf )
590	CASE DEFAULT
591	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
592	END SELECT
593	iom_file(jf)%nfid = 0 ! free the id
594	IF( PRESENT(kiomid) ) kiomid = 0 ! return 0 as id to specify that the file was closed
595	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
596	ELSEIF( PRESENT(kiomid) ) THEN
597	WRITE(ctmp1,*) '--->', kiomid
598	CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
599	ENDIF
600	END DO
601	ENDIF
602	!
603	END SUBROUTINE iom_close
604
605
606	FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )
607	!!-----------------------------------------------------------------------
608	!! * FUNCTION iom_varid *
609	!!
610	!! ** Purpose : get the id of a variable in a file (return 0 if not found)
611	!!-----------------------------------------------------------------------
612	INTEGER , INTENT(in ) :: kiomid ! file Identifier
613	CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable
614	INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of the dimensions
615	INTEGER, INTENT( out), OPTIONAL :: kndims ! size of the dimensions
616	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if looking for non-existing variable (default = .TRUE.)
617	!
618	INTEGER :: iom_varid, iiv, i_nvd
619	LOGICAL :: ll_fnd
620	CHARACTER(LEN=100) :: clinfo ! info character
621	LOGICAL :: llstop ! local definition of ldstop
622	!!-----------------------------------------------------------------------
623	iom_varid = 0 ! default definition
624	! do we call ctl_stop if we look for non-existing variable?
625	IF( PRESENT(ldstop) ) THEN ; llstop = ldstop
626	ELSE ; llstop = .TRUE.
627	ENDIF
628	!
629	IF( kiomid > 0 ) THEN
630	clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
631	IF( iom_file(kiomid)%nfid == 0 ) THEN
632	CALL ctl_stop( trim(clinfo), 'the file is not open' )
633	ELSE
634	ll_fnd = .FALSE.
635	iiv = 0
636	!
637	DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
638	iiv = iiv + 1
639	ll_fnd = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
640	END DO
641	!
642	IF( .NOT.ll_fnd ) THEN
643	iiv = iiv + 1
644	IF( iiv <= jpmax_vars ) THEN
645	SELECT CASE (iom_file(kiomid)%iolib)
646	CASE (jpioipsl ) ; iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )
647	CASE (jpnf90 ) ; iom_varid = iom_nf90_varid ( kiomid, cdvar, iiv, kdimsz, kndims )
648	CASE (jprstdimg) ; iom_varid = -1 ! all variables are listed in iom_file
649	CASE DEFAULT
650	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
651	END SELECT
652	ELSE
653	CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name, &
654	& 'increase the parameter jpmax_vars')
655	ENDIF
656	IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' )
657	ELSE
658	iom_varid = iiv
659	IF( PRESENT(kdimsz) ) THEN
660	i_nvd = iom_file(kiomid)%ndims(iiv)
661	IF( i_nvd == size(kdimsz) ) THEN
662	kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
663	ELSE
664	WRITE(ctmp1,*) i_nvd, size(kdimsz)
665	CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
666	ENDIF
667	ENDIF
668	IF( PRESENT(kndims) ) kndims = iom_file(kiomid)%ndims(iiv)
669	ENDIF
670	ENDIF
671	ENDIF
672	!
673	END FUNCTION iom_varid
674
675
676	!!----------------------------------------------------------------------
677	!! INTERFACE iom_get
678	!!----------------------------------------------------------------------
679	SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, lrxios )
680	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
681	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
682	REAL(wp) , INTENT( out) :: pvar ! read field
683	INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
684	LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! use xios to read restart
685	!
686	INTEGER :: idvar ! variable id
687	INTEGER :: idmspc ! number of spatial dimensions
688	INTEGER , DIMENSION(1) :: itime ! record number
689	CHARACTER(LEN=100) :: clinfo ! info character
690	CHARACTER(LEN=100) :: clname ! file name
691	CHARACTER(LEN=1) :: cldmspc !
692	LOGICAL :: lxios
693	!
694	lxios = .FALSE.
695	IF( PRESENT(lrxios) ) lxios = lrxios
696
697	IF(.NOT.lxios) THEN ! read data using default library
698	itime = 1
699	IF( PRESENT(ktime) ) itime = ktime
700	!
701	clname = iom_file(kiomid)%name
702	clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
703	!
704	IF( kiomid > 0 ) THEN
705	idvar = iom_varid( kiomid, cdvar )
706	IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
707	idmspc = iom_file ( kiomid )%ndims( idvar )
708	IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1
709	WRITE(cldmspc , fmt='(i1)') idmspc
710	IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
711	& 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
712	& 'Use ncwa -a to suppress the unnecessary dimensions' )
713	SELECT CASE (iom_file(kiomid)%iolib)
714	CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar, itime )
715	CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime )
716	CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idvar, pvar )
717	CASE DEFAULT
718	CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
719	END SELECT
720	ENDIF
721	ENDIF
722	ELSE
723	#if defined key_iomput
724	IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar)
725	CALL iom_swap( TRIM(rxios_context) )
726	CALL xios_recv_field( trim(cdvar), pvar)
727	CALL iom_swap( TRIM(cxios_context) )
728	#endif
729	ENDIF
730	END SUBROUTINE iom_g0d
731
732	SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrxios )
733	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
734	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
735	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
736	REAL(wp) , INTENT( out), DIMENSION(:) :: pvar ! read field
737	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
738	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading
739	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis
740	LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS
741	!
742	IF( kiomid > 0 ) THEN
743	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, &
744	& ktime=ktime, kstart=kstart, kcount=kcount, &
745	& lrxios=lrxios )
746	ENDIF
747	END SUBROUTINE iom_g1d
748
749	SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, lrxios)
750	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
751	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
752	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
753	REAL(wp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field
754	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
755	INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading
756	INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis
757	LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to
758	! look for and use a file attribute
759	! called open_ocean_jstart to set the start
760	! value for the 2nd dimension (netcdf only)
761	LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS
762	!
763	IF( kiomid > 0 ) THEN
764	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, &
765	& ktime=ktime, kstart=kstart, kcount=kcount, &
766	& lrowattr=lrowattr, lrxios=lrxios)
767	ENDIF
768	END SUBROUTINE iom_g2d
769
770	SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, lrxios )
771	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
772	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
773	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
774	REAL(wp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field
775	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
776	INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading
777	INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis
778	LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to
779	! look for and use a file attribute
780	! called open_ocean_jstart to set the start
781	! value for the 2nd dimension (netcdf only)
782	LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS
783	!
784	IF( kiomid > 0 ) THEN
785	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, &
786	& ktime=ktime, kstart=kstart, kcount=kcount, &
787	& lrowattr=lrowattr, lrxios=lrxios )
788	ENDIF
789	END SUBROUTINE iom_g3d
790	!!----------------------------------------------------------------------
791
792	SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , &
793	& pv_r1d, pv_r2d, pv_r3d, &
794	& ktime , kstart, kcount, &
795	& lrowattr, lrxios )
796	!!-----------------------------------------------------------------------
797	!! * ROUTINE iom_get_123d *
798	!!
799	!! ** Purpose : read a 1D/2D/3D variable
800	!!
801	!! ** Method : read ONE record at each CALL
802	!!-----------------------------------------------------------------------
803	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
804	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
805	CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable
806	REAL(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case)
807	REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case)
808	REAL(wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case)
809	INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
810	INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis
811	INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis
812	LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to
813	! look for and use a file attribute
814	! called open_ocean_jstart to set the start
815	! value for the 2nd dimension (netcdf only)
816	LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! use XIOS to read restart
817	!
818	LOGICAL :: lxios
819	LOGICAL :: llnoov ! local definition to read overlap
820	LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute
821	INTEGER :: jstartrow ! start point for 2nd dimension optionally set by file attribute
822	INTEGER :: jl ! loop on number of dimension
823	INTEGER :: idom ! type of domain
824	INTEGER :: idvar ! id of the variable
825	INTEGER :: inbdim ! number of dimensions of the variable
826	INTEGER :: idmspc ! number of spatial dimensions
827	INTEGER :: itime ! record number
828	INTEGER :: istop ! temporary value of nstop
829	INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes
830	INTEGER :: ji, jj ! loop counters
831	INTEGER :: irankpv !
832	INTEGER :: ind1, ind2 ! substring index
833	INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis
834	INTEGER, DIMENSION(jpmax_dims) :: icnt ! number of value to read along each axis
835	INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable
836	INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable
837	REAL(wp) :: zscf, zofs ! sacle_factor and add_offset
838	INTEGER :: itmp ! temporary integer
839	CHARACTER(LEN=256) :: clinfo ! info character
840	CHARACTER(LEN=256) :: clname ! file name
841	CHARACTER(LEN=1) :: clrankpv, cldmspc !
842	LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then only use values for 3rd spatial dimension.
843	!---------------------------------------------------------------------
844	!
845	lxios = .FALSE.
846	if(PRESENT(lrxios)) lxios = lrxios
847	idvar = iom_varid( kiomid, cdvar )
848	IF(.NOT.lxios) THEN
849	clname = iom_file(kiomid)%name ! esier to read
850	clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
851	! local definition of the domain ?
852	idom = kdom
853	! do we read the overlap
854	! ugly patch SM+JMM+RB to overwrite global definition in some cases
855	llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
856	! check kcount and kstart optionals parameters...
857	IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
858	IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
859	IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) &
860	& CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy')
861
862	luse_jattr = .false.
863	IF( PRESENT(lrowattr) ) THEN
864	IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data')
865	IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true.
866	ENDIF
867	IF( luse_jattr ) THEN
868	SELECT CASE (iom_file(kiomid)%iolib)
869	CASE (jpioipsl, jprstdimg )
870	CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)')
871	luse_jattr = .false.
872	CASE (jpnf90 )
873	! Ok
874	CASE DEFAULT
875	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
876	END SELECT
877	ENDIF
878
879	! Search for the variable in the data base (eventually actualize data)
880	istop = nstop
881	!
882	IF( idvar > 0 ) THEN
883	! to write iom_file(kiomid)%dimsz in a shorter way !
884	idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)
885	inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file
886	idmspc = inbdim ! number of spatial dimensions in the file
887	IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1
888	IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')
889	!
890	! update idom definition...
891	! Identify the domain in case of jpdom_auto(glo/dta) definition
892	IF( idom == jpdom_autoglo_xy ) THEN
893	ll_depth_spec = .TRUE.
894	idom = jpdom_autoglo
895	ELSE
896	ll_depth_spec = .FALSE.
897	ENDIF
898	IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN
899	IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global
900	ELSE ; idom = jpdom_data
901	ENDIF
902	ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
903	ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
904	IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF
905	ENDIF
906	! Identify the domain in case of jpdom_local definition
907	IF( idom == jpdom_local ) THEN
908	IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full
909	ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra
910	ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap
911	ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
912	ENDIF
913	ENDIF
914	!
915	! check the consistency between input array and data rank in the file
916	!
917	! initializations
918	itime = 1
919	IF( PRESENT(ktime) ) itime = ktime
920
921	irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
922	WRITE(clrankpv, fmt='(i1)') irankpv
923	WRITE(cldmspc , fmt='(i1)') idmspc
924	!
925	IF( idmspc < irankpv ) THEN
926	CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', &
927	& 'it is impossible to read a '//clrankpv//'D array from this file...' )
928	ELSEIF( idmspc == irankpv ) THEN
929	IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) &
930	& CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
931	ELSEIF( idmspc > irankpv ) THEN
932	IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
933	CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , &
934	& 'As the size of the z dimension is 1 and as we try to read the first record, ', &
935	& 'we accept this case, even if there is a possible mix-up between z and time dimension' )
936	idmspc = idmspc - 1
937	ELSE
938	CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , &
939	& 'we do not accept data with '//cldmspc//' spatial dimensions', &
940	& 'Use ncwa -a to suppress the unnecessary dimensions' )
941	ENDIF
942	ENDIF
943
944	!
945	! definition of istart and icnt
946	!
947	icnt (:) = 1
948	istart(:) = 1
949	istart(idmspc+1) = itime
950
951	IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
952	ELSE
953	IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc)
954	ELSE
955	IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array
956	IF( idom == jpdom_data ) THEN
957	jstartrow = 1
958	IF( luse_jattr ) THEN
959	CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found
960	jstartrow = MAX(1,jstartrow)
961	ENDIF
962	istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below
963	ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below
964	ENDIF
965	! we do not read the overlap -> we start to read at nldi, nldj
966	! JMM + SM: ugly patch before getting the new version of lib_mpp)
967	! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
968	IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
969	! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej
970	! JMM + SM: ugly patch before getting the new version of lib_mpp)
971	! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
972	IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
973	ELSE ; icnt(1:2) = (/ nlci , nlcj /)
974	ENDIF
975	IF( PRESENT(pv_r3d) ) THEN
976	IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta
977	ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3)
978	ELSE ; icnt(3) = jpk
979	ENDIF
980	ENDIF
981	ENDIF
982	ENDIF
983	ENDIF
984
985	! check that istart and icnt can be used with this file
986	!-
987	DO jl = 1, jpmax_dims
988	itmp = istart(jl)+icnt(jl)-1
989	IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
990	WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
991	WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl)
992	CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )
993	ENDIF
994	END DO
995
996	! check that icnt matches the input array
997	!-
998	IF( idom == jpdom_unknown ) THEN
999	IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d)
1000	IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d)
1001	IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d)
1002	ctmp1 = 'd'
1003	ELSE
1004	IF( irankpv == 2 ) THEN
1005	! JMM + SM: ugly patch before getting the new version of lib_mpp)
1006	! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)'
1007	IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
1008	ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)'
1009	ENDIF
1010	ENDIF
1011	IF( irankpv == 3 ) THEN
1012	! JMM + SM: ugly patch before getting the new version of lib_mpp)
1013	! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
1014	IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
1015	ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
1016	ENDIF
1017	ENDIF
1018	ENDIF
1019
1020	DO jl = 1, irankpv
1021	WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
1022	IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
1023	END DO
1024
1025	ENDIF
1026
1027	! read the data
1028	!-
1029	IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...
1030	!
1031	! find the right index of the array to be read
1032	! JMM + SM: ugly patch before getting the new version of lib_mpp)
1033	! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej
1034	! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
1035	! ENDIF
1036	IF( llnoov ) THEN
1037	IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej
1038	ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
1039	ENDIF
1040	ELSE
1041	IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj
1042	ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
1043	ENDIF
1044	ENDIF
1045
1046	SELECT CASE (iom_file(kiomid)%iolib)
1047	CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &
1048	& pv_r1d, pv_r2d, pv_r3d )
1049	CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &
1050	& pv_r1d, pv_r2d, pv_r3d )
1051	CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, &
1052	& pv_r1d, pv_r2d, pv_r3d )
1053	CASE DEFAULT
1054	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1055	END SELECT
1056
1057	IF( istop == nstop ) THEN ! no additional errors until this point...
1058	IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
1059
1060	!--- overlap areas and extra hallows (mpp)
1061	IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
1062	CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
1063	ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
1064	! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
1065	IF( icnt(3) == jpk ) THEN
1066	CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
1067	ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...)
1068	DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO
1069	DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO
1070	ENDIF
1071	ENDIF
1072	!
1073	ELSE
1074	! return if istop == nstop is false
1075	RETURN
1076	ENDIF
1077	ELSE
1078	! return if statment idvar > 0 .AND. istop == nstop is false
1079	RETURN
1080	ENDIF
1081	!
1082	ELSE ! read using XIOS. Only if key_iomput is defined
1083	#if defined key_iomput
1084	! will not handle scale factor and offset
1085	!would be good to be able to check which context is active and swap only if current is not restart
1086	CALL iom_swap( TRIM(rxios_context) )
1087	IF( PRESENT(pv_r3d) ) THEN
1088	if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar)
1089	CALL xios_recv_field( trim(cdvar), pv_r3d)
1090	IF(idom /= jpdom_unknown ) CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
1091	ELSEIF( PRESENT(pv_r2d) ) THEN
1092	if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar)
1093	CALL xios_recv_field( trim(cdvar), pv_r2d)
1094	IF(idom /= jpdom_unknown ) CALL lbc_lnk(pv_r2d,'Z',-999.,'no0')
1095	ELSEIF( PRESENT(pv_r1d) ) THEN
1096	if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar)
1097	CALL xios_recv_field( trim(cdvar), pv_r1d)
1098	ENDIF
1099	if(lwp) write(numout,*) 'XIOS RST READ END: ',trim(cdvar)
1100	CALL iom_swap( TRIM(cxios_context) )
1101	#else
1102	istop = istop + 1
1103	clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar)
1104	#endif
1105	ENDIF
1106	!some final adjustments
1107	! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
1108	IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. )
1109	IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. )
1110
1111	!--- Apply scale_factor and offset
1112	zscf = iom_file(kiomid)%scf(idvar) ! scale factor
1113	zofs = iom_file(kiomid)%ofs(idvar) ! offset
1114	IF( PRESENT(pv_r1d) ) THEN
1115	IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf
1116	IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs
1117	ELSEIF( PRESENT(pv_r2d) ) THEN
1118	!CDIR COLLAPSE
1119	IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf
1120	!CDIR COLLAPSE
1121	IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs
1122	ELSEIF( PRESENT(pv_r3d) ) THEN
1123	!CDIR COLLAPSE
1124	IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
1125	!CDIR COLLAPSE
1126	IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
1127	ENDIF
1128
1129	END SUBROUTINE iom_get_123d
1130
1131
1132	SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
1133	!!--------------------------------------------------------------------
1134	!! * SUBROUTINE iom_gettime *
1135	!!
1136	!! ** Purpose : read the time axis cdvar in the file
1137	!!--------------------------------------------------------------------
1138	INTEGER , INTENT(in ) :: kiomid ! file Identifier
1139	REAL(wp), DIMENSION(:) , INTENT( out) :: ptime ! the time axis
1140	CHARACTER(len=*), OPTIONAL , INTENT(in ) :: cdvar ! time axis name
1141	INTEGER , OPTIONAL , INTENT( out) :: kntime ! number of times in file
1142	CHARACTER(len=*), OPTIONAL , INTENT( out) :: cdunits ! units attribute of time coordinate
1143	CHARACTER(len=*), OPTIONAL , INTENT( out) :: cdcalendar ! calendar attribute of
1144	!
1145	INTEGER, DIMENSION(1) :: kdimsz
1146	INTEGER :: idvar ! id of the variable
1147	CHARACTER(LEN=32) :: tname ! local name of time coordinate
1148	CHARACTER(LEN=100) :: clinfo ! info character
1149	!---------------------------------------------------------------------
1150	!
1151	IF ( PRESENT(cdvar) ) THEN
1152	tname = cdvar
1153	ELSE
1154	tname = iom_file(kiomid)%uldname
1155	ENDIF
1156	IF( kiomid > 0 ) THEN
1157	clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
1158	IF ( PRESENT(kntime) ) THEN
1159	idvar = iom_varid( kiomid, tname, kdimsz = kdimsz )
1160	kntime = kdimsz(1)
1161	ELSE
1162	idvar = iom_varid( kiomid, tname )
1163	ENDIF
1164	!
1165	ptime(:) = 0. ! default definition
1166	IF( idvar > 0 ) THEN
1167	IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
1168	IF( iom_file(kiomid)%luld(idvar) ) THEN
1169	IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
1170	SELECT CASE (iom_file(kiomid)%iolib)
1171	CASE (jpioipsl ) ; CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
1172	CASE (jpnf90 ) ; CALL iom_nf90_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
1173	CASE (jprstdimg) ; CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' )
1174	CASE DEFAULT
1175	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1176	END SELECT
1177	ELSE
1178	WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
1179	CALL ctl_stop( trim(clinfo), trim(ctmp1) )
1180	ENDIF
1181	ELSE
1182	CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
1183	ENDIF
1184	ELSE
1185	CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
1186	ENDIF
1187	ELSE
1188	CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
1189	ENDIF
1190	ENDIF
1191	!
1192	END SUBROUTINE iom_gettime
1193
1194
1195	!!----------------------------------------------------------------------
1196	!! INTERFACE iom_getatt
1197	!!----------------------------------------------------------------------
1198	SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
1199	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
1200	CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute
1201	INTEGER , INTENT( out) :: pvar ! read field
1202	!
1203	IF( kiomid > 0 ) THEN
1204	IF( iom_file(kiomid)%nfid > 0 ) THEN
1205	SELECT CASE (iom_file(kiomid)%iolib)
1206	CASE (jpioipsl ) ; CALL ctl_stop('iom_getatt: only nf90 available')
1207	CASE (jpnf90 ) ; CALL iom_nf90_getatt( kiomid, cdatt, pvar )
1208	CASE (jprstdimg) ; CALL ctl_stop('iom_getatt: only nf90 available')
1209	CASE DEFAULT
1210	CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1211	END SELECT
1212	ENDIF
1213	ENDIF
1214	END SUBROUTINE iom_g0d_intatt
1215
1216
1217	!!----------------------------------------------------------------------
1218	!! INTERFACE iom_rstput
1219	!!----------------------------------------------------------------------
1220	SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
1221	INTEGER , INTENT(in) :: kt ! ocean time-step
1222	INTEGER , INTENT(in) :: kwrite ! writing time-step
1223	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1224	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1225	REAL(wp) , INTENT(in) :: pvar ! written field
1226	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1227	INTEGER :: ivid ! variable id
1228	IF( kiomid > 0 ) THEN
1229	IF( iom_file(kiomid)%nfid > 0 ) THEN
1230	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1231	SELECT CASE (iom_file(kiomid)%iolib)
1232	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
1233	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
1234	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar )
1235	CASE DEFAULT
1236	CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1237	END SELECT
1238	ENDIF
1239	ENDIF
1240	END SUBROUTINE iom_rp0d
1241
1242	SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
1243	INTEGER , INTENT(in) :: kt ! ocean time-step
1244	INTEGER , INTENT(in) :: kwrite ! writing time-step
1245	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1246	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1247	REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field
1248	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1249	INTEGER :: ivid ! variable id
1250	IF( kiomid > 0 ) THEN
1251	IF( iom_file(kiomid)%nfid > 0 ) THEN
1252	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1253	SELECT CASE (iom_file(kiomid)%iolib)
1254	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
1255	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
1256	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar )
1257	CASE DEFAULT
1258	CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1259	END SELECT
1260	ENDIF
1261	ENDIF
1262	END SUBROUTINE iom_rp1d
1263
1264	SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
1265	INTEGER , INTENT(in) :: kt ! ocean time-step
1266	INTEGER , INTENT(in) :: kwrite ! writing time-step
1267	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1268	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1269	REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field
1270	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1271	INTEGER :: ivid ! variable id
1272	IF( kiomid > 0 ) THEN
1273	IF( iom_file(kiomid)%nfid > 0 ) THEN
1274	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1275	SELECT CASE (iom_file(kiomid)%iolib)
1276	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
1277	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
1278	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar )
1279	CASE DEFAULT
1280	CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
1281	END SELECT
1282	ENDIF
1283	ENDIF
1284	END SUBROUTINE iom_rp2d
1285
1286	SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
1287	INTEGER , INTENT(in) :: kt ! ocean time-step
1288	INTEGER , INTENT(in) :: kwrite ! writing time-step
1289	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1290	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1291	REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field
1292	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1293	INTEGER :: ivid ! variable id
1294	IF( kiomid > 0 ) THEN
1295	IF( iom_file(kiomid)%nfid > 0 ) THEN
1296	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1297	SELECT CASE (iom_file(kiomid)%iolib)
1298	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
1299	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
1300	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar )
1301	CASE DEFAULT
1302	CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
1303	END SELECT
1304	ENDIF
1305	ENDIF
1306	END SUBROUTINE iom_rp3d
1307
1308
1309	!!----------------------------------------------------------------------
1310	!! INTERFACE iom_put
1311	!!----------------------------------------------------------------------
1312	SUBROUTINE iom_p0d( cdname, pfield0d )
1313	CHARACTER(LEN=*), INTENT(in) :: cdname
1314	REAL(wp) , INTENT(in) :: pfield0d
1315	REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson
1316	#if defined key_iomput
1317	zz(:,:)=pfield0d
1318	CALL xios_send_field(cdname, zz)
1319	!CALL xios_send_field(cdname, (/pfield0d/))
1320	#else
1321	IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings
1322	#endif
1323	END SUBROUTINE iom_p0d
1324
1325	SUBROUTINE iom_p1d( cdname, pfield1d )
1326	CHARACTER(LEN=*) , INTENT(in) :: cdname
1327	REAL(wp), DIMENSION(:), INTENT(in) :: pfield1d
1328	#if defined key_iomput
1329	CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
1330	#else
1331	IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings
1332	#endif
1333	END SUBROUTINE iom_p1d
1334
1335	SUBROUTINE iom_p2d( cdname, pfield2d )
1336	CHARACTER(LEN=*) , INTENT(in) :: cdname
1337	REAL(wp), DIMENSION(:,:), INTENT(in) :: pfield2d
1338	#if defined key_iomput
1339	CALL xios_send_field(cdname, pfield2d)
1340	#else
1341	IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings
1342	#endif
1343	END SUBROUTINE iom_p2d
1344
1345	SUBROUTINE iom_p3d( cdname, pfield3d )
1346	CHARACTER(LEN=*) , INTENT(in) :: cdname
1347	REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d
1348	#if defined key_iomput
1349	CALL xios_send_field(cdname, pfield3d)
1350	#else
1351	IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings
1352	#endif
1353	END SUBROUTINE iom_p3d
1354	!!----------------------------------------------------------------------
1355
1356	#if defined key_iomput
1357
1358	SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, &
1359	& data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, &
1360	& nvertex, bounds_lon, bounds_lat, area )
1361	CHARACTER(LEN=*) , INTENT(in) :: cdid
1362	INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj
1363	INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj
1364	INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex
1365	REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue
1366	REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area
1367	#if ! defined key_xios2
1368	LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask
1369	#else
1370	LOGICAL, DIMENSION(:) , OPTIONAL, INTENT(in) :: mask
1371	#endif
1372
1373	#if ! defined key_xios2
1374	IF ( xios_is_valid_domain (cdid) ) THEN
1375	CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
1376	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
1377	& zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, &
1378	& lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, &
1379	& bounds_lat=bounds_lat, area=area )
1380	ENDIF
1381	IF ( xios_is_valid_domaingroup(cdid) ) THEN
1382	CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
1383	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
1384	& zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, &
1385	& lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, &
1386	& bounds_lat=bounds_lat, area=area )
1387	ENDIF
1388
1389	#else
1390	IF ( xios_is_valid_domain (cdid) ) THEN
1391	CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
1392	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
1393	& lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, &
1394	& bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
1395	ENDIF
1396	IF ( xios_is_valid_domaingroup(cdid) ) THEN
1397	CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
1398	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
1399	& lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, &
1400	& bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
1401	ENDIF
1402	#endif
1403	CALL xios_solve_inheritance()
1404
1405	END SUBROUTINE iom_set_domain_attr
1406
1407	#if defined key_xios2
1408	SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj)
1409	CHARACTER(LEN=*) , INTENT(in) :: cdid
1410	INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj
1411
1412	IF ( xios_is_valid_zoom_domain (cdid) ) THEN
1413	CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, &
1414	& nj=nj)
1415	ENDIF
1416	END SUBROUTINE iom_set_zoom_domain_attr
1417	#endif
1418
1419
1420	SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
1421	CHARACTER(LEN=*) , INTENT(in) :: cdid
1422	REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis
1423	REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds
1424	IF ( PRESENT(paxis) ) THEN
1425	#if ! defined key_xios2
1426	IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis )
1427	IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis )
1428	#else
1429	IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis )
1430	IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis )
1431	#endif
1432	ENDIF
1433	IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds )
1434	IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds )
1435	CALL xios_solve_inheritance()
1436	END SUBROUTINE iom_set_axis_attr
1437
1438	SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
1439	CHARACTER(LEN=*) , INTENT(in) :: cdid
1440	#if ! defined key_xios2
1441	CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_op
1442	CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_offset
1443	#else
1444	TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op
1445	TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset
1446	#endif
1447	IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr &
1448	& ( cdid, freq_op=freq_op, freq_offset=freq_offset )
1449	IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr &
1450	& ( cdid, freq_op=freq_op, freq_offset=freq_offset )
1451	CALL xios_solve_inheritance()
1452	END SUBROUTINE iom_set_field_attr
1453
1454	SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
1455	CHARACTER(LEN=*) , INTENT(in) :: cdid
1456	CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix
1457	IF ( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix )
1458	IF ( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
1459	CALL xios_solve_inheritance()
1460	END SUBROUTINE iom_set_file_attr
1461
1462
1463	SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
1464	CHARACTER(LEN=*) , INTENT(in ) :: cdid
1465	CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix
1466	#if ! defined key_xios2
1467	CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: output_freq
1468	#else
1469	TYPE(xios_duration) ,OPTIONAL , INTENT(out) :: output_freq
1470	#endif
1471	LOGICAL :: llexist1,llexist2,llexist3
1472	!---------------------------------------------------------------------
1473	IF( PRESENT( name ) ) name = '' ! default values
1474	IF( PRESENT( name_suffix ) ) name_suffix = ''
1475	#if ! defined key_xios2
1476	IF( PRESENT( output_freq ) ) output_freq = ''
1477	#else
1478	IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0)
1479	#endif
1480	IF ( xios_is_valid_file (cdid) ) THEN
1481	CALL xios_solve_inheritance()
1482	CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
1483	IF(llexist1) CALL xios_get_file_attr ( cdid, name = name )
1484	IF(llexist2) CALL xios_get_file_attr ( cdid, name_suffix = name_suffix )
1485	IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq )
1486	ENDIF
1487	IF ( xios_is_valid_filegroup(cdid) ) THEN
1488	CALL xios_solve_inheritance()
1489	CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
1490	IF(llexist1) CALL xios_get_filegroup_attr( cdid, name = name )
1491	IF(llexist2) CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
1492	IF(llexist3) CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
1493	ENDIF
1494	END SUBROUTINE iom_get_file_attr
1495
1496
1497	SUBROUTINE iom_set_grid_attr( cdid, mask )
1498	CHARACTER(LEN=*) , INTENT(in) :: cdid
1499	LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask
1500	#if ! defined key_xios2
1501	IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask )
1502	IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask )
1503	#else
1504	IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask )
1505	IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask )
1506	#endif
1507	CALL xios_solve_inheritance()
1508	END SUBROUTINE iom_set_grid_attr
1509
1510	SUBROUTINE iom_setkt( kt, cdname )
1511	INTEGER , INTENT(in) :: kt
1512	CHARACTER(LEN=*), INTENT(in) :: cdname
1513	!
1514	CALL iom_swap( cdname ) ! swap to cdname context
1515	CALL xios_update_calendar(kt)
1516	IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context
1517	!
1518	END SUBROUTINE iom_setkt
1519
1520	SUBROUTINE iom_context_finalize( cdname )
1521	CHARACTER(LEN=*), INTENT(in) :: cdname
1522	!
1523	IF( xios_is_valid_context(cdname) ) THEN
1524	CALL iom_swap( cdname ) ! swap to cdname context
1525	CALL xios_context_finalize() ! finalize the context
1526	IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context
1527	ENDIF
1528	!
1529	END SUBROUTINE iom_context_finalize
1530
1531
1532	SUBROUTINE set_grid( cdgrd, plon, plat )
1533	!!----------------------------------------------------------------------
1534	!! * ROUTINE set_grid *
1535	!!
1536	!! ** Purpose : define horizontal grids
1537	!!
1538	!!----------------------------------------------------------------------
1539	CHARACTER(LEN=1) , INTENT(in) :: cdgrd
1540	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon
1541	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
1542	!
1543	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask
1544	INTEGER :: ni,nj
1545
1546	ni=nlei-nldi+1 ; nj=nlej-nldj+1
1547
1548	#if ! defined key_xios2
1549	CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
1550	#else
1551	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)
1552	#endif
1553	CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
1554	CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), &
1555	& latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
1556
1557	IF ( ln_mskland ) THEN
1558	! mask land points, keep values on coast line -> specific mask for U, V and W points
1559	SELECT CASE ( cdgrd )
1560	CASE('T') ; zmask(:,:,:) = tmask(:,:,:)
1561	CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. )
1562	CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( zmask, 'V', 1. )
1563	CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1)
1564	END SELECT
1565	!
1566	#if ! defined key_xios2
1567	CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj /)) /= 0. )
1568	#else
1569	CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj /)) /= 0. )
1570	#endif
1571	CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
1572	ENDIF
1573
1574	END SUBROUTINE set_grid
1575
1576
1577	SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
1578	!!----------------------------------------------------------------------
1579	!! * ROUTINE set_grid_bounds *
1580	!!
1581	!! ** Purpose : define horizontal grid corners
1582	!!
1583	!!----------------------------------------------------------------------
1584	CHARACTER(LEN=1) , INTENT(in) :: cdgrd
1585	!
1586	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j)
1587	REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j)
1588	!
1589	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j)
1590	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells
1591	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells
1592	!
1593	INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
1594	! ! represents the bottom-left corner of cell (i,j)
1595	INTEGER :: ji, jj, jn, ni, nj
1596
1597	ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) )
1598
1599	! Offset of coordinate representing bottom-left corner
1600	SELECT CASE ( TRIM(cdgrd) )
1601	CASE ('T', 'W')
1602	icnr = -1 ; jcnr = -1
1603	CASE ('U')
1604	icnr = 0 ; jcnr = -1
1605	CASE ('V')
1606	icnr = -1 ; jcnr = 0
1607	END SELECT
1608
1609	ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior
1610
1611	z_fld(:,:) = 1._wp
1612	CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold
1613
1614	! Cell vertices that can be defined
1615	DO jj = 2, jpjm1
1616	DO ji = 2, jpim1
1617	z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left
1618	z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right
1619	z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
1620	z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left
1621	z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left
1622	z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right
1623	z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
1624	z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left
1625	END DO
1626	END DO
1627
1628	! Cell vertices on boundries
1629	DO jn = 1, 4
1630	CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )
1631	CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )
1632	END DO
1633
1634	! Zero-size cells at closed boundaries if cell points provided,
1635	! otherwise they are closed cells with unrealistic bounds
1636	IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN
1637	IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
1638	DO jn = 1, 4 ! (West or jpni = 1), closed E-W
1639	z_bnds(jn,1,:,1) = plat_pnt(1,:) ; z_bnds(jn,1,:,2) = plon_pnt(1,:)
1640	END DO
1641	ENDIF
1642	IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
1643	DO jn = 1, 4 ! (East or jpni = 1), closed E-W
1644	z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)
1645	END DO
1646	ENDIF
1647	IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN
1648	DO jn = 1, 4 ! South or (jpnj = 1, not symmetric)
1649	z_bnds(jn,:,1,1) = plat_pnt(:,1) ; z_bnds(jn,:,1,2) = plon_pnt(:,1)
1650	END DO
1651	ENDIF
1652	IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN
1653	DO jn = 1, 4 ! (North or jpnj = 1), no north fold
1654	z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)
1655	END DO
1656	ENDIF
1657	ENDIF
1658
1659	! Rotate cells at the north fold
1660	IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN
1661	DO jj = 1, jpj
1662	DO ji = 1, jpi
1663	IF( z_fld(ji,jj) == -1. ) THEN
1664	z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
1665	z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
1666	z_bnds(:,ji,jj,:) = z_rot(:,:)
1667	ENDIF
1668	END DO
1669	END DO
1670
1671	! Invert cells at the symmetric equator
1672	ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN
1673	DO ji = 1, jpi
1674	z_rot(1:2,:) = z_bnds(3:4,ji,1,:)
1675	z_rot(3:4,:) = z_bnds(1:2,ji,1,:)
1676	z_bnds(:,ji,1,:) = z_rot(:,:)
1677	END DO
1678	ENDIF
1679
1680	CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), &
1681	bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )
1682
1683	DEALLOCATE( z_bnds, z_fld, z_rot )
1684
1685	END SUBROUTINE set_grid_bounds
1686
1687
1688	SUBROUTINE set_grid_znl( plat )
1689	!!----------------------------------------------------------------------
1690	!! * ROUTINE set_grid_znl *
1691	!!
1692	!! ** Purpose : define grids for zonal mean
1693	!!
1694	!!----------------------------------------------------------------------
1695	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
1696	!
1697	REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon
1698	INTEGER :: ni,nj, ix, iy
1699
1700
1701	ni=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk)
1702	ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0.
1703
1704	CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)
1705	#if ! defined key_xios2
1706	CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
1707	CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
1708	CALL iom_set_domain_attr("gznl", lonvalue = zlon, &
1709	& latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
1710	!
1711	CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)
1712	#else
1713	! Pas teste : attention aux indices !
1714	CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
1715	CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
1716	CALL iom_set_domain_attr("gznl", lonvalue = zlon, &
1717	& latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
1718	CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
1719	#endif
1720
1721	CALL iom_update_file_name('ptr')
1722	!
1723	END SUBROUTINE set_grid_znl
1724
1725	SUBROUTINE set_scalar
1726	!!----------------------------------------------------------------------
1727	!! * ROUTINE set_scalar *
1728	!!
1729	!! ** Purpose : define fake grids for scalar point
1730	!!
1731	!!----------------------------------------------------------------------
1732	REAL(wp), DIMENSION(1) :: zz = 1.
1733	!!----------------------------------------------------------------------
1734	#if ! defined key_xios2
1735	CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
1736	#else
1737	CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1)
1738	#endif
1739	CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
1740
1741	zz=REAL(narea,wp)
1742	CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
1743
1744	END SUBROUTINE set_scalar
1745
1746	SUBROUTINE set_1point
1747	!!----------------------------------------------------------------------
1748	!! * ROUTINE set_1point *
1749	!!
1750	!! ** Purpose : define zoom grid for scalar fields
1751	!!
1752	!!----------------------------------------------------------------------
1753	REAL(wp), DIMENSION(1) :: zz = 1.
1754	INTEGER :: ix, iy
1755	!!----------------------------------------------------------------------
1756	CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! Nearest point to north pole should be ocean
1757	CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy)
1758
1759	END SUBROUTINE set_1point
1760
1761
1762
1763	SUBROUTINE set_xmlatt
1764	!!----------------------------------------------------------------------
1765	!! * ROUTINE set_xmlatt *
1766	!!
1767	!! ** Purpose : automatic definitions of some of the xml attributs...
1768	!!
1769	!!----------------------------------------------------------------------
1770	CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name
1771	CHARACTER(len=256) :: clsuff ! suffix name
1772	CHARACTER(len=1) :: cl1 ! 1 character
1773	CHARACTER(len=2) :: cl2 ! 2 characters
1774	CHARACTER(len=3) :: cl3 ! 3 characters
1775	INTEGER :: ji, jg ! loop counters
1776	INTEGER :: ix, iy ! i-,j- index
1777	REAL(wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings
1778	REAL(wp) ,DIMENSION( 7) :: zlattao ! latitudes of tao moorings
1779	REAL(wp) ,DIMENSION( 4) :: zlonrama ! longitudes of rama moorings
1780	REAL(wp) ,DIMENSION(11) :: zlatrama ! latitudes of rama moorings
1781	REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings
1782	REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings
1783	#if defined key_xios2
1784	TYPE(xios_duration) :: f_op, f_of
1785	#endif
1786
1787	!!----------------------------------------------------------------------
1788	!
1789	! frequency of the call of iom_put (attribut: freq_op)
1790	#if ! defined key_xios2
1791	WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts')
1792	WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op=cl1//'ts', freq_offset='0ts')
1793	WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op=cl1//'ts', freq_offset='0ts')
1794	WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op=cl1//'ts', freq_offset='0ts')
1795	WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op=cl1//'ts', freq_offset='0ts')
1796	#else
1797	f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
1798	f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of)
1799	f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of)
1800	f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of)
1801	f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of)
1802	#endif
1803
1804	! output file names (attribut: name)
1805	DO ji = 1, 9
1806	WRITE(cl1,'(i1)') ji
1807	CALL iom_update_file_name('file'//cl1)
1808	END DO
1809	DO ji = 1, 99
1810	WRITE(cl2,'(i2.2)') ji
1811	CALL iom_update_file_name('file'//cl2)
1812	END DO
1813	DO ji = 1, 999
1814	WRITE(cl3,'(i3.3)') ji
1815	CALL iom_update_file_name('file'//cl3)
1816	END DO
1817
1818	! Zooms...
1819	clgrd = (/ 'T', 'U', 'W' /)
1820	DO jg = 1, SIZE(clgrd) ! grid type
1821	cl1 = clgrd(jg)
1822	! Equatorial section (attributs: jbegin, ni, name_suffix)
1823	CALL dom_ngb( 0., 0., ix, iy, cl1 )
1824	#if ! defined key_xios2
1825	CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)
1826	#else
1827	CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo)
1828	#endif
1829	CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff )
1830	CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
1831	CALL iom_update_file_name('Eq'//cl1)
1832	END DO
1833	! TAO moorings (attributs: ibegin, jbegin, name_suffix)
1834	zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
1835	zlattao = (/ -8.0, -5.0, -2.0, 0.0, 2.0, 5.0, 8.0 /)
1836	CALL set_mooring( zlontao, zlattao )
1837	! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
1838	zlonrama = (/ 55.0, 67.0, 80.5, 90.0 /)
1839	zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
1840	CALL set_mooring( zlonrama, zlatrama )
1841	! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
1842	zlonpira = (/ -38.0, -23.0, -10.0 /)
1843	zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
1844	CALL set_mooring( zlonpira, zlatpira )
1845
1846
1847	END SUBROUTINE set_xmlatt
1848
1849
1850	SUBROUTINE set_mooring( plon, plat)
1851	!!----------------------------------------------------------------------
1852	!! * ROUTINE set_mooring *
1853	!!
1854	!! ** Purpose : automatic definitions of moorings xml attributs...
1855	!!
1856	!!----------------------------------------------------------------------
1857	REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring
1858	!
1859	!!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name
1860	CHARACTER(len=1),DIMENSION(1) :: clgrd = (/ 'T' /) ! suffix name
1861	CHARACTER(len=256) :: clname ! file name
1862	CHARACTER(len=256) :: clsuff ! suffix name
1863	CHARACTER(len=1) :: cl1 ! 1 character
1864	CHARACTER(len=6) :: clon,clat ! name of longitude, latitude
1865	INTEGER :: ji, jj, jg ! loop counters
1866	INTEGER :: ix, iy ! i-,j- index
1867	REAL(wp) :: zlon, zlat
1868	!!----------------------------------------------------------------------
1869	DO jg = 1, SIZE(clgrd)
1870	cl1 = clgrd(jg)
1871	DO ji = 1, SIZE(plon)
1872	DO jj = 1, SIZE(plat)
1873	zlon = plon(ji)
1874	zlat = plat(jj)
1875	! modifications for RAMA moorings
1876	IF( zlon == 67. .AND. zlat == 15. ) zlon = 65.
1877	IF( zlon == 90. .AND. zlat <= -4. ) zlon = 95.
1878	IF( zlon == 95. .AND. zlat == -4. ) zlat = -5.
1879	! modifications for PIRATA moorings
1880	IF( zlon == -38. .AND. zlat == -19. ) zlon = -34.
1881	IF( zlon == -38. .AND. zlat == -14. ) zlon = -32.
1882	IF( zlon == -38. .AND. zlat == -8. ) zlon = -30.
1883	IF( zlon == -38. .AND. zlat == 0. ) zlon = -35.
1884	IF( zlon == -23. .AND. zlat == 20. ) zlat = 21.
1885	IF( zlon == -10. .AND. zlat == -14. ) zlat = -10.
1886	IF( zlon == -10. .AND. zlat == -8. ) zlat = -6.
1887	IF( zlon == -10. .AND. zlat == 4. ) THEN ; zlon = 0. ; zlat = 0. ; ENDIF
1888	CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
1889	IF( zlon >= 0. ) THEN
1890	IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT( zlon), 'e'
1891	ELSE ; WRITE(clon, '(f5.1,a)') zlon , 'e'
1892	ENDIF
1893	ELSE
1894	IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT(-zlon), 'w'
1895	ELSE ; WRITE(clon, '(f5.1,a)') -zlon , 'w'
1896	ENDIF
1897	ENDIF
1898	IF( zlat >= 0. ) THEN
1899	IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT( zlat), 'n'
1900	ELSE ; WRITE(clat, '(f4.1,a)') zlat , 'n'
1901	ENDIF
1902	ELSE
1903	IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT(-zlat), 's'
1904	ELSE ; WRITE(clat, '(f4.1,a)') -zlat , 's'
1905	ENDIF
1906	ENDIF
1907	clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
1908	#if ! defined key_xios2
1909	CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)
1910	#else
1911	CALL iom_set_zoom_domain_attr (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1)
1912	#endif
1913	CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff )
1914	CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
1915	CALL iom_update_file_name(TRIM(clname)//cl1)
1916	END DO
1917	END DO
1918	END DO
1919
1920	END SUBROUTINE set_mooring
1921
1922
1923	SUBROUTINE iom_update_file_name( cdid )
1924	!!----------------------------------------------------------------------
1925	!! * ROUTINE iom_update_file_name *
1926	!!
1927	!! ** Purpose :
1928	!!
1929	!!----------------------------------------------------------------------
1930	CHARACTER(LEN=*) , INTENT(in) :: cdid
1931	!
1932	CHARACTER(LEN=256) :: clname
1933	CHARACTER(LEN=20) :: clfreq
1934	CHARACTER(LEN=20) :: cldate
1935	INTEGER :: idx
1936	INTEGER :: jn
1937	INTEGER :: itrlen
1938	INTEGER :: iyear, imonth, iday, isec
1939	REAL(wp) :: zsec
1940	LOGICAL :: llexist
1941	#if defined key_xios2
1942	TYPE(xios_duration) :: output_freq
1943	#endif
1944	!!----------------------------------------------------------------------
1945
1946
1947	DO jn = 1,2
1948	#if ! defined key_xios2
1949	IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq )
1950	#else
1951	output_freq = xios_duration(0,0,0,0,0,0)
1952	IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq )
1953	#endif
1954	IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname )
1955
1956	IF ( TRIM(clname) /= '' ) THEN
1957
1958	idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
1959	DO WHILE ( idx /= 0 )
1960	clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
1961	idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
1962	END DO
1963
1964	#if ! defined key_xios2
1965	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1966	DO WHILE ( idx /= 0 )
1967	IF ( TRIM(clfreq) /= '' ) THEN
1968	itrlen = LEN_TRIM(clfreq)
1969	IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1)
1970	clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname))
1971	ELSE
1972	CALL ctl_stop('error in the name of file id '//TRIM(cdid), &
1973	& ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
1974	ENDIF
1975	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1976	END DO
1977	#else
1978	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1979	DO WHILE ( idx /= 0 )
1980	IF ( output_freq%timestep /= 0) THEN
1981	WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts'
1982	itrlen = LEN_TRIM(ADJUSTL(clfreq))
1983	ELSE IF ( output_freq%hour /= 0 ) THEN
1984	WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'
1985	itrlen = LEN_TRIM(ADJUSTL(clfreq))
1986	ELSE IF ( output_freq%day /= 0 ) THEN
1987	WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d'
1988	itrlen = LEN_TRIM(ADJUSTL(clfreq))
1989	ELSE IF ( output_freq%month /= 0 ) THEN
1990	WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m'
1991	itrlen = LEN_TRIM(ADJUSTL(clfreq))
1992	ELSE IF ( output_freq%year /= 0 ) THEN
1993	WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y'
1994	itrlen = LEN_TRIM(ADJUSTL(clfreq))
1995	ELSE
1996	CALL ctl_stop('error in the name of file id '//TRIM(cdid), &
1997	& ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
1998	ENDIF
1999	clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
2000	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
2001	END DO
2002	#endif
2003	idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
2004	DO WHILE ( idx /= 0 )
2005	cldate = iom_sdate( fjulday - rdttra(1) / rday )
2006	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
2007	idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
2008	END DO
2009
2010	idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
2011	DO WHILE ( idx /= 0 )
2012	cldate = iom_sdate( fjulday - rdttra(1) / rday, ldfull = .TRUE. )
2013	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
2014	idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
2015	END DO
2016
2017	idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
2018	DO WHILE ( idx /= 0 )
2019	cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
2020	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
2021	idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
2022	END DO
2023
2024	idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
2025	DO WHILE ( idx /= 0 )
2026	cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
2027	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
2028	idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
2029	END DO
2030
2031	IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
2032	IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname )
2033	IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname )
2034
2035	ENDIF
2036
2037	END DO
2038
2039	END SUBROUTINE iom_update_file_name
2040
2041
2042	FUNCTION iom_sdate( pjday, ld24, ldfull )
2043	!!----------------------------------------------------------------------
2044	!! * ROUTINE iom_sdate *
2045	!!
2046	!! ** Purpose : send back the date corresponding to the given julian day
2047	!!
2048	!!----------------------------------------------------------------------
2049	REAL(wp), INTENT(in ) :: pjday ! julian day
2050	LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00
2051	LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss
2052	!
2053	CHARACTER(LEN=20) :: iom_sdate
2054	CHARACTER(LEN=50) :: clfmt ! format used to write the date
2055	INTEGER :: iyear, imonth, iday, ihour, iminute, isec
2056	REAL(wp) :: zsec
2057	LOGICAL :: ll24, llfull
2058	!
2059	IF( PRESENT(ld24) ) THEN ; ll24 = ld24
2060	ELSE ; ll24 = .FALSE.
2061	ENDIF
2062
2063	IF( PRESENT(ldfull) ) THEN ; llfull = ldfull
2064	ELSE ; llfull = .FALSE.
2065	ENDIF
2066
2067	CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
2068	isec = NINT(zsec)
2069
2070	IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day
2071	CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec )
2072	isec = 86400
2073	ENDIF
2074
2075	IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date
2076	ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
2077	ENDIF
2078
2079	!$AGRIF_DO_NOT_TREAT
2080	! Should be fixed in the conv
2081	IF( llfull ) THEN
2082	clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
2083	ihour = isec / 3600
2084	isec = MOD(isec, 3600)
2085	iminute = isec / 60
2086	isec = MOD(isec, 60)
2087	WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec ! date of the end of run
2088	ELSE
2089	WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run
2090	ENDIF
2091	!$AGRIF_END_DO_NOT_TREAT
2092
2093	END FUNCTION iom_sdate
2094
2095	#else
2096
2097
2098	SUBROUTINE iom_setkt( kt, cdname )
2099	INTEGER , INTENT(in):: kt
2100	CHARACTER(LEN=*), INTENT(in) :: cdname
2101	IF( .FALSE. ) WRITE(numout,*) kt, cdname ! useless test to avoid compilation warnings
2102	END SUBROUTINE iom_setkt
2103
2104	SUBROUTINE iom_context_finalize( cdname )
2105	CHARACTER(LEN=*), INTENT(in) :: cdname
2106	IF( .FALSE. ) WRITE(numout,*) cdname ! useless test to avoid compilation warnings
2107	END SUBROUTINE iom_context_finalize
2108
2109	#endif
2110
2111	LOGICAL FUNCTION iom_use( cdname )
2112	CHARACTER(LEN=*), INTENT(in) :: cdname
2113	#if defined key_iomput
2114	iom_use = xios_field_is_active( cdname )
2115	#else
2116	iom_use = .FALSE.
2117	#endif
2118	END FUNCTION iom_use
2119
2120	!!======================================================================
2121	END MODULE iom

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

Download in other formats: