Context Navigation

iom.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 101.4 KB

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

Download in other formats: