Context Navigation

iom.F90 @ 9830

Last change on this file since 9830 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

Line
1	MODULE iom
2	!!=====================================================================
3	!! * MODULE iom *
4	!! Input/Output manager : Library to read input files
5	!!====================================================================
6	!! History : 2.0 ! 2005-12 (J. Belier) Original code
7	!! 2.0 ! 2006-02 (S. Masson) Adaptation to NEMO
8	!! 3.0 ! 2007-07 (D. Storkey) Changes to iom_gettime
9	!! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add C1D case
10	!!--------------------------------------------------------------------
11
12	!!--------------------------------------------------------------------
13	!! iom_open : open a file read only
14	!! iom_close : close a file or all files opened by iom
15	!! iom_get : read a field (interfaced to several routines)
16	!! iom_gettime : read the time axis cdvar in the file
17	!! iom_varid : get the id of a variable in a file
18	!! iom_rstput : write a field in a restart file (interfaced to several routines)
19	!!--------------------------------------------------------------------
20	USE dom_oce ! ocean space and time domain
21	USE c1d ! 1D vertical configuration
22	USE flo_oce ! floats module declarations
23	USE lbclnk ! lateal boundary condition / mpp exchanges
24	USE iom_def ! iom variables definitions
25	USE iom_ioipsl ! NetCDF format with IOIPSL library
26	USE iom_nf90 ! NetCDF format with native NetCDF library
27	USE iom_rstdimg ! restarts access direct format "dimg" style...
28	USE in_out_manager ! I/O manager
29	USE lib_mpp ! MPP library
30	#if defined key_iomput
31	USE sbc_oce, ONLY : nn_fsbc ! ocean space and time domain
32	USE trc_oce, ONLY : nn_dttrc ! !: frequency of step on passive tracers
33	USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes
34	#if defined key_lim3
35	USE ice , ONLY : jpl
36	#elif defined key_lim2
37	USE par_ice_2
38	#endif
39	USE domngb ! ocean space and time domain
40	USE phycst ! physical constants
41	USE dianam ! build name of file
42	USE xios
43	# endif
44	USE ioipsl, ONLY : ju2ymds ! for calendar
45	USE crs ! Grid coarsening
46	USE timing
47
48	IMPLICIT NONE
49	PUBLIC ! must be public to be able to access iom_def through iom
50
51	#if defined key_iomput
52	LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag
53	#else
54	LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag
55	#endif
56	PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
57	PUBLIC iom_getatt, iom_use, iom_context_finalize
58
59	PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
60	PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d
61	PRIVATE iom_p1d, iom_p2d, iom_p3d
62	#if defined key_iomput
63	PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
64	PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate
65	# endif
66
67	INTERFACE iom_get
68	MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d
69	END INTERFACE
70	INTERFACE iom_getatt
71	MODULE PROCEDURE iom_g0d_intatt
72	END INTERFACE
73	INTERFACE iom_rstput
74	MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
75	END INTERFACE
76	INTERFACE iom_put
77	MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d
78	END INTERFACE
79
80	!!----------------------------------------------------------------------
81	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
82	!! $Id$
83	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
84	!!----------------------------------------------------------------------
85
86	CONTAINS
87
88	SUBROUTINE iom_init( cdname )
89	!!----------------------------------------------------------------------
90	!! * ROUTINE *
91	!!
92	!! ** Purpose :
93	!!
94	!!----------------------------------------------------------------------
95	CHARACTER(len=*), INTENT(in) :: cdname
96	#if defined key_iomput
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
106	!
107	REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds
108	!!----------------------------------------------------------------------
109	#if ! defined key_xios2
110	ALLOCATE( z_bnds(jpk,2) )
111	#else
112	ALLOCATE( z_bnds(2,jpk) )
113	#endif
114
115	clname = cdname
116	IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
117	CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
118	CALL iom_swap( cdname )
119
120	! calendar parameters
121	#if ! defined key_xios2
122	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
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")
126	END SELECT
127	WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday
128	CALL xios_set_context_attr(TRIM(clname), start_date=cldate )
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
141
142	CALL set_scalar
143
144	IF( TRIM(cdname) == TRIM(cxios_context) ) THEN
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 )
149	CALL set_grid_znl( gphit )
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
161	ENDIF
162
163	IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN
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 )
170	CALL set_grid_znl( gphit_crs )
171	!
172	CALL dom_grid_glo ! Return to parent grid domain
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
184	ENDIF
185
186	! vertical grid definition
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 )
191
192	! Add vertical grid bounds
193	#if ! defined key_xios2
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)
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
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 )
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
216	CALL iom_set_axis_attr( "depthw", bounds=z_bnds )
217
218
219	# if defined key_floats
220	CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )
221	# endif
222	#if defined key_lim3 \|\| defined key_lim2
223	CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
224	#endif
225	CALL iom_set_axis_attr( "icbcla", class_num )
226	CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )
227	CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )
228
229	! automatic definitions of some of the xml attributs
230	CALL set_xmlatt
231
232	CALL set_1point
233
234	! end file definition
235	dtime%second = rdt
236	CALL xios_set_timestep(dtime)
237	CALL xios_close_context_definition()
238
239	CALL xios_update_calendar(0)
240
241	DEALLOCATE( z_bnds )
242
243	#endif
244
245	END SUBROUTINE iom_init
246
247
248	SUBROUTINE iom_swap( cdname )
249	!!---------------------------------------------------------------------
250	!! * SUBROUTINE iom_swap *
251	!!
252	!! ** Purpose : swap context between different agrif grid for xmlio_server
253	!!---------------------------------------------------------------------
254	CHARACTER(len=*), INTENT(in) :: cdname
255	#if defined key_iomput
256	TYPE(xios_context) :: nemo_hdl
257
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)
265	#endif
266	!
267	END SUBROUTINE iom_swap
268
269
270	SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
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)
280	INTEGER , INTENT(in ), OPTIONAL :: kiolib ! library used to open the file (default = jpnf90)
281	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.)
282	LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
283
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)
286	CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg"
287	CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits)
288	CHARACTER(LEN=256) :: clinfo ! info character
289	LOGICAL :: llok ! check the existence
290	LOGICAL :: llwrt ! local definition of ldwrt
291	LOGICAL :: llnoov ! local definition to read overlap
292	LOGICAL :: llstop ! local definition of ldstop
293	LOGICAL :: lliof ! local definition of ldiof
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	! =============
308	kiomid = -1
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)
313	IF( Agrif_Root() ) THEN
314	IF( iom_open_init == 0 ) THEN
315	iom_file(:)%nfid = 0
316	iom_open_init = 1
317	ENDIF
318	ENDIF
319	! do we read or write the file?
320	IF( PRESENT(ldwrt) ) THEN ; llwrt = ldwrt
321	ELSE ; llwrt = .FALSE.
322	ENDIF
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
327	! what library do we use to open the file?
328	IF( PRESENT(kiolib) ) THEN ; iolib = kiolib
329	ELSE ; iolib = jpnf90
330	ENDIF
331	! are we using interpolation on the fly?
332	IF( PRESENT(ldiof) ) THEN ; lliof = ldiof
333	ELSE ; lliof = .FALSE.
334	ENDIF
335	! do we read the overlap
336	! ugly patch SM+JMM+RB to overwrite global definition in some cases
337	llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
338	! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
339	! =============
340	clname = trim(cdname)
341	IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
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
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)
358	IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 ) &
359	& clname = TRIM(clname)//TRIM(clsuffix)
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
366	IF( iolib == jprstdimg ) THEN ; WRITE(clcpu,*) narea
367	ELSE ; WRITE(clcpu,*) narea-1
368	ENDIF
369	clcpu = TRIM(ADJUSTL(clcpu))
370	iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
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
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
386	IF( llnoov ) THEN ; idom = jpdom_local_noovlap ! default definition
387	ELSE ; idom = jpdom_local_full ! default definition
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
415	! Open the NetCDF or RSTDIMG file
416	! =============
417	! do we have some free file identifier?
418	IF( MINVAL(iom_file(:)%nfid) /= 0 ) &
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
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
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
435	ENDIF
436	ENDIF
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	!!--------------------------------------------------------------------
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
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
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
486	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
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
497	FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )
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
506	INTEGER, INTENT( out), OPTIONAL :: kndims ! size of the dimensions
507	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if looking for non-existing variable (default = .TRUE.)
508	!
509	INTEGER :: iom_varid, iiv, i_nvd
510	LOGICAL :: ll_fnd
511	CHARACTER(LEN=100) :: clinfo ! info character
512	LOGICAL :: llstop ! local definition of ldstop
513	!!-----------------------------------------------------------------------
514	iom_varid = 0 ! default definition
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
519	!
520	IF( kiomid > 0 ) THEN
521	clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
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 )
538	CASE (jpnf90 ) ; iom_varid = iom_nf90_varid ( kiomid, cdvar, iiv, kdimsz, kndims )
539	CASE (jprstdimg) ; iom_varid = -1 ! all variables are listed in iom_file
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
547	IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' )
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
559	IF( PRESENT(kndims) ) kndims = iom_file(kiomid)%ndims(iiv)
560	ENDIF
561	ENDIF
562	ENDIF
563	!
564	END FUNCTION iom_varid
565
566
567	!!----------------------------------------------------------------------
568	!! INTERFACE iom_get
569	!!----------------------------------------------------------------------
570	SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )
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
574	INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
575	!
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 !
582	!
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	!
589	IF( kiomid > 0 ) THEN
590	idvar = iom_varid( kiomid, cdvar )
591	IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
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' )
598	SELECT CASE (iom_file(kiomid)%iolib)
599	CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar, itime )
600	CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime )
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
607	END SUBROUTINE iom_g0d
608
609	SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
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	!
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
622	END SUBROUTINE iom_g1d
623
624	SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
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
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)
636	!
637	IF( kiomid > 0 ) THEN
638	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, &
639	& ktime=ktime, kstart=kstart, kcount=kcount, &
640	& lrowattr=lrowattr )
641	ENDIF
642	END SUBROUTINE iom_g2d
643
644	SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )
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
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)
656	!
657	IF( kiomid > 0 ) THEN
658	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, &
659	& ktime=ktime, kstart=kstart, kcount=kcount, &
660	& lrowattr=lrowattr )
661	ENDIF
662	END SUBROUTINE iom_g3d
663	!!----------------------------------------------------------------------
664
665	SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , &
666	& pv_r1d, pv_r2d, pv_r3d, &
667	& ktime , kstart, kcount, &
668	& lrowattr )
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
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)
689	!
690	LOGICAL :: llnoov ! local definition to read overlap
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
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
700	INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes
701	INTEGER :: ji, jj ! loop counters
702	INTEGER :: irankpv !
703	INTEGER :: ind1, ind2 ! substring index
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
707	INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable
708	REAL(wp) :: zscf, zofs ! sacle_factor and add_offset
709	INTEGER :: itmp ! temporary integer
710	CHARACTER(LEN=256) :: clinfo ! info character
711	CHARACTER(LEN=256) :: clname ! file name
712	CHARACTER(LEN=1) :: clrankpv, cldmspc !
713	LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then only use values for 3rd spatial dimension.
714	!---------------------------------------------------------------------
715	!
716	clname = iom_file(kiomid)%name ! esier to read
717	clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
718	! local definition of the domain ?
719	idom = kdom
720	! do we read the overlap
721	! ugly patch SM+JMM+RB to overwrite global definition in some cases
722	llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
723	! check kcount and kstart optionals parameters...
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')
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')
728
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
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
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
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
766	IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN
767	IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global
768	ELSE ; idom = jpdom_data
769	ENDIF
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
773	ENDIF
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
782	!
783	! check the consistency between input array and data rank in the file
784	!
785	! initializations
786	itime = 1
787	IF( PRESENT(ktime) ) itime = ktime
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
792	!
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
805	ELSE
806	CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , &
807	& 'we do not accept data with '//cldmspc//' spatial dimensions', &
808	& 'Use ncwa -a to suppress the unnecessary dimensions' )
809	ENDIF
810	ENDIF
811
812	!
813	! definition of istart and icnt
814	!
815	icnt (:) = 1
816	istart(:) = 1
817	istart(idmspc+1) = itime
818
819	IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
820	ELSE
821	IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc)
822	ELSE
823	IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array
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
832	ENDIF
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 /)
836	IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
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 /)
840	IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
841	ELSE ; icnt(1:2) = (/ nlci , nlcj /)
842	ENDIF
843	IF( PRESENT(pv_r3d) ) THEN
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
847	ENDIF
848	ENDIF
849	ENDIF
850	ENDIF
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
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)
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	!-
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)'
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)'
877	ENDIF
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,:)'
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,:)'
884	ENDIF
885	ENDIF
886	ENDIF
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
893	ENDIF
894
895	! read the data
896	!-
897	IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...
898	!
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
904	IF( llnoov ) THEN
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
914	SELECT CASE (iom_file(kiomid)%iolib)
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 )
921	CASE DEFAULT
922	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
923	END SELECT
924
925	IF( istop == nstop ) THEN ! no additional errors until this point...
926	IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
927
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
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
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
952	!CDIR COLLAPSE
953	IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf
954	!CDIR COLLAPSE
955	IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs
956	ELSEIF( PRESENT(pv_r3d) ) THEN
957	!CDIR COLLAPSE
958	IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
959	!CDIR COLLAPSE
960	IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
961	ENDIF
962	!
963	ENDIF
964	!
965	ENDIF
966	!
967	END SUBROUTINE iom_get_123d
968
969
970	SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
971	!!--------------------------------------------------------------------
972	!! * SUBROUTINE iom_gettime *
973	!!
974	!! ** Purpose : read the time axis cdvar in the file
975	!!--------------------------------------------------------------------
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
982	!
983	INTEGER, DIMENSION(1) :: kdimsz
984	INTEGER :: idvar ! id of the variable
985	CHARACTER(LEN=32) :: tname ! local name of time coordinate
986	CHARACTER(LEN=100) :: clinfo ! info character
987	!---------------------------------------------------------------------
988	!
989	IF ( PRESENT(cdvar) ) THEN
990	tname = cdvar
991	ELSE
992	tname = iom_file(kiomid)%uldname
993	ENDIF
994	IF( kiomid > 0 ) THEN
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
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
1007	IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
1008	SELECT CASE (iom_file(kiomid)%iolib)
1009	CASE (jpioipsl ) ; CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
1010	CASE (jpnf90 ) ; CALL iom_nf90_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
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
1019	ELSE
1020	CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
1021	ENDIF
1022	ELSE
1023	CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
1024	ENDIF
1025	ELSE
1026	CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
1027	ENDIF
1028	ENDIF
1029	!
1030	END SUBROUTINE iom_gettime
1031
1032
1033	!!----------------------------------------------------------------------
1034	!! INTERFACE iom_getatt
1035	!!----------------------------------------------------------------------
1036	SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
1037	INTEGER , INTENT(in ) :: kiomid !Identifier of the file
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	!!----------------------------------------------------------------------
1056	!! INTERFACE iom_rstput
1057	!!----------------------------------------------------------------------
1058	SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
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
1063	REAL(wp) , INTENT(in) :: pvar ! written field
1064	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1065	INTEGER :: ivid ! variable id
1066	IF( kiomid > 0 ) THEN
1067	IF( iom_file(kiomid)%nfid > 0 ) THEN
1068	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
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
1078	END SUBROUTINE iom_rp0d
1079
1080	SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
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
1085	REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field
1086	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1087	INTEGER :: ivid ! variable id
1088	IF( kiomid > 0 ) THEN
1089	IF( iom_file(kiomid)%nfid > 0 ) THEN
1090	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
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
1100	END SUBROUTINE iom_rp1d
1101
1102	SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
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
1107	REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field
1108	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1109	INTEGER :: ivid ! variable id
1110	IF( kiomid > 0 ) THEN
1111	IF( iom_file(kiomid)%nfid > 0 ) THEN
1112	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
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
1122	END SUBROUTINE iom_rp2d
1123
1124	SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
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
1129	REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field
1130	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1131	INTEGER :: ivid ! variable id
1132	IF( kiomid > 0 ) THEN
1133	IF( iom_file(kiomid)%nfid > 0 ) THEN
1134	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
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
1144	END SUBROUTINE iom_rp3d
1145
1146
1147	!!----------------------------------------------------------------------
1148	!! INTERFACE iom_put
1149	!!----------------------------------------------------------------------
1150	SUBROUTINE iom_p0d( cdname, pfield0d )
1151	CHARACTER(LEN=*), INTENT(in) :: cdname
1152	REAL(wp) , INTENT(in) :: pfield0d
1153	#if ! defined key_xios2
1154	REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson
1155	#endif
1156	#if defined key_iomput
1157	#if ! defined key_xios2
1158	zz(:,:)=pfield0d
1159	CALL xios_send_field(cdname, zz)
1160	#else
1161	CALL xios_send_field(cdname, (/pfield0d/))
1162	#endif
1163	#else
1164	IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings
1165	#endif
1166	END SUBROUTINE iom_p0d
1167
1168	SUBROUTINE iom_p1d( cdname, pfield1d )
1169	CHARACTER(LEN=*) , INTENT(in) :: cdname
1170	REAL(wp), DIMENSION(:), INTENT(in) :: pfield1d
1171	#if defined key_iomput
1172	CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
1173	#else
1174	IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings
1175	#endif
1176	END SUBROUTINE iom_p1d
1177
1178	SUBROUTINE iom_p2d( cdname, pfield2d )
1179	CHARACTER(LEN=*) , INTENT(in) :: cdname
1180	REAL(wp), DIMENSION(:,:), INTENT(in) :: pfield2d
1181	#if defined key_iomput
1182	CALL xios_send_field(cdname, pfield2d)
1183	#else
1184	IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings
1185	#endif
1186	END SUBROUTINE iom_p2d
1187
1188	SUBROUTINE iom_p3d( cdname, pfield3d )
1189	CHARACTER(LEN=*) , INTENT(in) :: cdname
1190	REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d
1191	#if defined key_iomput
1192	CALL xios_send_field(cdname, pfield3d)
1193	#else
1194	IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings
1195	#endif
1196	END SUBROUTINE iom_p3d
1197	!!----------------------------------------------------------------------
1198
1199	#if defined key_iomput
1200
1201	SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, &
1202	& data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, &
1203	& nvertex, bounds_lon, bounds_lat, area )
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
1209	REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area
1210	#if ! defined key_xios2
1211	LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask
1212	#else
1213	LOGICAL, DIMENSION(:) , OPTIONAL, INTENT(in) :: mask
1214	#endif
1215
1216	#if ! defined key_xios2
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, &
1221	& lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, &
1222	& bounds_lat=bounds_lat, area=area )
1223	ENDIF
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, &
1228	& lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, &
1229	& bounds_lat=bounds_lat, area=area )
1230	ENDIF
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 , &
1236	& lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, &
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 , &
1242	& lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, &
1243	& bounds_lat_1D=bounds_lat, area=area, type='curvilinear' )
1244	ENDIF
1245	#endif
1246	CALL xios_solve_inheritance()
1247
1248	END SUBROUTINE iom_set_domain_attr
1249
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
1254
1255	IF ( xios_is_valid_zoom_domain (cdid) ) THEN
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
1263	SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds )
1264	CHARACTER(LEN=*) , INTENT(in) :: cdid
1265	REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis
1266	REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds
1267	IF ( PRESENT(paxis) ) THEN
1268	#if ! defined key_xios2
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 )
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
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 )
1278	CALL xios_solve_inheritance()
1279	END SUBROUTINE iom_set_axis_attr
1280
1281	SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
1282	CHARACTER(LEN=*) , INTENT(in) :: cdid
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 )
1294	CALL xios_solve_inheritance()
1295	END SUBROUTINE iom_set_field_attr
1296
1297	SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
1298	CHARACTER(LEN=*) , INTENT(in) :: cdid
1299	CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix
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()
1303	END SUBROUTINE iom_set_file_attr
1304
1305
1306	SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
1307	CHARACTER(LEN=*) , INTENT(in ) :: cdid
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
1314	LOGICAL :: llexist1,llexist2,llexist3
1315	!---------------------------------------------------------------------
1316	IF( PRESENT( name ) ) name = '' ! default values
1317	IF( PRESENT( name_suffix ) ) name_suffix = ''
1318	#if ! defined key_xios2
1319	IF( PRESENT( output_freq ) ) output_freq = ''
1320	#else
1321	IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0)
1322	#endif
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
1342	LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask
1343	#if ! defined key_xios2
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 )
1346	#else
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 )
1349	#endif
1350	CALL xios_solve_inheritance()
1351	END SUBROUTINE iom_set_grid_attr
1352
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)
1359	IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context
1360	!
1361	END SUBROUTINE iom_setkt
1362
1363	SUBROUTINE iom_context_finalize( cdname )
1364	CHARACTER(LEN=*), INTENT(in) :: cdname
1365	!
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
1369	IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context
1370	ENDIF
1371	!
1372	END SUBROUTINE iom_context_finalize
1373
1374
1375	SUBROUTINE set_grid( cdgrd, plon, plat )
1376	!!----------------------------------------------------------------------
1377	!! * ROUTINE set_grid *
1378	!!
1379	!! ** Purpose : define horizontal grids
1380	!!
1381	!!----------------------------------------------------------------------
1382	CHARACTER(LEN=1) , INTENT(in) :: cdgrd
1383	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon
1384	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
1385	!
1386	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask
1387	INTEGER :: ni,nj
1388
1389	ni=nlei-nldi+1 ; nj=nlej-nldj+1
1390
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
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
1402
1403
1404	SELECT CASE ( cdgrd )
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
1421	!
1422	#if ! defined key_xios2
1423	CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj /)) /= 0. )
1424	#else
1425	CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj /)) /= 0. )
1426	#endif
1427	CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
1428	ENDIF
1429
1430	END SUBROUTINE set_grid
1431
1432
1433	SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt )
1434	!!----------------------------------------------------------------------
1435	!! * ROUTINE set_grid_bounds *
1436	!!
1437	!! ** Purpose : define horizontal grid corners
1438	!!
1439	!!----------------------------------------------------------------------
1440	CHARACTER(LEN=1) , INTENT(in) :: cdgrd
1441	!
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	!
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
1453	ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) )
1454
1455	! Offset of coordinate representing bottom-left corner
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
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
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
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
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
1539	DEALLOCATE( z_bnds, z_fld, z_rot )
1540
1541	END SUBROUTINE set_grid_bounds
1542
1543
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
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)
1561	#if ! defined key_xios2
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)
1568	#else
1569	! Pas teste : attention aux indices !
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, &
1573	& latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
1574	CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo)
1575	#endif
1576
1577	CALL iom_update_file_name('ptr')
1578	!
1579	END SUBROUTINE set_grid_znl
1580
1581	SUBROUTINE set_scalar
1582	!!----------------------------------------------------------------------
1583	!! * ROUTINE set_scalar *
1584	!!
1585	!! ** Purpose : define fake grids for scalar point
1586	!!
1587	!!----------------------------------------------------------------------
1588	REAL(wp), DIMENSION(1) :: zz = 1.
1589	!!----------------------------------------------------------------------
1590	#if ! defined key_xios2
1591	CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
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
1595	CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
1596
1597	zz=REAL(narea,wp)
1598	CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
1599
1600	END SUBROUTINE set_scalar
1601
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)
1614
1615	END SUBROUTINE set_1point
1616
1617
1618
1619	SUBROUTINE set_xmlatt
1620	!!----------------------------------------------------------------------
1621	!! * ROUTINE set_xmlatt *
1622	!!
1623	!! ** Purpose : automatic definitions of some of the xml attributs...
1624	!!
1625	!!----------------------------------------------------------------------
1626	CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name
1627	CHARACTER(len=256) :: clsuff ! suffix name
1628	CHARACTER(len=1) :: cl1 ! 1 character
1629	CHARACTER(len=2) :: cl2 ! 2 characters
1630	CHARACTER(len=3) :: cl3 ! 3 characters
1631	INTEGER :: ji, jg ! loop counters
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
1639	#if defined key_xios2
1640	TYPE(xios_duration) :: f_op, f_of
1641	#endif
1642
1643	!!----------------------------------------------------------------------
1644	!
1645	! frequency of the call of iom_put (attribut: freq_op)
1646	#if ! defined key_xios2
1647	WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts')
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')
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')
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)
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)
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)
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
1667
1668	! output file names (attribut: name)
1669	DO ji = 1, 9
1670	WRITE(cl1,'(i1)') ji
1671	CALL iom_update_file_name('file'//cl1)
1672	END DO
1673	DO ji = 1, 99
1674	WRITE(cl2,'(i2.2)') ji
1675	CALL iom_update_file_name('file'//cl2)
1676	END DO
1677	DO ji = 1, 999
1678	WRITE(cl3,'(i3.3)') ji
1679	CALL iom_update_file_name('file'//cl3)
1680	END DO
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 )
1688	#if ! defined key_xios2
1689	CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)
1690	#else
1691	CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo)
1692	#endif
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)
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 )
1709
1710
1711	END SUBROUTINE set_xmlatt
1712
1713
1714	SUBROUTINE set_mooring( plon, plat)
1715	!!----------------------------------------------------------------------
1716	!! * ROUTINE set_mooring *
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
1725	CHARACTER(len=256) :: clname ! file name
1726	CHARACTER(len=256) :: clsuff ! suffix name
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))
1772	#if ! defined key_xios2
1773	CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)
1774	#else
1775	CALL iom_set_zoom_domain_attr (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1)
1776	#endif
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)
1780	END DO
1781	END DO
1782	END DO
1783
1784	END SUBROUTINE set_mooring
1785
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
1805	#if defined key_xios2
1806	TYPE(xios_duration) :: output_freq
1807	#endif
1808	!!----------------------------------------------------------------------
1809
1810
1811	DO jn = 1,2
1812	#if ! defined key_xios2
1813	IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq )
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
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
1828	#if ! defined key_xios2
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
1841	#else
1842	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1843	DO WHILE ( idx /= 0 )
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
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
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
1895	IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname)
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
1943	!$AGRIF_DO_NOT_TREAT
1944	! Should be fixed in the conv
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
1955	!$AGRIF_END_DO_NOT_TREAT
1956
1957	END FUNCTION iom_sdate
1958
1959	#else
1960
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
1966	END SUBROUTINE iom_setkt
1967
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
1973	#endif
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
1983
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 @ 9830

Download in other formats: