Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

iom.F90

Last change on this file was 15033, checked in by smasson, 3 years ago
trunk: suppress jpim1 et jpjm1, #2699
Property svn:keywords set to `Id`
File size: 142.0 KB

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

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

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

Context Navigation

source: NEMO/trunk/src/OCE/IOM/iom.F90

Download in other formats: