Context Navigation

iom.F90 @ 11018

Last change on this file since 11018 was 9830, checked in by frrh, 6 years ago

Merge revisions 9607:9721 of/branches/UKMO/dev_r5518_GO6_diag_bitcomp
into GO6 package branch.

This change ensures most 2D and 3D diagnostics produced by NEMO and MEDUSA
are bit reproducible on different PE decompositions.

Command used:
svn merge -r 9607:9721 svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/UKMO/dev_r5518_GO6_diag_bitcomp

Met Office GMED ticket 389 refers.

This change applies a mask to all duplicate grid points
output on diagnistic grids for T, U and V points. i.e. it masks
any wrap columns and duplicated grid points across the N-fold.
Fields affected are all "standard" NEMO diagnostics (scalar and
diaptr diagnostics are not on "normal" grids).

It also introduces some corrections/initialisations to achieve
PE decomposition bit comparison.

Most 2D or 3D fields are now bit comparable on different PE decompositions.
Only diaptr diagnostics can not be guaranteed bit reproducible
(due to their method of computation).

This change does nothing to CICE output.

Model evolution is unaffected.

File size: 101.3 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
[679]	486	IF(lwp) 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...
[4245]	926	IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
[1191]	927
[679]	928	!--- overlap areas and extra hallows (mpp)
	929	IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
	930	CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
	931	ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
	932	! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
	933	IF( icnt(3) == jpk ) THEN
	934	CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
	935	ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...)
	936	DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO
	937	DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO
	938	ENDIF
	939	ENDIF
	940
[3764]	941	! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
	942	IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. )
	943	IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. )
	944
[679]	945	!--- Apply scale_factor and offset
	946	zscf = iom_file(kiomid)%scf(idvar) ! scale factor
	947	zofs = iom_file(kiomid)%ofs(idvar) ! offset
	948	IF( PRESENT(pv_r1d) ) THEN
	949	IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf
	950	IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs
	951	ELSEIF( PRESENT(pv_r2d) ) THEN
[1697]	952	!CDIR COLLAPSE
[679]	953	IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf
[1697]	954	!CDIR COLLAPSE
[679]	955	IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs
	956	ELSEIF( PRESENT(pv_r3d) ) THEN
[1697]	957	!CDIR COLLAPSE
[679]	958	IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
[1697]	959	!CDIR COLLAPSE
[679]	960	IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
	961	ENDIF
	962	!
[544]	963	ENDIF
	964	!
	965	ENDIF
	966	!
	967	END SUBROUTINE iom_get_123d
	968
	969
[911]	970	SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
[544]	971	!!--------------------------------------------------------------------
	972	!! * SUBROUTINE iom_gettime *
	973	!!
	974	!! ** Purpose : read the time axis cdvar in the file
	975	!!--------------------------------------------------------------------
[911]	976	INTEGER , INTENT(in ) :: kiomid ! file Identifier
	977	REAL(wp), DIMENSION(:) , INTENT( out) :: ptime ! the time axis
	978	CHARACTER(len=*), OPTIONAL , INTENT(in ) :: cdvar ! time axis name
	979	INTEGER , OPTIONAL , INTENT( out) :: kntime ! number of times in file
	980	CHARACTER(len=*), OPTIONAL , INTENT( out) :: cdunits ! units attribute of time coordinate
	981	CHARACTER(len=*), OPTIONAL , INTENT( out) :: cdcalendar ! calendar attribute of
[544]	982	!
[911]	983	INTEGER, DIMENSION(1) :: kdimsz
[544]	984	INTEGER :: idvar ! id of the variable
[911]	985	CHARACTER(LEN=32) :: tname ! local name of time coordinate
[544]	986	CHARACTER(LEN=100) :: clinfo ! info character
	987	!---------------------------------------------------------------------
	988	!
[911]	989	IF ( PRESENT(cdvar) ) THEN
	990	tname = cdvar
	991	ELSE
	992	tname = iom_file(kiomid)%uldname
	993	ENDIF
[679]	994	IF( kiomid > 0 ) THEN
[911]	995	clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
	996	IF ( PRESENT(kntime) ) THEN
	997	idvar = iom_varid( kiomid, tname, kdimsz = kdimsz )
	998	kntime = kdimsz(1)
	999	ELSE
	1000	idvar = iom_varid( kiomid, tname )
	1001	ENDIF
[679]	1002	!
	1003	ptime(:) = 0. ! default definition
	1004	IF( idvar > 0 ) THEN
	1005	IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
	1006	IF( iom_file(kiomid)%luld(idvar) ) THEN
[2499]	1007	IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
[679]	1008	SELECT CASE (iom_file(kiomid)%iolib)
[911]	1009	CASE (jpioipsl ) ; CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
	1010	CASE (jpnf90 ) ; CALL iom_nf90_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
[679]	1011	CASE (jprstdimg) ; CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' )
	1012	CASE DEFAULT
	1013	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	1014	END SELECT
	1015	ELSE
	1016	WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
	1017	CALL ctl_stop( trim(clinfo), trim(ctmp1) )
	1018	ENDIF
[544]	1019	ELSE
[679]	1020	CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
[544]	1021	ENDIF
	1022	ELSE
[679]	1023	CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
[544]	1024	ENDIF
	1025	ELSE
[679]	1026	CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
[544]	1027	ENDIF
	1028	ENDIF
	1029	!
	1030	END SUBROUTINE iom_gettime
	1031
	1032
	1033	!!----------------------------------------------------------------------
[2528]	1034	!! INTERFACE iom_getatt
	1035	!!----------------------------------------------------------------------
	1036	SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
[8308]	1037	INTEGER , INTENT(in ) :: kiomid !Identifier of the file
[2528]	1038	CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute
	1039	INTEGER , INTENT( out) :: pvar ! read field
	1040	!
	1041	IF( kiomid > 0 ) THEN
	1042	IF( iom_file(kiomid)%nfid > 0 ) THEN
	1043	SELECT CASE (iom_file(kiomid)%iolib)
	1044	CASE (jpioipsl ) ; CALL ctl_stop('iom_getatt: only nf90 available')
	1045	CASE (jpnf90 ) ; CALL iom_nf90_getatt( kiomid, cdatt, pvar )
	1046	CASE (jprstdimg) ; CALL ctl_stop('iom_getatt: only nf90 available')
	1047	CASE DEFAULT
	1048	CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	1049	END SELECT
	1050	ENDIF
	1051	ENDIF
	1052	END SUBROUTINE iom_g0d_intatt
	1053
	1054
	1055	!!----------------------------------------------------------------------
[544]	1056	!! INTERFACE iom_rstput
	1057	!!----------------------------------------------------------------------
[550]	1058	SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
[544]	1059	INTEGER , INTENT(in) :: kt ! ocean time-step
	1060	INTEGER , INTENT(in) :: kwrite ! writing time-step
	1061	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
	1062	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
[556]	1063	REAL(wp) , INTENT(in) :: pvar ! written field
[544]	1064	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
	1065	INTEGER :: ivid ! variable id
[679]	1066	IF( kiomid > 0 ) THEN
	1067	IF( iom_file(kiomid)%nfid > 0 ) THEN
[745]	1068	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
[679]	1069	SELECT CASE (iom_file(kiomid)%iolib)
	1070	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
	1071	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
	1072	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar )
	1073	CASE DEFAULT
	1074	CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	1075	END SELECT
	1076	ENDIF
	1077	ENDIF
[550]	1078	END SUBROUTINE iom_rp0d
[544]	1079
[550]	1080	SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
[544]	1081	INTEGER , INTENT(in) :: kt ! ocean time-step
	1082	INTEGER , INTENT(in) :: kwrite ! writing time-step
	1083	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
	1084	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
[2715]	1085	REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field
[544]	1086	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
	1087	INTEGER :: ivid ! variable id
[679]	1088	IF( kiomid > 0 ) THEN
	1089	IF( iom_file(kiomid)%nfid > 0 ) THEN
[745]	1090	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
[679]	1091	SELECT CASE (iom_file(kiomid)%iolib)
	1092	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
	1093	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
	1094	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar )
	1095	CASE DEFAULT
	1096	CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	1097	END SELECT
	1098	ENDIF
	1099	ENDIF
[550]	1100	END SUBROUTINE iom_rp1d
[544]	1101
[550]	1102	SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
[544]	1103	INTEGER , INTENT(in) :: kt ! ocean time-step
	1104	INTEGER , INTENT(in) :: kwrite ! writing time-step
	1105	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
	1106	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
[2715]	1107	REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field
[544]	1108	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
	1109	INTEGER :: ivid ! variable id
[679]	1110	IF( kiomid > 0 ) THEN
	1111	IF( iom_file(kiomid)%nfid > 0 ) THEN
[745]	1112	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
[679]	1113	SELECT CASE (iom_file(kiomid)%iolib)
	1114	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
	1115	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
	1116	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar )
	1117	CASE DEFAULT
	1118	CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
	1119	END SELECT
	1120	ENDIF
	1121	ENDIF
[550]	1122	END SUBROUTINE iom_rp2d
[544]	1123
[550]	1124	SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
[544]	1125	INTEGER , INTENT(in) :: kt ! ocean time-step
	1126	INTEGER , INTENT(in) :: kwrite ! writing time-step
	1127	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
	1128	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
[2715]	1129	REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field
[544]	1130	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
	1131	INTEGER :: ivid ! variable id
[679]	1132	IF( kiomid > 0 ) THEN
	1133	IF( iom_file(kiomid)%nfid > 0 ) THEN
[745]	1134	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
[679]	1135	SELECT CASE (iom_file(kiomid)%iolib)
	1136	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
	1137	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
	1138	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar )
	1139	CASE DEFAULT
	1140	CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
	1141	END SELECT
	1142	ENDIF
	1143	ENDIF
[550]	1144	END SUBROUTINE iom_rp3d
[1359]	1145
	1146
[544]	1147	!!----------------------------------------------------------------------
[1457]	1148	!! INTERFACE iom_put
[1359]	1149	!!----------------------------------------------------------------------
[1738]	1150	SUBROUTINE iom_p0d( cdname, pfield0d )
	1151	CHARACTER(LEN=*), INTENT(in) :: cdname
	1152	REAL(wp) , INTENT(in) :: pfield0d
[8308]	1153	#if ! defined key_xios2
[5426]	1154	REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson
[8308]	1155	#endif
[1738]	1156	#if defined key_iomput
[8308]	1157	#if ! defined key_xios2
[5426]	1158	zz(:,:)=pfield0d
	1159	CALL xios_send_field(cdname, zz)
[1738]	1160	#else
[8308]	1161	CALL xios_send_field(cdname, (/pfield0d/))
	1162	#endif
	1163	#else
[1738]	1164	IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings
	1165	#endif
	1166	END SUBROUTINE iom_p0d
	1167
[3294]	1168	SUBROUTINE iom_p1d( cdname, pfield1d )
	1169	CHARACTER(LEN=*) , INTENT(in) :: cdname
	1170	REAL(wp), DIMENSION(:), INTENT(in) :: pfield1d
	1171	#if defined key_iomput
[3695]	1172	CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
[3294]	1173	#else
	1174	IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings
	1175	#endif
	1176	END SUBROUTINE iom_p1d
	1177
[1359]	1178	SUBROUTINE iom_p2d( cdname, pfield2d )
	1179	CHARACTER(LEN=*) , INTENT(in) :: cdname
[2715]	1180	REAL(wp), DIMENSION(:,:), INTENT(in) :: pfield2d
[1412]	1181	#if defined key_iomput
[3695]	1182	CALL xios_send_field(cdname, pfield2d)
[1520]	1183	#else
	1184	IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings
[1359]	1185	#endif
	1186	END SUBROUTINE iom_p2d
[544]	1187
[1359]	1188	SUBROUTINE iom_p3d( cdname, pfield3d )
	1189	CHARACTER(LEN=*) , INTENT(in) :: cdname
[2715]	1190	REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d
[1412]	1191	#if defined key_iomput
[3695]	1192	CALL xios_send_field(cdname, pfield3d)
[1520]	1193	#else
	1194	IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings
[1359]	1195	#endif
	1196	END SUBROUTINE iom_p3d
	1197	!!----------------------------------------------------------------------
[544]	1198
[1412]	1199	#if defined key_iomput
[1359]	1200
[4148]	1201	SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, &
[5363]	1202	& data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, &
[5415]	1203	& nvertex, bounds_lon, bounds_lat, area )
[5363]	1204	CHARACTER(LEN=*) , INTENT(in) :: cdid
	1205	INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj
	1206	INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj
	1207	INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex
	1208	REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue
[5415]	1209	REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area
[6498]	1210	#if ! defined key_xios2
	1211	LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask
	1212	#else
	1213	LOGICAL, DIMENSION(:) , OPTIONAL, INTENT(in) :: mask
	1214	#endif
[3695]	1215
[6487]	1216	#if ! defined key_xios2
[4148]	1217	IF ( xios_is_valid_domain (cdid) ) THEN
	1218	CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
	1219	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
	1220	& zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, &
[5415]	1221	& lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, &
	1222	& bounds_lat=bounds_lat, area=area )
[6487]	1223	ENDIF
[4148]	1224	IF ( xios_is_valid_domaingroup(cdid) ) THEN
	1225	CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
	1226	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
	1227	& zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, &
[5415]	1228	& lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, &
	1229	& bounds_lat=bounds_lat, area=area )
[3695]	1230	ENDIF
[6487]	1231
	1232	#else
	1233	IF ( xios_is_valid_domain (cdid) ) THEN
	1234	CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
	1235	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
[6498]	1236	& lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, &
[6487]	1237	& bounds_lat_1D=bounds_lat, area=area, type='curvilinear')
	1238	ENDIF
	1239	IF ( xios_is_valid_domaingroup(cdid) ) THEN
	1240	CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
	1241	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
[6498]	1242	& lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, &
[6487]	1243	& bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
	1244	ENDIF
	1245	#endif
[4148]	1246	CALL xios_solve_inheritance()
[3695]	1247
	1248	END SUBROUTINE iom_set_domain_attr
	1249
[6487]	1250	#if defined key_xios2
	1251	SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj)
	1252	CHARACTER(LEN=*) , INTENT(in) :: cdid
	1253	INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj
[3695]	1254
[6498]	1255	IF ( xios_is_valid_zoom_domain (cdid) ) THEN
[6487]	1256	CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, &
	1257	& nj=nj)
	1258	ENDIF
	1259	END SUBROUTINE iom_set_zoom_domain_attr
	1260	#endif
	1261
	1262
[5415]	1263	SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
[4148]	1264	CHARACTER(LEN=*) , INTENT(in) :: cdid
[5415]	1265	REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis
	1266	REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds
	1267	IF ( PRESENT(paxis) ) THEN
[6487]	1268	#if ! defined key_xios2
[5415]	1269	IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis )
	1270	IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis )
[6487]	1271	#else
	1272	IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis )
	1273	IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis )
	1274	#endif
[5415]	1275	ENDIF
	1276	IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds )
	1277	IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds )
[4148]	1278	CALL xios_solve_inheritance()
[3737]	1279	END SUBROUTINE iom_set_axis_attr
	1280
[4148]	1281	SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
	1282	CHARACTER(LEN=*) , INTENT(in) :: cdid
[6487]	1283	#if ! defined key_xios2
	1284	CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_op
	1285	CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_offset
	1286	#else
	1287	TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op
	1288	TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset
	1289	#endif
	1290	IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr &
	1291	& ( cdid, freq_op=freq_op, freq_offset=freq_offset )
	1292	IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr &
	1293	& ( cdid, freq_op=freq_op, freq_offset=freq_offset )
[4148]	1294	CALL xios_solve_inheritance()
[3695]	1295	END SUBROUTINE iom_set_field_attr
	1296
[4148]	1297	SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
	1298	CHARACTER(LEN=*) , INTENT(in) :: cdid
[3695]	1299	CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix
[4148]	1300	IF ( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix )
	1301	IF ( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
	1302	CALL xios_solve_inheritance()
[3771]	1303	END SUBROUTINE iom_set_file_attr
[3695]	1304
	1305
[4148]	1306	SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
	1307	CHARACTER(LEN=*) , INTENT(in ) :: cdid
[6487]	1308	CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix
	1309	#if ! defined key_xios2
	1310	CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: output_freq
	1311	#else
	1312	TYPE(xios_duration) ,OPTIONAL , INTENT(out) :: output_freq
	1313	#endif
[4148]	1314	LOGICAL :: llexist1,llexist2,llexist3
	1315	!---------------------------------------------------------------------
	1316	IF( PRESENT( name ) ) name = '' ! default values
	1317	IF( PRESENT( name_suffix ) ) name_suffix = ''
[6487]	1318	#if ! defined key_xios2
[4148]	1319	IF( PRESENT( output_freq ) ) output_freq = ''
[6487]	1320	#else
	1321	IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0)
	1322	#endif
[4148]	1323	IF ( xios_is_valid_file (cdid) ) THEN
	1324	CALL xios_solve_inheritance()
	1325	CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
	1326	IF(llexist1) CALL xios_get_file_attr ( cdid, name = name )
	1327	IF(llexist2) CALL xios_get_file_attr ( cdid, name_suffix = name_suffix )
	1328	IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq )
	1329	ENDIF
	1330	IF ( xios_is_valid_filegroup(cdid) ) THEN
	1331	CALL xios_solve_inheritance()
	1332	CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
	1333	IF(llexist1) CALL xios_get_filegroup_attr( cdid, name = name )
	1334	IF(llexist2) CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
	1335	IF(llexist3) CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
	1336	ENDIF
	1337	END SUBROUTINE iom_get_file_attr
	1338
	1339
	1340	SUBROUTINE iom_set_grid_attr( cdid, mask )
	1341	CHARACTER(LEN=*) , INTENT(in) :: cdid
[3771]	1342	LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask
[6487]	1343	#if ! defined key_xios2
[4148]	1344	IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask )
	1345	IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask )
[6487]	1346	#else
[6498]	1347	IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask )
	1348	IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask )
[6487]	1349	#endif
[4148]	1350	CALL xios_solve_inheritance()
[3771]	1351	END SUBROUTINE iom_set_grid_attr
[3695]	1352
[4152]	1353	SUBROUTINE iom_setkt( kt, cdname )
	1354	INTEGER , INTENT(in) :: kt
	1355	CHARACTER(LEN=*), INTENT(in) :: cdname
	1356	!
	1357	CALL iom_swap( cdname ) ! swap to cdname context
	1358	CALL xios_update_calendar(kt)
[5407]	1359	IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context
[4152]	1360	!
	1361	END SUBROUTINE iom_setkt
[3695]	1362
[4152]	1363	SUBROUTINE iom_context_finalize( cdname )
	1364	CHARACTER(LEN=*), INTENT(in) :: cdname
	1365	!
[4990]	1366	IF( xios_is_valid_context(cdname) ) THEN
	1367	CALL iom_swap( cdname ) ! swap to cdname context
	1368	CALL xios_context_finalize() ! finalize the context
[5407]	1369	IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context
[4990]	1370	ENDIF
	1371	!
[4152]	1372	END SUBROUTINE iom_context_finalize
	1373
	1374
[3771]	1375	SUBROUTINE set_grid( cdgrd, plon, plat )
[1359]	1376	!!----------------------------------------------------------------------
[4148]	1377	!! * ROUTINE set_grid *
[1359]	1378	!!
[1725]	1379	!! ** Purpose : define horizontal grids
[1359]	1380	!!
	1381	!!----------------------------------------------------------------------
[3771]	1382	CHARACTER(LEN=1) , INTENT(in) :: cdgrd
[1359]	1383	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon
	1384	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
[3771]	1385	!
	1386	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask
[3695]	1387	INTEGER :: ni,nj
	1388
	1389	ni=nlei-nldi+1 ; nj=nlej-nldj+1
[1359]	1390
[6487]	1391	#if ! defined key_xios2
	1392	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)
	1393	#else
	1394	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)
	1395	#endif
[3771]	1396	CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
	1397	CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), &
	1398	& latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
	1399
	1400	IF ( ln_mskland ) THEN
	1401	! mask land points, keep values on coast line -> specific mask for U, V and W points
[9830]	1402
	1403
[3771]	1404	SELECT CASE ( cdgrd )
[9830]	1405	! The masks applied here are specifically used to mask out duplicate
	1406	! data points in wrap columns and N-fold rows in order to ensure bit
	1407	! reproducibility of diagnostics which have not undergone an explicit
	1408	! lbc_lnk prior to writing. Such fields are prone to junk values at
	1409	! duplicate points since those points are often excluded from the
	1410	! core field computation process.
	1411	CASE('T')
	1412	zmask(:,:,:) = tmask_i_diag(:,:,:)
	1413	CASE('U')
	1414	zmask(:,:,:) = umask_i_diag(:,:,:)
	1415	CASE('V')
	1416	zmask(:,:,:) = vmask_i_diag(:,:,:)
	1417	CASE('W')
	1418	zmask(:,:,2:jpk ) = tmask_i_diag(:,:,1:jpkm1) + tmask_i_diag(:,:,2:jpk)
	1419	zmask(:,:,1) = tmask_i_diag(:,:,1)
	1420	END SELECT
[3771]	1421	!
[6498]	1422	#if ! defined key_xios2
[4148]	1423	CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj /)) /= 0. )
[6498]	1424	#else
	1425	CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj /)) /= 0. )
	1426	#endif
[4148]	1427	CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
[3771]	1428	ENDIF
[3695]	1429
[1359]	1430	END SUBROUTINE set_grid
	1431
[1725]	1432
[5415]	1433	SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
[5363]	1434	!!----------------------------------------------------------------------
	1435	!! * ROUTINE set_grid_bounds *
	1436	!!
	1437	!! ** Purpose : define horizontal grid corners
	1438	!!
	1439	!!----------------------------------------------------------------------
	1440	CHARACTER(LEN=1) , INTENT(in) :: cdgrd
	1441	!
[5415]	1442	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j)
	1443	REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j)
	1444	!
[5363]	1445	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j)
	1446	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells
	1447	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells
	1448	!
	1449	INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr)
	1450	! ! represents the bottom-left corner of cell (i,j)
	1451	INTEGER :: ji, jj, jn, ni, nj
	1452
[5415]	1453	ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) )
[5363]	1454
[5415]	1455	! Offset of coordinate representing bottom-left corner
[5363]	1456	SELECT CASE ( TRIM(cdgrd) )
	1457	CASE ('T', 'W')
	1458	icnr = -1 ; jcnr = -1
	1459	CASE ('U')
	1460	icnr = 0 ; jcnr = -1
	1461	CASE ('V')
	1462	icnr = -1 ; jcnr = 0
	1463	END SELECT
	1464
	1465	ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior
	1466
	1467	z_fld(:,:) = 1._wp
	1468	CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold
	1469
	1470	! Cell vertices that can be defined
	1471	DO jj = 2, jpjm1
	1472	DO ji = 2, jpim1
[5415]	1473	z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left
	1474	z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right
	1475	z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
	1476	z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left
	1477	z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left
	1478	z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right
	1479	z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right
	1480	z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left
[5363]	1481	END DO
	1482	END DO
	1483
	1484	! Cell vertices on boundries
	1485	DO jn = 1, 4
	1486	CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp )
	1487	CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp )
	1488	END DO
	1489
[5415]	1490	! Zero-size cells at closed boundaries if cell points provided,
	1491	! otherwise they are closed cells with unrealistic bounds
	1492	IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN
	1493	IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
	1494	DO jn = 1, 4 ! (West or jpni = 1), closed E-W
	1495	z_bnds(jn,1,:,1) = plat_pnt(1,:) ; z_bnds(jn,1,:,2) = plon_pnt(1,:)
	1496	END DO
	1497	ENDIF
	1498	IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN
	1499	DO jn = 1, 4 ! (East or jpni = 1), closed E-W
	1500	z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:)
	1501	END DO
	1502	ENDIF
	1503	IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN
	1504	DO jn = 1, 4 ! South or (jpnj = 1, not symmetric)
	1505	z_bnds(jn,:,1,1) = plat_pnt(:,1) ; z_bnds(jn,:,1,2) = plon_pnt(:,1)
	1506	END DO
	1507	ENDIF
	1508	IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN
	1509	DO jn = 1, 4 ! (North or jpnj = 1), no north fold
	1510	z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj)
	1511	END DO
	1512	ENDIF
[5363]	1513	ENDIF
	1514
	1515	! Rotate cells at the north fold
	1516	IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN
	1517	DO jj = 1, jpj
	1518	DO ji = 1, jpi
	1519	IF( z_fld(ji,jj) == -1. ) THEN
	1520	z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:)
	1521	z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:)
	1522	z_bnds(:,ji,jj,:) = z_rot(:,:)
	1523	ENDIF
	1524	END DO
	1525	END DO
	1526
	1527	! Invert cells at the symmetric equator
	1528	ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN
	1529	DO ji = 1, jpi
	1530	z_rot(1:2,:) = z_bnds(3:4,ji,1,:)
	1531	z_rot(3:4,:) = z_bnds(1:2,ji,1,:)
	1532	z_bnds(:,ji,1,:) = z_rot(:,:)
	1533	END DO
	1534	ENDIF
	1535
	1536	CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), &
	1537	bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 )
	1538
[5415]	1539	DEALLOCATE( z_bnds, z_fld, z_rot )
[5363]	1540
	1541	END SUBROUTINE set_grid_bounds
	1542
	1543
[5385]	1544	SUBROUTINE set_grid_znl( plat )
	1545	!!----------------------------------------------------------------------
	1546	!! * ROUTINE set_grid_znl *
	1547	!!
	1548	!! ** Purpose : define grids for zonal mean
	1549	!!
	1550	!!----------------------------------------------------------------------
	1551	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
	1552	!
	1553	REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon
	1554	INTEGER :: ni,nj, ix, iy
	1555
	1556
	1557	ni=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk)
	1558	ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0.
	1559
[7750]	1560	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]	1561	#if ! defined key_xios2
[5385]	1562	CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)
	1563	CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
	1564	CALL iom_set_domain_attr("gznl", lonvalue = zlon, &
	1565	& latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
	1566	!
	1567	CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)
[6487]	1568	#else
	1569	! Pas teste : attention aux indices !
[6498]	1570	CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj)
	1571	CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
	1572	CALL iom_set_domain_attr("gznl", lonvalue = zlon, &
[6487]	1573	& latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
[6498]	1574	CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
[6487]	1575	#endif
	1576
[5385]	1577	CALL iom_update_file_name('ptr')
	1578	!
	1579	END SUBROUTINE set_grid_znl
	1580
[1738]	1581	SUBROUTINE set_scalar
	1582	!!----------------------------------------------------------------------
[4148]	1583	!! * ROUTINE set_scalar *
[1738]	1584	!!
	1585	!! ** Purpose : define fake grids for scalar point
	1586	!!
	1587	!!----------------------------------------------------------------------
[5426]	1588	REAL(wp), DIMENSION(1) :: zz = 1.
[1738]	1589	!!----------------------------------------------------------------------
[6498]	1590	#if ! defined key_xios2
[3695]	1591	CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
[6498]	1592	#else
	1593	CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1)
	1594	#endif
[5426]	1595	CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
[5415]	1596
[4689]	1597	zz=REAL(narea,wp)
[5426]	1598	CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
[6487]	1599
[1738]	1600	END SUBROUTINE set_scalar
	1601
[7179]	1602	SUBROUTINE set_1point
	1603	!!----------------------------------------------------------------------
	1604	!! * ROUTINE set_1point *
	1605	!!
	1606	!! ** Purpose : define zoom grid for scalar fields
	1607	!!
	1608	!!----------------------------------------------------------------------
	1609	REAL(wp), DIMENSION(1) :: zz = 1.
	1610	INTEGER :: ix, iy
	1611	!!----------------------------------------------------------------------
	1612	CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! Nearest point to north pole should be ocean
	1613	CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy)
[1738]	1614
[7179]	1615	END SUBROUTINE set_1point
	1616
	1617
	1618
[1725]	1619	SUBROUTINE set_xmlatt
	1620	!!----------------------------------------------------------------------
[4148]	1621	!! * ROUTINE set_xmlatt *
[1725]	1622	!!
	1623	!! ** Purpose : automatic definitions of some of the xml attributs...
	1624	!!
	1625	!!----------------------------------------------------------------------
	1626	CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name
[4148]	1627	CHARACTER(len=256) :: clsuff ! suffix name
[1725]	1628	CHARACTER(len=1) :: cl1 ! 1 character
[5003]	1629	CHARACTER(len=2) :: cl2 ! 2 characters
	1630	CHARACTER(len=3) :: cl3 ! 3 characters
[4148]	1631	INTEGER :: ji, jg ! loop counters
[1725]	1632	INTEGER :: ix, iy ! i-,j- index
	1633	REAL(wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings
	1634	REAL(wp) ,DIMENSION( 7) :: zlattao ! latitudes of tao moorings
	1635	REAL(wp) ,DIMENSION( 4) :: zlonrama ! longitudes of rama moorings
	1636	REAL(wp) ,DIMENSION(11) :: zlatrama ! latitudes of rama moorings
	1637	REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings
	1638	REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings
[6487]	1639	#if defined key_xios2
	1640	TYPE(xios_duration) :: f_op, f_of
	1641	#endif
	1642
[1725]	1643	!!----------------------------------------------------------------------
	1644	!
	1645	! frequency of the call of iom_put (attribut: freq_op)
[6487]	1646	#if ! defined key_xios2
	1647	WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts')
[8104]	1648	WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('trendT_even' , freq_op=cl1//'ts', freq_offset='0ts')
	1649	WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('trendT_odd' , freq_op=cl1//'ts', freq_offset='-1ts')
[9163]	1650	WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('ptrd_T_even' , freq_op=cl1//'ts', freq_offset='0ts')
	1651	WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('ptrd_T_odd' , freq_op=cl1//'ts', freq_offset='-1ts')
[6487]	1652	WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op=cl1//'ts', freq_offset='0ts')
	1653	WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op=cl1//'ts', freq_offset='0ts')
	1654	WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op=cl1//'ts', freq_offset='0ts')
	1655	WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op=cl1//'ts', freq_offset='0ts')
	1656	#else
	1657	f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)
[8104]	1658	f_op%timestep = 2 ; f_of%timestep = 0 ; CALL iom_set_field_attr('trendT_even' , freq_op=f_op, freq_offset=f_of)
	1659	f_op%timestep = 2 ; f_of%timestep = -1 ; CALL iom_set_field_attr('trendT_odd' , freq_op=f_op, freq_offset=f_of)
[9163]	1660	f_op%timestep = 2 ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrd_T_even' , freq_op=f_op, freq_offset=f_of)
	1661	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]	1662	f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of)
	1663	f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of)
	1664	f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of)
	1665	f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of)
	1666	#endif
[3695]	1667
[1725]	1668	! output file names (attribut: name)
[4148]	1669	DO ji = 1, 9
	1670	WRITE(cl1,'(i1)') ji
	1671	CALL iom_update_file_name('file'//cl1)
[1725]	1672	END DO
[4148]	1673	DO ji = 1, 99
	1674	WRITE(cl2,'(i2.2)') ji
	1675	CALL iom_update_file_name('file'//cl2)
	1676	END DO
[5003]	1677	DO ji = 1, 999
	1678	WRITE(cl3,'(i3.3)') ji
	1679	CALL iom_update_file_name('file'//cl3)
	1680	END DO
[1725]	1681
	1682	! Zooms...
	1683	clgrd = (/ 'T', 'U', 'W' /)
	1684	DO jg = 1, SIZE(clgrd) ! grid type
	1685	cl1 = clgrd(jg)
	1686	! Equatorial section (attributs: jbegin, ni, name_suffix)
	1687	CALL dom_ngb( 0., 0., ix, iy, cl1 )
[6487]	1688	#if ! defined key_xios2
[4148]	1689	CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)
[6487]	1690	#else
	1691	CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo)
	1692	#endif
[4148]	1693	CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff )
	1694	CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
	1695	CALL iom_update_file_name('Eq'//cl1)
[1725]	1696	END DO
	1697	! TAO moorings (attributs: ibegin, jbegin, name_suffix)
	1698	zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
	1699	zlattao = (/ -8.0, -5.0, -2.0, 0.0, 2.0, 5.0, 8.0 /)
	1700	CALL set_mooring( zlontao, zlattao )
	1701	! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
	1702	zlonrama = (/ 55.0, 67.0, 80.5, 90.0 /)
	1703	zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
	1704	CALL set_mooring( zlonrama, zlatrama )
	1705	! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
	1706	zlonpira = (/ -38.0, -23.0, -10.0 /)
	1707	zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
	1708	CALL set_mooring( zlonpira, zlatpira )
[5147]	1709
[1725]	1710
	1711	END SUBROUTINE set_xmlatt
	1712
	1713
	1714	SUBROUTINE set_mooring( plon, plat)
	1715	!!----------------------------------------------------------------------
[4148]	1716	!! * ROUTINE set_mooring *
[1725]	1717	!!
	1718	!! ** Purpose : automatic definitions of moorings xml attributs...
	1719	!!
	1720	!!----------------------------------------------------------------------
	1721	REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring
	1722	!
	1723	!!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name
	1724	CHARACTER(len=1),DIMENSION(1) :: clgrd = (/ 'T' /) ! suffix name
[4148]	1725	CHARACTER(len=256) :: clname ! file name
	1726	CHARACTER(len=256) :: clsuff ! suffix name
[1725]	1727	CHARACTER(len=1) :: cl1 ! 1 character
	1728	CHARACTER(len=6) :: clon,clat ! name of longitude, latitude
	1729	INTEGER :: ji, jj, jg ! loop counters
	1730	INTEGER :: ix, iy ! i-,j- index
	1731	REAL(wp) :: zlon, zlat
	1732	!!----------------------------------------------------------------------
	1733	DO jg = 1, SIZE(clgrd)
	1734	cl1 = clgrd(jg)
	1735	DO ji = 1, SIZE(plon)
	1736	DO jj = 1, SIZE(plat)
	1737	zlon = plon(ji)
	1738	zlat = plat(jj)
	1739	! modifications for RAMA moorings
	1740	IF( zlon == 67. .AND. zlat == 15. ) zlon = 65.
	1741	IF( zlon == 90. .AND. zlat <= -4. ) zlon = 95.
	1742	IF( zlon == 95. .AND. zlat == -4. ) zlat = -5.
	1743	! modifications for PIRATA moorings
	1744	IF( zlon == -38. .AND. zlat == -19. ) zlon = -34.
	1745	IF( zlon == -38. .AND. zlat == -14. ) zlon = -32.
	1746	IF( zlon == -38. .AND. zlat == -8. ) zlon = -30.
	1747	IF( zlon == -38. .AND. zlat == 0. ) zlon = -35.
	1748	IF( zlon == -23. .AND. zlat == 20. ) zlat = 21.
	1749	IF( zlon == -10. .AND. zlat == -14. ) zlat = -10.
	1750	IF( zlon == -10. .AND. zlat == -8. ) zlat = -6.
	1751	IF( zlon == -10. .AND. zlat == 4. ) THEN ; zlon = 0. ; zlat = 0. ; ENDIF
	1752	CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
	1753	IF( zlon >= 0. ) THEN
	1754	IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT( zlon), 'e'
	1755	ELSE ; WRITE(clon, '(f5.1,a)') zlon , 'e'
	1756	ENDIF
	1757	ELSE
	1758	IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT(-zlon), 'w'
	1759	ELSE ; WRITE(clon, '(f5.1,a)') -zlon , 'w'
	1760	ENDIF
	1761	ENDIF
	1762	IF( zlat >= 0. ) THEN
	1763	IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT( zlat), 'n'
	1764	ELSE ; WRITE(clat, '(f4.1,a)') zlat , 'n'
	1765	ENDIF
	1766	ELSE
	1767	IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT(-zlat), 's'
	1768	ELSE ; WRITE(clat, '(f4.1,a)') -zlat , 's'
	1769	ENDIF
	1770	ENDIF
	1771	clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
[6487]	1772	#if ! defined key_xios2
[4148]	1773	CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)
[6487]	1774	#else
	1775	CALL iom_set_zoom_domain_attr (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1)
	1776	#endif
[4148]	1777	CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff )
	1778	CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
	1779	CALL iom_update_file_name(TRIM(clname)//cl1)
[1725]	1780	END DO
	1781	END DO
	1782	END DO
	1783
	1784	END SUBROUTINE set_mooring
	1785
[4148]	1786
	1787	SUBROUTINE iom_update_file_name( cdid )
	1788	!!----------------------------------------------------------------------
	1789	!! * ROUTINE iom_update_file_name *
	1790	!!
	1791	!! ** Purpose :
	1792	!!
	1793	!!----------------------------------------------------------------------
	1794	CHARACTER(LEN=*) , INTENT(in) :: cdid
	1795	!
	1796	CHARACTER(LEN=256) :: clname
	1797	CHARACTER(LEN=20) :: clfreq
	1798	CHARACTER(LEN=20) :: cldate
	1799	INTEGER :: idx
	1800	INTEGER :: jn
	1801	INTEGER :: itrlen
	1802	INTEGER :: iyear, imonth, iday, isec
	1803	REAL(wp) :: zsec
	1804	LOGICAL :: llexist
[6487]	1805	#if defined key_xios2
	1806	TYPE(xios_duration) :: output_freq
	1807	#endif
[4148]	1808	!!----------------------------------------------------------------------
	1809
[6487]	1810
[4148]	1811	DO jn = 1,2
[6487]	1812	#if ! defined key_xios2
[4148]	1813	IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq )
[6487]	1814	#else
	1815	output_freq = xios_duration(0,0,0,0,0,0)
	1816	IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq )
	1817	#endif
[4148]	1818	IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname )
	1819
	1820	IF ( TRIM(clname) /= '' ) THEN
	1821
	1822	idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
	1823	DO WHILE ( idx /= 0 )
	1824	clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
	1825	idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
	1826	END DO
	1827
[6487]	1828	#if ! defined key_xios2
[4148]	1829	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
	1830	DO WHILE ( idx /= 0 )
	1831	IF ( TRIM(clfreq) /= '' ) THEN
	1832	itrlen = LEN_TRIM(clfreq)
	1833	IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1)
	1834	clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname))
	1835	ELSE
	1836	CALL ctl_stop('error in the name of file id '//TRIM(cdid), &
	1837	& ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
	1838	ENDIF
	1839	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
	1840	END DO
[6487]	1841	#else
	1842	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
	1843	DO WHILE ( idx /= 0 )
[6498]	1844	IF ( output_freq%timestep /= 0) THEN
	1845	WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts'
	1846	itrlen = LEN_TRIM(ADJUSTL(clfreq))
	1847	ELSE IF ( output_freq%hour /= 0 ) THEN
[6487]	1848	WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h'
	1849	itrlen = LEN_TRIM(ADJUSTL(clfreq))
	1850	ELSE IF ( output_freq%day /= 0 ) THEN
	1851	WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d'
	1852	itrlen = LEN_TRIM(ADJUSTL(clfreq))
	1853	ELSE IF ( output_freq%month /= 0 ) THEN
	1854	WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m'
	1855	itrlen = LEN_TRIM(ADJUSTL(clfreq))
	1856	ELSE IF ( output_freq%year /= 0 ) THEN
	1857	WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y'
	1858	itrlen = LEN_TRIM(ADJUSTL(clfreq))
	1859	ELSE
	1860	CALL ctl_stop('error in the name of file id '//TRIM(cdid), &
	1861	& ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
	1862	ENDIF
	1863	clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname))
	1864	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
	1865	END DO
	1866	#endif
[4148]	1867	idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
	1868	DO WHILE ( idx /= 0 )
	1869	cldate = iom_sdate( fjulday - rdttra(1) / rday )
	1870	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
	1871	idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
	1872	END DO
	1873
	1874	idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
	1875	DO WHILE ( idx /= 0 )
	1876	cldate = iom_sdate( fjulday - rdttra(1) / rday, ldfull = .TRUE. )
	1877	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
	1878	idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
	1879	END DO
	1880
	1881	idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
	1882	DO WHILE ( idx /= 0 )
	1883	cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
	1884	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
	1885	idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
	1886	END DO
	1887
	1888	idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
	1889	DO WHILE ( idx /= 0 )
	1890	cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
	1891	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
	1892	idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
	1893	END DO
	1894
[6487]	1895	IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
[4148]	1896	IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname )
	1897	IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname )
	1898
	1899	ENDIF
	1900
	1901	END DO
	1902
	1903	END SUBROUTINE iom_update_file_name
	1904
	1905
	1906	FUNCTION iom_sdate( pjday, ld24, ldfull )
	1907	!!----------------------------------------------------------------------
	1908	!! * ROUTINE iom_sdate *
	1909	!!
	1910	!! ** Purpose : send back the date corresponding to the given julian day
	1911	!!
	1912	!!----------------------------------------------------------------------
	1913	REAL(wp), INTENT(in ) :: pjday ! julian day
	1914	LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00
	1915	LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss
	1916	!
	1917	CHARACTER(LEN=20) :: iom_sdate
	1918	CHARACTER(LEN=50) :: clfmt ! format used to write the date
	1919	INTEGER :: iyear, imonth, iday, ihour, iminute, isec
	1920	REAL(wp) :: zsec
	1921	LOGICAL :: ll24, llfull
	1922	!
	1923	IF( PRESENT(ld24) ) THEN ; ll24 = ld24
	1924	ELSE ; ll24 = .FALSE.
	1925	ENDIF
	1926
	1927	IF( PRESENT(ldfull) ) THEN ; llfull = ldfull
	1928	ELSE ; llfull = .FALSE.
	1929	ENDIF
	1930
	1931	CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
	1932	isec = NINT(zsec)
	1933
	1934	IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day
	1935	CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec )
	1936	isec = 86400
	1937	ENDIF
	1938
	1939	IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date
	1940	ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
	1941	ENDIF
	1942
[6487]	1943	!$AGRIF_DO_NOT_TREAT
	1944	! Should be fixed in the conv
[4148]	1945	IF( llfull ) THEN
	1946	clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
	1947	ihour = isec / 3600
	1948	isec = MOD(isec, 3600)
	1949	iminute = isec / 60
	1950	isec = MOD(isec, 60)
	1951	WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec ! date of the end of run
	1952	ELSE
	1953	WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run
	1954	ENDIF
[6487]	1955	!$AGRIF_END_DO_NOT_TREAT
[4148]	1956
	1957	END FUNCTION iom_sdate
	1958
[1359]	1959	#else
	1960
[4152]	1961
	1962	SUBROUTINE iom_setkt( kt, cdname )
	1963	INTEGER , INTENT(in):: kt
	1964	CHARACTER(LEN=*), INTENT(in) :: cdname
	1965	IF( .FALSE. ) WRITE(numout,*) kt, cdname ! useless test to avoid compilation warnings
[1359]	1966	END SUBROUTINE iom_setkt
	1967
[4152]	1968	SUBROUTINE iom_context_finalize( cdname )
	1969	CHARACTER(LEN=*), INTENT(in) :: cdname
	1970	IF( .FALSE. ) WRITE(numout,*) cdname ! useless test to avoid compilation warnings
	1971	END SUBROUTINE iom_context_finalize
	1972
[1359]	1973	#endif
[4689]	1974
	1975	LOGICAL FUNCTION iom_use( cdname )
	1976	CHARACTER(LEN=*), INTENT(in) :: cdname
	1977	#if defined key_iomput
	1978	iom_use = xios_field_is_active( cdname )
	1979	#else
	1980	iom_use = .FALSE.
	1981	#endif
	1982	END FUNCTION iom_use
[3695]	1983
[544]	1984	!!======================================================================
	1985	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 @ 11018

Download in other formats: