Context Navigation

source: CONFIG/UNIFORM/v6/IPSLCM6/SOURCES/NEMO/iom.F90 @ 2372

Last change on this file since 2372 was 2372, checked in by aclsce, 10 years ago

Modified in order to :

use writing of diaptr file by using XIOS library (SOURCES/NEMO and opa9.card)
IPSLCM6 specific NEMO sources coherent with updated NEMO revision
IPSLCM6 specific NEMO namelist files coherent with updated NEMO revision
use only XIOS in LMDZ trunk revision (run.def parameter)
coherent TS coherent with output variables (green TSC)
significative monitoring (ATM and MBG)

File size: 78.6 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	USE diaptr_oce , ONLY : nn_fptr, nxline ! ocean space and time domain
35	#if defined key_lim3
36	USE par_ice
37	#elif defined key_lim2
38	USE par_ice_2
39	#endif
40	USE domngb ! ocean space and time domain
41	USE phycst ! physical constants
42	USE dianam ! build name of file
43	USE xios
44	# endif
45	USE ioipsl, ONLY : ju2ymds ! for calendar
46	USE crs ! Grid coarsening
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_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: iom.F90 4691 2014-06-25 12:31:42Z clem $
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	TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0)
98	CHARACTER(len=19) :: cldate
99	CHARACTER(len=10) :: clname
100	INTEGER :: ji
101	!!----------------------------------------------------------------------
102
103	clname = cdname
104	IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname)
105	# if defined key_mpp_mpi
106	CALL xios_context_initialize(TRIM(clname), mpi_comm_opa)
107	# else
108	CALL xios_context_initialize(TRIM(clname), 0)
109	# endif
110	CALL iom_swap( cdname )
111
112	! calendar parameters
113	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
114	CASE ( 1) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian")
115	CASE ( 0) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap")
116	CASE (30) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360")
117	END SELECT
118	WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday
119	CALL xios_set_context_attr(TRIM(clname), start_date=cldate )
120
121	! horizontal grid definition
122	CALL set_scalar
123
124	IF( TRIM(cdname) == "nemo" ) THEN
125	CALL set_grid( "T", glamt, gphit )
126	CALL set_grid( "U", glamu, gphiu )
127	CALL set_grid( "V", glamv, gphiv )
128	CALL set_grid( "W", glamt, gphit )
129	ENDIF
130
131	IF( TRIM(cdname) == "nemo_crs" ) THEN
132	CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain
133	!
134	CALL set_grid( "T", glamt_crs, gphit_crs )
135	CALL set_grid( "U", glamu_crs, gphiu_crs )
136	CALL set_grid( "V", glamv_crs, gphiv_crs )
137	CALL set_grid( "W", glamt_crs, gphit_crs )
138	!
139	CALL dom_grid_glo ! Return to parent grid domain
140	ENDIF
141
142
143	! vertical grid definition
144	CALL iom_set_axis_attr( "deptht", gdept_1d )
145	CALL iom_set_axis_attr( "depthu", gdept_1d )
146	CALL iom_set_axis_attr( "depthv", gdept_1d )
147	CALL iom_set_axis_attr( "depthw", gdepw_1d )
148	# if defined key_floats
149	CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )
150	# endif
151	#if defined key_lim3 \|\| defined key_lim2
152	CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )
153	#endif
154	CALL iom_set_axis_attr( "icbcla", class_num )
155
156	! automatic definitions of some of the xml attributs
157	CALL set_xmlatt
158
159	! end file definition
160	dtime%second = rdt
161	CALL xios_set_timestep(dtime)
162	CALL xios_close_context_definition()
163
164	CALL xios_update_calendar(0)
165	#endif
166
167	END SUBROUTINE iom_init
168
169
170	SUBROUTINE iom_swap( cdname )
171	!!---------------------------------------------------------------------
172	!! * SUBROUTINE iom_swap *
173	!!
174	!! ** Purpose : swap context between different agrif grid for xmlio_server
175	!!---------------------------------------------------------------------
176	CHARACTER(len=*), INTENT(in) :: cdname
177	#if defined key_iomput
178	TYPE(xios_context) :: nemo_hdl
179
180	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
181	CALL xios_get_handle(TRIM(cdname),nemo_hdl)
182	ELSE
183	CALL xios_get_handle(TRIM(Agrif_CFixed())//"_"//TRIM(cdname),nemo_hdl)
184	ENDIF
185	!
186	CALL xios_set_current_context(nemo_hdl)
187	#endif
188	!
189	END SUBROUTINE iom_swap
190
191
192	SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )
193	!!---------------------------------------------------------------------
194	!! * SUBROUTINE iom_open *
195	!!
196	!! ** Purpose : open an input file (return 0 if not found)
197	!!---------------------------------------------------------------------
198	CHARACTER(len=*), INTENT(in ) :: cdname ! File name
199	INTEGER , INTENT( out) :: kiomid ! iom identifier of the opened file
200	LOGICAL , INTENT(in ), OPTIONAL :: ldwrt ! open in write modeb (default = .FALSE.)
201	INTEGER , INTENT(in ), OPTIONAL :: kdom ! Type of domain to be written (default = jpdom_local_noovlap)
202	INTEGER , INTENT(in ), OPTIONAL :: kiolib ! library used to open the file (default = jpnf90)
203	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.)
204	LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.)
205
206	CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu]
207	CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode)
208	CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg"
209	CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits)
210	CHARACTER(LEN=256) :: clinfo ! info character
211	LOGICAL :: llok ! check the existence
212	LOGICAL :: llwrt ! local definition of ldwrt
213	LOGICAL :: llnoov ! local definition to read overlap
214	LOGICAL :: llstop ! local definition of ldstop
215	LOGICAL :: lliof ! local definition of ldiof
216	INTEGER :: iolib ! library do we use to open the file
217	INTEGER :: icnt ! counter for digits in clcpu (max = jpmax_digits)
218	INTEGER :: iln, ils ! lengths of character
219	INTEGER :: idom ! type of domain
220	INTEGER :: istop !
221	INTEGER, DIMENSION(2,5) :: idompar ! domain parameters:
222	! local number of points for x,y dimensions
223	! position of first local point for x,y dimensions
224	! position of last local point for x,y dimensions
225	! start halo size for x,y dimensions
226	! end halo size for x,y dimensions
227	!---------------------------------------------------------------------
228	! Initializations and control
229	! =============
230	kiomid = -1
231	clinfo = ' iom_open ~~~ '
232	istop = nstop
233	! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0
234	! (could be done when defining iom_file in f95 but not in f90)
235	IF( Agrif_Root() ) THEN
236	IF( iom_open_init == 0 ) THEN
237	iom_file(:)%nfid = 0
238	iom_open_init = 1
239	ENDIF
240	ENDIF
241	! do we read or write the file?
242	IF( PRESENT(ldwrt) ) THEN ; llwrt = ldwrt
243	ELSE ; llwrt = .FALSE.
244	ENDIF
245	! do we call ctl_stop if we try to open a non-existing file in read mode?
246	IF( PRESENT(ldstop) ) THEN ; llstop = ldstop
247	ELSE ; llstop = .TRUE.
248	ENDIF
249	! what library do we use to open the file?
250	IF( PRESENT(kiolib) ) THEN ; iolib = kiolib
251	ELSE ; iolib = jpnf90
252	ENDIF
253	! are we using interpolation on the fly?
254	IF( PRESENT(ldiof) ) THEN ; lliof = ldiof
255	ELSE ; lliof = .FALSE.
256	ENDIF
257	! do we read the overlap
258	! ugly patch SM+JMM+RB to overwrite global definition in some cases
259	llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
260	! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix)
261	! =============
262	clname = trim(cdname)
263	IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN
264	iln = INDEX(clname,'/')
265	cltmpn = clname(1:iln)
266	clname = clname(iln+1:LEN_TRIM(clname))
267	clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
268	ENDIF
269	! which suffix should we use?
270	SELECT CASE (iolib)
271	CASE (jpioipsl ) ; clsuffix = '.nc'
272	CASE (jpnf90 ) ; clsuffix = '.nc'
273	CASE (jprstdimg) ; clsuffix = '.dimg'
274	CASE DEFAULT ; clsuffix = ''
275	CALL ctl_stop( TRIM(clinfo), 'accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
276	END SELECT
277	! Add the suffix if needed
278	iln = LEN_TRIM(clname)
279	ils = LEN_TRIM(clsuffix)
280	IF( iln <= ils .OR. INDEX( TRIM(clname), TRIM(clsuffix), back = .TRUE. ) /= iln - ils + 1 ) &
281	& clname = TRIM(clname)//TRIM(clsuffix)
282	cltmpn = clname ! store this name
283	! try to find if the file to be opened already exist
284	! =============
285	INQUIRE( FILE = clname, EXIST = llok )
286	IF( .NOT.llok ) THEN
287	! we try to add the cpu number to the name
288	IF( iolib == jprstdimg ) THEN ; WRITE(clcpu,*) narea
289	ELSE ; WRITE(clcpu,*) narea-1
290	ENDIF
291	clcpu = TRIM(ADJUSTL(clcpu))
292	iln = INDEX(clname,TRIM(clsuffix), back = .TRUE.)
293	clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
294	icnt = 0
295	INQUIRE( FILE = clname, EXIST = llok )
296	! we try different formats for the cpu number by adding 0
297	DO WHILE( .NOT.llok .AND. icnt < jpmax_digits )
298	clcpu = "0"//trim(clcpu)
299	clname = clname(1:iln-1)//'_'//TRIM(clcpu)//TRIM(clsuffix)
300	INQUIRE( FILE = clname, EXIST = llok )
301	icnt = icnt + 1
302	END DO
303	ENDIF
304	IF( llwrt ) THEN
305	! check the domain definition
306	! JMM + SM: ugly patch before getting the new version of lib_mpp)
307	! idom = jpdom_local_noovlap ! default definition
308	IF( llnoov ) THEN ; idom = jpdom_local_noovlap ! default definition
309	ELSE ; idom = jpdom_local_full ! default definition
310	ENDIF
311	IF( PRESENT(kdom) ) idom = kdom
312	! create the domain informations
313	! =============
314	SELECT CASE (idom)
315	CASE (jpdom_local_full)
316	idompar(:,1) = (/ jpi , jpj /)
317	idompar(:,2) = (/ nimpp , njmpp /)
318	idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1 /)
319	idompar(:,4) = (/ nldi - 1 , nldj - 1 /)
320	idompar(:,5) = (/ jpi - nlei , jpj - nlej /)
321	CASE (jpdom_local_noextra)
322	idompar(:,1) = (/ nlci , nlcj /)
323	idompar(:,2) = (/ nimpp , njmpp /)
324	idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /)
325	idompar(:,4) = (/ nldi - 1 , nldj - 1 /)
326	idompar(:,5) = (/ nlci - nlei , nlcj - nlej /)
327	CASE (jpdom_local_noovlap)
328	idompar(:,1) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
329	idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /)
330	idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /)
331	idompar(:,4) = (/ 0 , 0 /)
332	idompar(:,5) = (/ 0 , 0 /)
333	CASE DEFAULT
334	CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' )
335	END SELECT
336	ENDIF
337	! Open the NetCDF or RSTDIMG file
338	! =============
339	! do we have some free file identifier?
340	IF( MINVAL(iom_file(:)%nfid) /= 0 ) &
341	& CALL ctl_stop( TRIM(clinfo), 'No more free file identifier', 'increase jpmax_files in iom_def' )
342	! if no file was found...
343	IF( .NOT. llok ) THEN
344	IF( .NOT. llwrt ) THEN ! we are in read mode
345	IF( llstop ) THEN ; CALL ctl_stop( TRIM(clinfo), 'File '//TRIM(cltmpn)//'* not found' )
346	ELSE ; istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file
347	ENDIF
348	ELSE ! we are in write mode so we
349	clname = cltmpn ! get back the file name without the cpu number
350	ENDIF
351	ELSE
352	IF( llwrt .AND. .NOT. ln_clobber ) THEN ! we stop as we want to write in a new file
353	CALL ctl_stop( TRIM(clinfo), 'We want to write in a new file but '//TRIM(clname)//' already exists...' )
354	istop = nstop + 1 ! make sure that istop /= nstop so we don't open the file
355	ELSEIF( llwrt ) THEN ! the file exists and we are in write mode with permission to
356	clname = cltmpn ! overwrite so get back the file name without the cpu number
357	ENDIF
358	ENDIF
359	IF( istop == nstop ) THEN ! no error within this routine
360	SELECT CASE (iolib)
361	CASE (jpioipsl ) ; CALL iom_ioipsl_open( clname, kiomid, llwrt, llok, idompar )
362	CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar )
363	CASE (jprstdimg) ; CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )
364	CASE DEFAULT
365	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
366	END SELECT
367	ENDIF
368	!
369	END SUBROUTINE iom_open
370
371
372	SUBROUTINE iom_close( kiomid )
373	!!--------------------------------------------------------------------
374	!! * SUBROUTINE iom_close *
375	!!
376	!! ** Purpose : close an input file, or all files opened by iom
377	!!--------------------------------------------------------------------
378	INTEGER, INTENT(inout), OPTIONAL :: kiomid ! iom identifier of the file to be closed
379	! ! return 0 when file is properly closed
380	! ! No argument: all files opened by iom are closed
381
382	INTEGER :: jf ! dummy loop indices
383	INTEGER :: i_s, i_e ! temporary integer
384	CHARACTER(LEN=100) :: clinfo ! info character
385	!---------------------------------------------------------------------
386	!
387	clinfo = ' iom_close ~~~ '
388	IF( PRESENT(kiomid) ) THEN
389	i_s = kiomid
390	i_e = kiomid
391	ELSE
392	i_s = 1
393	i_e = jpmax_files
394	ENDIF
395
396	IF( i_s > 0 ) THEN
397	DO jf = i_s, i_e
398	IF( iom_file(jf)%nfid > 0 ) THEN
399	SELECT CASE (iom_file(jf)%iolib)
400	CASE (jpioipsl ) ; CALL iom_ioipsl_close( jf )
401	CASE (jpnf90 ) ; CALL iom_nf90_close( jf )
402	CASE (jprstdimg) ; CALL iom_rstdimg_close( jf )
403	CASE DEFAULT
404	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
405	END SELECT
406	iom_file(jf)%nfid = 0 ! free the id
407	IF( PRESENT(kiomid) ) kiomid = 0 ! return 0 as id to specify that the file was closed
408	IF(lwp) WRITE(numout,*) TRIM(clinfo)//' close file: '//TRIM(iom_file(jf)%name)//' ok'
409	ELSEIF( PRESENT(kiomid) ) THEN
410	WRITE(ctmp1,*) '--->', kiomid
411	CALL ctl_stop( TRIM(clinfo)//' Invalid file identifier', ctmp1 )
412	ENDIF
413	END DO
414	ENDIF
415	!
416	END SUBROUTINE iom_close
417
418
419	FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )
420	!!-----------------------------------------------------------------------
421	!! * FUNCTION iom_varid *
422	!!
423	!! ** Purpose : get the id of a variable in a file (return 0 if not found)
424	!!-----------------------------------------------------------------------
425	INTEGER , INTENT(in ) :: kiomid ! file Identifier
426	CHARACTER(len=*) , INTENT(in ) :: cdvar ! name of the variable
427	INTEGER, DIMENSION(:), INTENT( out), OPTIONAL :: kdimsz ! size of the dimensions
428	INTEGER, INTENT( out), OPTIONAL :: kndims ! size of the dimensions
429	LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if looking for non-existing variable (default = .TRUE.)
430	!
431	INTEGER :: iom_varid, iiv, i_nvd
432	LOGICAL :: ll_fnd
433	CHARACTER(LEN=100) :: clinfo ! info character
434	LOGICAL :: llstop ! local definition of ldstop
435	!!-----------------------------------------------------------------------
436	iom_varid = 0 ! default definition
437	! do we call ctl_stop if we look for non-existing variable?
438	IF( PRESENT(ldstop) ) THEN ; llstop = ldstop
439	ELSE ; llstop = .TRUE.
440	ENDIF
441	!
442	IF( kiomid > 0 ) THEN
443	clinfo = 'iom_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
444	IF( iom_file(kiomid)%nfid == 0 ) THEN
445	CALL ctl_stop( trim(clinfo), 'the file is not open' )
446	ELSE
447	ll_fnd = .FALSE.
448	iiv = 0
449	!
450	DO WHILE ( .NOT.ll_fnd .AND. iiv < iom_file(kiomid)%nvars )
451	iiv = iiv + 1
452	ll_fnd = ( TRIM(cdvar) == TRIM(iom_file(kiomid)%cn_var(iiv)) )
453	END DO
454	!
455	IF( .NOT.ll_fnd ) THEN
456	iiv = iiv + 1
457	IF( iiv <= jpmax_vars ) THEN
458	SELECT CASE (iom_file(kiomid)%iolib)
459	CASE (jpioipsl ) ; iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )
460	CASE (jpnf90 ) ; iom_varid = iom_nf90_varid ( kiomid, cdvar, iiv, kdimsz, kndims )
461	CASE (jprstdimg) ; iom_varid = -1 ! all variables are listed in iom_file
462	CASE DEFAULT
463	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
464	END SELECT
465	ELSE
466	CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name, &
467	& 'increase the parameter jpmax_vars')
468	ENDIF
469	IF( llstop .AND. iom_varid == -1 ) CALL ctl_stop( TRIM(clinfo)//' not found' )
470	ELSE
471	iom_varid = iiv
472	IF( PRESENT(kdimsz) ) THEN
473	i_nvd = iom_file(kiomid)%ndims(iiv)
474	IF( i_nvd == size(kdimsz) ) THEN
475	kdimsz(:) = iom_file(kiomid)%dimsz(1:i_nvd,iiv)
476	ELSE
477	WRITE(ctmp1,*) i_nvd, size(kdimsz)
478	CALL ctl_stop( trim(clinfo), 'error in kdimsz size'//trim(ctmp1) )
479	ENDIF
480	ENDIF
481	IF( PRESENT(kndims) ) kndims = iom_file(kiomid)%ndims(iiv)
482	ENDIF
483	ENDIF
484	ENDIF
485	!
486	END FUNCTION iom_varid
487
488
489	!!----------------------------------------------------------------------
490	!! INTERFACE iom_get
491	!!----------------------------------------------------------------------
492	SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )
493	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
494	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
495	REAL(wp) , INTENT( out) :: pvar ! read field
496	INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
497	!
498	INTEGER :: idvar ! variable id
499	INTEGER :: idmspc ! number of spatial dimensions
500	INTEGER , DIMENSION(1) :: itime ! record number
501	CHARACTER(LEN=100) :: clinfo ! info character
502	CHARACTER(LEN=100) :: clname ! file name
503	CHARACTER(LEN=1) :: cldmspc !
504	!
505	itime = 1
506	IF( PRESENT(ktime) ) itime = ktime
507	!
508	clname = iom_file(kiomid)%name
509	clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar)
510	!
511	IF( kiomid > 0 ) THEN
512	idvar = iom_varid( kiomid, cdvar )
513	IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
514	idmspc = iom_file ( kiomid )%ndims( idvar )
515	IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1
516	WRITE(cldmspc , fmt='(i1)') idmspc
517	IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', &
518	& 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , &
519	& 'Use ncwa -a to suppress the unnecessary dimensions' )
520	SELECT CASE (iom_file(kiomid)%iolib)
521	CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar, itime )
522	CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime )
523	CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idvar, pvar )
524	CASE DEFAULT
525	CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
526	END SELECT
527	ENDIF
528	ENDIF
529	END SUBROUTINE iom_g0d
530
531	SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
532	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
533	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
534	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
535	REAL(wp) , INTENT( out), DIMENSION(:) :: pvar ! read field
536	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
537	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading
538	INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis
539	!
540	IF( kiomid > 0 ) THEN
541	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, &
542	& ktime=ktime, kstart=kstart, kcount=kcount )
543	ENDIF
544	END SUBROUTINE iom_g1d
545
546	SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
547	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
548	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
549	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
550	REAL(wp) , INTENT( out), DIMENSION(:,:) :: pvar ! read field
551	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
552	INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading
553	INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis
554	!
555	IF( kiomid > 0 ) THEN
556	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, &
557	& ktime=ktime, kstart=kstart, kcount=kcount )
558	ENDIF
559	END SUBROUTINE iom_g2d
560
561	SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )
562	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
563	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
564	CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable
565	REAL(wp) , INTENT( out), DIMENSION(:,:,:) :: pvar ! read field
566	INTEGER , INTENT(in ) , OPTIONAL :: ktime ! record number
567	INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading
568	INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis
569	!
570	IF( kiomid > 0 ) THEN
571	IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, &
572	& ktime=ktime, kstart=kstart, kcount=kcount )
573	ENDIF
574	END SUBROUTINE iom_g3d
575	!!----------------------------------------------------------------------
576
577	SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , &
578	& pv_r1d, pv_r2d, pv_r3d, &
579	& ktime , kstart, kcount )
580	!!-----------------------------------------------------------------------
581	!! * ROUTINE iom_get_123d *
582	!!
583	!! ** Purpose : read a 1D/2D/3D variable
584	!!
585	!! ** Method : read ONE record at each CALL
586	!!-----------------------------------------------------------------------
587	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
588	INTEGER , INTENT(in ) :: kdom ! Type of domain to be read
589	CHARACTER(len=*) , INTENT(in ) :: cdvar ! Name of the variable
590	REAL(wp), DIMENSION(:) , INTENT( out), OPTIONAL :: pv_r1d ! read field (1D case)
591	REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pv_r2d ! read field (2D case)
592	REAL(wp), DIMENSION(:,:,:) , INTENT( out), OPTIONAL :: pv_r3d ! read field (3D case)
593	INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number
594	INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis
595	INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis
596	!
597	LOGICAL :: llnoov ! local definition to read overlap
598	INTEGER :: jl ! loop on number of dimension
599	INTEGER :: idom ! type of domain
600	INTEGER :: idvar ! id of the variable
601	INTEGER :: inbdim ! number of dimensions of the variable
602	INTEGER :: idmspc ! number of spatial dimensions
603	INTEGER :: itime ! record number
604	INTEGER :: istop ! temporary value of nstop
605	INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes
606	INTEGER :: ji, jj ! loop counters
607	INTEGER :: irankpv !
608	INTEGER :: ind1, ind2 ! substring index
609	INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis
610	INTEGER, DIMENSION(jpmax_dims) :: icnt ! number of value to read along each axis
611	INTEGER, DIMENSION(jpmax_dims) :: idimsz ! size of the dimensions of the variable
612	INTEGER, DIMENSION(jpmax_dims) :: ishape ! size of the dimensions of the variable
613	REAL(wp) :: zscf, zofs ! sacle_factor and add_offset
614	INTEGER :: itmp ! temporary integer
615	CHARACTER(LEN=256) :: clinfo ! info character
616	CHARACTER(LEN=256) :: clname ! file name
617	CHARACTER(LEN=1) :: clrankpv, cldmspc !
618	!---------------------------------------------------------------------
619	!
620	clname = iom_file(kiomid)%name ! esier to read
621	clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar)
622	! local definition of the domain ?
623	idom = kdom
624	! do we read the overlap
625	! ugly patch SM+JMM+RB to overwrite global definition in some cases
626	llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif
627	! check kcount and kstart optionals parameters...
628	IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present')
629	IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present')
630	IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown')
631
632	! Search for the variable in the data base (eventually actualize data)
633	istop = nstop
634	idvar = iom_varid( kiomid, cdvar )
635	!
636	IF( idvar > 0 ) THEN
637	! to write iom_file(kiomid)%dimsz in a shorter way !
638	idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)
639	inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file
640	idmspc = inbdim ! number of spatial dimensions in the file
641	IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1
642	IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')
643	!
644	! update idom definition...
645	! Identify the domain in case of jpdom_auto(glo/dta) definition
646	IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN
647	IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global
648	ELSE ; idom = jpdom_data
649	ENDIF
650	ind1 = INDEX( clname, '_', back = .TRUE. ) + 1
651	ind2 = INDEX( clname, '.', back = .TRUE. ) - 1
652	IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF
653	ENDIF
654	! Identify the domain in case of jpdom_local definition
655	IF( idom == jpdom_local ) THEN
656	IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full
657	ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra
658	ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap
659	ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' )
660	ENDIF
661	ENDIF
662	!
663	! check the consistency between input array and data rank in the file
664	!
665	! initializations
666	itime = 1
667	IF( PRESENT(ktime) ) itime = ktime
668
669	irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) )
670	WRITE(clrankpv, fmt='(i1)') irankpv
671	WRITE(cldmspc , fmt='(i1)') idmspc
672	!
673	IF( idmspc < irankpv ) THEN
674	CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', &
675	& 'it is impossible to read a '//clrankpv//'D array from this file...' )
676	ELSEIF( idmspc == irankpv ) THEN
677	IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) &
678	& CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' )
679	ELSEIF( idmspc > irankpv ) THEN
680	IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN
681	CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , &
682	& 'As the size of the z dimension is 1 and as we try to read the first record, ', &
683	& 'we accept this case, even if there is a possible mix-up between z and time dimension' )
684	idmspc = idmspc - 1
685	ELSE
686	CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , &
687	& 'we do not accept data with '//cldmspc//' spatial dimensions', &
688	& 'Use ncwa -a to suppress the unnecessary dimensions' )
689	ENDIF
690	ENDIF
691
692	!
693	! definition of istart and icnt
694	!
695	icnt (:) = 1
696	istart(:) = 1
697	istart(idmspc+1) = itime
698
699	IF( PRESENT(kstart) ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)
700	ELSE
701	IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc)
702	ELSE
703	IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array
704	IF( idom == jpdom_data ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /) ! icnt(1:2) done bellow
705	ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done bellow
706	ENDIF
707	! we do not read the overlap -> we start to read at nldi, nldj
708	! JMM + SM: ugly patch before getting the new version of lib_mpp)
709	! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
710	IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)
711	! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej
712	! JMM + SM: ugly patch before getting the new version of lib_mpp)
713	! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
714	IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)
715	ELSE ; icnt(1:2) = (/ nlci , nlcj /)
716	ENDIF
717	IF( PRESENT(pv_r3d) ) THEN
718	IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta
719	ELSE ; icnt(3) = jpk
720	ENDIF
721	ENDIF
722	ENDIF
723	ENDIF
724	ENDIF
725
726	! check that istart and icnt can be used with this file
727	!-
728	DO jl = 1, jpmax_dims
729	itmp = istart(jl)+icnt(jl)-1
730	IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN
731	WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp
732	WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl)
733	CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )
734	ENDIF
735	END DO
736
737	! check that icnt matches the input array
738	!-
739	IF( idom == jpdom_unknown ) THEN
740	IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d)
741	IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d)
742	IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d)
743	ctmp1 = 'd'
744	ELSE
745	IF( irankpv == 2 ) THEN
746	! JMM + SM: ugly patch before getting the new version of lib_mpp)
747	! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)'
748	IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)'
749	ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)'
750	ENDIF
751	ENDIF
752	IF( irankpv == 3 ) THEN
753	! JMM + SM: ugly patch before getting the new version of lib_mpp)
754	! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'
755	IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'
756	ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'
757	ENDIF
758	ENDIF
759	ENDIF
760
761	DO jl = 1, irankpv
762	WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)
763	IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )
764	END DO
765
766	ENDIF
767
768	! read the data
769	!-
770	IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...
771	!
772	! find the right index of the array to be read
773	! JMM + SM: ugly patch before getting the new version of lib_mpp)
774	! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej
775	! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
776	! ENDIF
777	IF( llnoov ) THEN
778	IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej
779	ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
780	ENDIF
781	ELSE
782	IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj
783	ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)
784	ENDIF
785	ENDIF
786
787	SELECT CASE (iom_file(kiomid)%iolib)
788	CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &
789	& pv_r1d, pv_r2d, pv_r3d )
790	CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &
791	& pv_r1d, pv_r2d, pv_r3d )
792	CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, &
793	& pv_r1d, pv_r2d, pv_r3d )
794	CASE DEFAULT
795	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
796	END SELECT
797
798	IF( istop == nstop ) THEN ! no additional errors until this point...
799	IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)
800
801	!--- overlap areas and extra hallows (mpp)
802	IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN
803	CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' )
804	ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN
805	! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension
806	IF( icnt(3) == jpk ) THEN
807	CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' )
808	ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...)
809	DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO
810	DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO
811	ENDIF
812	ENDIF
813
814	! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain
815	IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. )
816	IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. )
817
818	!--- Apply scale_factor and offset
819	zscf = iom_file(kiomid)%scf(idvar) ! scale factor
820	zofs = iom_file(kiomid)%ofs(idvar) ! offset
821	IF( PRESENT(pv_r1d) ) THEN
822	IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf
823	IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs
824	ELSEIF( PRESENT(pv_r2d) ) THEN
825	!CDIR COLLAPSE
826	IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf
827	!CDIR COLLAPSE
828	IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs
829	ELSEIF( PRESENT(pv_r3d) ) THEN
830	!CDIR COLLAPSE
831	IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
832	!CDIR COLLAPSE
833	IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs
834	ENDIF
835	!
836	ENDIF
837	!
838	ENDIF
839	!
840	END SUBROUTINE iom_get_123d
841
842
843	SUBROUTINE iom_gettime( kiomid, ptime, cdvar, kntime, cdunits, cdcalendar )
844	!!--------------------------------------------------------------------
845	!! * SUBROUTINE iom_gettime *
846	!!
847	!! ** Purpose : read the time axis cdvar in the file
848	!!--------------------------------------------------------------------
849	INTEGER , INTENT(in ) :: kiomid ! file Identifier
850	REAL(wp), DIMENSION(:) , INTENT( out) :: ptime ! the time axis
851	CHARACTER(len=*), OPTIONAL , INTENT(in ) :: cdvar ! time axis name
852	INTEGER , OPTIONAL , INTENT( out) :: kntime ! number of times in file
853	CHARACTER(len=*), OPTIONAL , INTENT( out) :: cdunits ! units attribute of time coordinate
854	CHARACTER(len=*), OPTIONAL , INTENT( out) :: cdcalendar ! calendar attribute of
855	!
856	INTEGER, DIMENSION(1) :: kdimsz
857	INTEGER :: idvar ! id of the variable
858	CHARACTER(LEN=32) :: tname ! local name of time coordinate
859	CHARACTER(LEN=100) :: clinfo ! info character
860	!---------------------------------------------------------------------
861	!
862	IF ( PRESENT(cdvar) ) THEN
863	tname = cdvar
864	ELSE
865	tname = iom_file(kiomid)%uldname
866	ENDIF
867	IF( kiomid > 0 ) THEN
868	clinfo = 'iom_gettime, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(tname)
869	IF ( PRESENT(kntime) ) THEN
870	idvar = iom_varid( kiomid, tname, kdimsz = kdimsz )
871	kntime = kdimsz(1)
872	ELSE
873	idvar = iom_varid( kiomid, tname )
874	ENDIF
875	!
876	ptime(:) = 0. ! default definition
877	IF( idvar > 0 ) THEN
878	IF( iom_file(kiomid)%ndims(idvar) == 1 ) THEN
879	IF( iom_file(kiomid)%luld(idvar) ) THEN
880	IF( iom_file(kiomid)%dimsz(1,idvar) <= size(ptime) ) THEN
881	SELECT CASE (iom_file(kiomid)%iolib)
882	CASE (jpioipsl ) ; CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
883	CASE (jpnf90 ) ; CALL iom_nf90_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
884	CASE (jprstdimg) ; CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' )
885	CASE DEFAULT
886	CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
887	END SELECT
888	ELSE
889	WRITE(ctmp1,*) 'error with the size of ptime ',size(ptime),iom_file(kiomid)%dimsz(1,idvar)
890	CALL ctl_stop( trim(clinfo), trim(ctmp1) )
891	ENDIF
892	ELSE
893	CALL ctl_stop( trim(clinfo), 'variable dimension is not unlimited... use iom_get' )
894	ENDIF
895	ELSE
896	CALL ctl_stop( trim(clinfo), 'the variable has more than 1 dimension' )
897	ENDIF
898	ELSE
899	CALL ctl_stop( trim(clinfo), 'variable not found in '//iom_file(kiomid)%name )
900	ENDIF
901	ENDIF
902	!
903	END SUBROUTINE iom_gettime
904
905
906	!!----------------------------------------------------------------------
907	!! INTERFACE iom_getatt
908	!!----------------------------------------------------------------------
909	SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar )
910	INTEGER , INTENT(in ) :: kiomid ! Identifier of the file
911	CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute
912	INTEGER , INTENT( out) :: pvar ! read field
913	!
914	IF( kiomid > 0 ) THEN
915	IF( iom_file(kiomid)%nfid > 0 ) THEN
916	SELECT CASE (iom_file(kiomid)%iolib)
917	CASE (jpioipsl ) ; CALL ctl_stop('iom_getatt: only nf90 available')
918	CASE (jpnf90 ) ; CALL iom_nf90_getatt( kiomid, cdatt, pvar )
919	CASE (jprstdimg) ; CALL ctl_stop('iom_getatt: only nf90 available')
920	CASE DEFAULT
921	CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
922	END SELECT
923	ENDIF
924	ENDIF
925	END SUBROUTINE iom_g0d_intatt
926
927
928	!!----------------------------------------------------------------------
929	!! INTERFACE iom_rstput
930	!!----------------------------------------------------------------------
931	SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )
932	INTEGER , INTENT(in) :: kt ! ocean time-step
933	INTEGER , INTENT(in) :: kwrite ! writing time-step
934	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
935	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
936	REAL(wp) , INTENT(in) :: pvar ! written field
937	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
938	INTEGER :: ivid ! variable id
939	IF( kiomid > 0 ) THEN
940	IF( iom_file(kiomid)%nfid > 0 ) THEN
941	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
942	SELECT CASE (iom_file(kiomid)%iolib)
943	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
944	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
945	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar )
946	CASE DEFAULT
947	CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
948	END SELECT
949	ENDIF
950	ENDIF
951	END SUBROUTINE iom_rp0d
952
953	SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )
954	INTEGER , INTENT(in) :: kt ! ocean time-step
955	INTEGER , INTENT(in) :: kwrite ! writing time-step
956	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
957	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
958	REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field
959	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
960	INTEGER :: ivid ! variable id
961	IF( kiomid > 0 ) THEN
962	IF( iom_file(kiomid)%nfid > 0 ) THEN
963	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
964	SELECT CASE (iom_file(kiomid)%iolib)
965	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
966	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
967	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar )
968	CASE DEFAULT
969	CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
970	END SELECT
971	ENDIF
972	ENDIF
973	END SUBROUTINE iom_rp1d
974
975	SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )
976	INTEGER , INTENT(in) :: kt ! ocean time-step
977	INTEGER , INTENT(in) :: kwrite ! writing time-step
978	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
979	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
980	REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field
981	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
982	INTEGER :: ivid ! variable id
983	IF( kiomid > 0 ) THEN
984	IF( iom_file(kiomid)%nfid > 0 ) THEN
985	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
986	SELECT CASE (iom_file(kiomid)%iolib)
987	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
988	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
989	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar )
990	CASE DEFAULT
991	CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
992	END SELECT
993	ENDIF
994	ENDIF
995	END SUBROUTINE iom_rp2d
996
997	SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )
998	INTEGER , INTENT(in) :: kt ! ocean time-step
999	INTEGER , INTENT(in) :: kwrite ! writing time-step
1000	INTEGER , INTENT(in) :: kiomid ! Identifier of the file
1001	CHARACTER(len=*), INTENT(in) :: cdvar ! time axis name
1002	REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field
1003	INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type
1004	INTEGER :: ivid ! variable id
1005	IF( kiomid > 0 ) THEN
1006	IF( iom_file(kiomid)%nfid > 0 ) THEN
1007	ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. )
1008	SELECT CASE (iom_file(kiomid)%iolib)
1009	CASE (jpioipsl ) ; CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
1010	CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
1011	CASE (jprstdimg) ; IF( kt == kwrite ) CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar )
1012	CASE DEFAULT
1013	CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
1014	END SELECT
1015	ENDIF
1016	ENDIF
1017	END SUBROUTINE iom_rp3d
1018
1019
1020	!!----------------------------------------------------------------------
1021	!! INTERFACE iom_put
1022	!!----------------------------------------------------------------------
1023	SUBROUTINE iom_p0d( cdname, pfield0d )
1024	CHARACTER(LEN=*), INTENT(in) :: cdname
1025	REAL(wp) , INTENT(in) :: pfield0d
1026	REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson
1027	#if defined key_iomput
1028	zz(:,:)=pfield0d
1029	CALL xios_send_field(cdname, zz)
1030	!CALL xios_send_field(cdname, (/pfield0d/))
1031	#else
1032	IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings
1033	#endif
1034	END SUBROUTINE iom_p0d
1035
1036	SUBROUTINE iom_p1d( cdname, pfield1d )
1037	CHARACTER(LEN=*) , INTENT(in) :: cdname
1038	REAL(wp), DIMENSION(:), INTENT(in) :: pfield1d
1039	#if defined key_iomput
1040	CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) )
1041	#else
1042	IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings
1043	#endif
1044	END SUBROUTINE iom_p1d
1045
1046	SUBROUTINE iom_p2d( cdname, pfield2d )
1047	CHARACTER(LEN=*) , INTENT(in) :: cdname
1048	REAL(wp), DIMENSION(:,:), INTENT(in) :: pfield2d
1049	#if defined key_iomput
1050	CALL xios_send_field(cdname, pfield2d)
1051	#else
1052	IF( .FALSE. ) WRITE(numout,*) cdname, pfield2d ! useless test to avoid compilation warnings
1053	#endif
1054	END SUBROUTINE iom_p2d
1055
1056	SUBROUTINE iom_p3d( cdname, pfield3d )
1057	CHARACTER(LEN=*) , INTENT(in) :: cdname
1058	REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d
1059	#if defined key_iomput
1060	CALL xios_send_field(cdname, pfield3d)
1061	#else
1062	IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings
1063	#endif
1064	END SUBROUTINE iom_p3d
1065	!!----------------------------------------------------------------------
1066
1067	#if defined key_iomput
1068
1069	SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, &
1070	& data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask )
1071	CHARACTER(LEN=*) , INTENT(in) :: cdid
1072	INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj
1073	INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj
1074	INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj
1075	REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue
1076	LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask
1077
1078	IF ( xios_is_valid_domain (cdid) ) THEN
1079	CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
1080	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
1081	& zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, &
1082	& lonvalue=lonvalue, latvalue=latvalue,mask=mask )
1083	ENDIF
1084
1085	IF ( xios_is_valid_domaingroup(cdid) ) THEN
1086	CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &
1087	& data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , &
1088	& zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, &
1089	& lonvalue=lonvalue, latvalue=latvalue,mask=mask )
1090	ENDIF
1091	CALL xios_solve_inheritance()
1092
1093	END SUBROUTINE iom_set_domain_attr
1094
1095
1096	SUBROUTINE iom_set_axis_attr( cdid, paxis )
1097	CHARACTER(LEN=*) , INTENT(in) :: cdid
1098	REAL(wp), DIMENSION(:), INTENT(in) :: paxis
1099	IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=size(paxis),value=paxis )
1100	IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis )
1101	CALL xios_solve_inheritance()
1102	END SUBROUTINE iom_set_axis_attr
1103
1104
1105	SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset )
1106	CHARACTER(LEN=*) , INTENT(in) :: cdid
1107	CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op
1108	CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset
1109	IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset )
1110	IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset )
1111	CALL xios_solve_inheritance()
1112	END SUBROUTINE iom_set_field_attr
1113
1114
1115	SUBROUTINE iom_set_file_attr( cdid, name, name_suffix )
1116	CHARACTER(LEN=*) , INTENT(in) :: cdid
1117	CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix
1118	IF ( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix )
1119	IF ( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix )
1120	CALL xios_solve_inheritance()
1121	END SUBROUTINE iom_set_file_attr
1122
1123
1124	SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq )
1125	CHARACTER(LEN=*) , INTENT(in ) :: cdid
1126	CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix, output_freq
1127	LOGICAL :: llexist1,llexist2,llexist3
1128	!---------------------------------------------------------------------
1129	IF( PRESENT( name ) ) name = '' ! default values
1130	IF( PRESENT( name_suffix ) ) name_suffix = ''
1131	IF( PRESENT( output_freq ) ) output_freq = ''
1132	IF ( xios_is_valid_file (cdid) ) THEN
1133	CALL xios_solve_inheritance()
1134	CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
1135	IF(llexist1) CALL xios_get_file_attr ( cdid, name = name )
1136	IF(llexist2) CALL xios_get_file_attr ( cdid, name_suffix = name_suffix )
1137	IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq )
1138	ENDIF
1139	IF ( xios_is_valid_filegroup(cdid) ) THEN
1140	CALL xios_solve_inheritance()
1141	CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3)
1142	IF(llexist1) CALL xios_get_filegroup_attr( cdid, name = name )
1143	IF(llexist2) CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix )
1144	IF(llexist3) CALL xios_get_filegroup_attr( cdid, output_freq = output_freq )
1145	ENDIF
1146	END SUBROUTINE iom_get_file_attr
1147
1148
1149	SUBROUTINE iom_set_grid_attr( cdid, mask )
1150	CHARACTER(LEN=*) , INTENT(in) :: cdid
1151	LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask
1152	IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask )
1153	IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask )
1154	CALL xios_solve_inheritance()
1155	END SUBROUTINE iom_set_grid_attr
1156
1157	SUBROUTINE iom_setkt( kt, cdname )
1158	INTEGER , INTENT(in) :: kt
1159	CHARACTER(LEN=*), INTENT(in) :: cdname
1160	!
1161	CALL iom_swap( cdname ) ! swap to cdname context
1162	CALL xios_update_calendar(kt)
1163	IF( cdname /= "nemo" ) CALL iom_swap( "nemo" ) ! return back to nemo context
1164	!
1165	END SUBROUTINE iom_setkt
1166
1167	SUBROUTINE iom_context_finalize( cdname )
1168	CHARACTER(LEN=*), INTENT(in) :: cdname
1169	!
1170	CALL iom_swap( cdname ) ! swap to cdname context
1171	CALL xios_context_finalize() ! finalize the context
1172	IF( cdname /= "nemo" ) CALL iom_swap( "nemo" ) ! return back to nemo context
1173	!
1174	END SUBROUTINE iom_context_finalize
1175
1176
1177	SUBROUTINE set_grid( cdgrd, plon, plat )
1178	!!----------------------------------------------------------------------
1179	!! * ROUTINE set_grid *
1180	!!
1181	!! ** Purpose : define horizontal grids
1182	!!
1183	!!----------------------------------------------------------------------
1184	CHARACTER(LEN=1) , INTENT(in) :: cdgrd
1185	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon
1186	REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat
1187	!
1188	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask
1189	INTEGER :: ni,nj
1190
1191	ni=nlei-nldi+1 ; nj=nlej-nldj+1
1192
1193	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)
1194	CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)
1195	CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), &
1196	& latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))
1197
1198	IF ( ln_mskland ) THEN
1199	! mask land points, keep values on coast line -> specific mask for U, V and W points
1200	SELECT CASE ( cdgrd )
1201	CASE('T') ; zmask(:,:,:) = tmask(:,:,:)
1202	CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. )
1203	CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpi,:) ; CALL lbc_lnk( zmask, 'V', 1. )
1204	CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1)
1205	END SELECT
1206	!
1207	CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj /)) /= 0. )
1208	CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. )
1209	ENDIF
1210
1211	END SUBROUTINE set_grid
1212
1213
1214	SUBROUTINE set_scalar
1215	!!----------------------------------------------------------------------
1216	!! * ROUTINE set_scalar *
1217	!!
1218	!! ** Purpose : define fake grids for scalar point
1219	!!
1220	!!----------------------------------------------------------------------
1221	REAL(wp), DIMENSION(1) :: zz = 1.
1222	!!----------------------------------------------------------------------
1223	CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)
1224	CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1)
1225	zz=REAL(narea,wp)
1226	CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz)
1227
1228	END SUBROUTINE set_scalar
1229
1230
1231	SUBROUTINE set_xmlatt
1232	!!----------------------------------------------------------------------
1233	!! * ROUTINE set_xmlatt *
1234	!!
1235	!! ** Purpose : automatic definitions of some of the xml attributs...
1236	!!
1237	!!----------------------------------------------------------------------
1238	CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name
1239	CHARACTER(len=256) :: clsuff ! suffix name
1240	CHARACTER(len=1) :: cl1 ! 1 character
1241	CHARACTER(len=2) :: cl2 ! 1 character
1242	INTEGER :: ji, jg ! loop counters
1243	INTEGER :: ix, iy ! i-,j- index
1244	REAL(wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings
1245	REAL(wp) ,DIMENSION( 7) :: zlattao ! latitudes of tao moorings
1246	REAL(wp) ,DIMENSION( 4) :: zlonrama ! longitudes of rama moorings
1247	REAL(wp) ,DIMENSION(11) :: zlatrama ! latitudes of rama moorings
1248	REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings
1249	REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings
1250	!!----------------------------------------------------------------------
1251	!
1252	! frequency of the call of iom_put (attribut: freq_op)
1253	WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts')
1254	WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op = cl1//'ts', freq_offset='0ts')
1255	WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op = cl1//'ts', freq_offset='0ts')
1256	WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op = cl1//'ts', freq_offset='0ts')
1257	WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op = cl1//'ts', freq_offset='0ts')
1258	WRITE(cl1,'(i1)') nn_fptr ; CALL iom_set_field_attr('diaptr' , freq_op = cl1//'ts', freq_offset='0ts')
1259
1260	! output file names (attribut: name)
1261	DO ji = 1, 9
1262	WRITE(cl1,'(i1)') ji
1263	CALL iom_update_file_name('file'//cl1)
1264	END DO
1265	DO ji = 1, 99
1266	WRITE(cl2,'(i2.2)') ji
1267	CALL iom_update_file_name('file'//cl2)
1268	END DO
1269
1270	! Zooms...
1271	clgrd = (/ 'T', 'U', 'W' /)
1272	DO jg = 1, SIZE(clgrd) ! grid type
1273	cl1 = clgrd(jg)
1274	! Equatorial section (attributs: jbegin, ni, name_suffix)
1275	CALL dom_ngb( 0., 0., ix, iy, cl1 )
1276	CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)
1277	CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff )
1278	CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq')
1279	CALL iom_update_file_name('Eq'//cl1)
1280	END DO
1281	! TAO moorings (attributs: ibegin, jbegin, name_suffix)
1282	zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /)
1283	zlattao = (/ -8.0, -5.0, -2.0, 0.0, 2.0, 5.0, 8.0 /)
1284	CALL set_mooring( zlontao, zlattao )
1285	! RAMA moorings (attributs: ibegin, jbegin, name_suffix)
1286	zlonrama = (/ 55.0, 67.0, 80.5, 90.0 /)
1287	zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /)
1288	CALL set_mooring( zlonrama, zlatrama )
1289	! PIRATA moorings (attributs: ibegin, jbegin, name_suffix)
1290	zlonpira = (/ -38.0, -23.0, -10.0 /)
1291	zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /)
1292	CALL set_mooring( zlonpira, zlatpira )
1293
1294	! diaptr : zonal mean
1295	CALL iom_set_domain_attr ('ptr', zoom_ibegin=nxline, zoom_nj=jpjglo)
1296	CALL iom_update_file_name('ptr')
1297	!
1298	END SUBROUTINE set_xmlatt
1299
1300
1301	SUBROUTINE set_mooring( plon, plat)
1302	!!----------------------------------------------------------------------
1303	!! * ROUTINE set_mooring *
1304	!!
1305	!! ** Purpose : automatic definitions of moorings xml attributs...
1306	!!
1307	!!----------------------------------------------------------------------
1308	REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring
1309	!
1310	!!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name
1311	CHARACTER(len=1),DIMENSION(1) :: clgrd = (/ 'T' /) ! suffix name
1312	CHARACTER(len=256) :: clname ! file name
1313	CHARACTER(len=256) :: clsuff ! suffix name
1314	CHARACTER(len=1) :: cl1 ! 1 character
1315	CHARACTER(len=6) :: clon,clat ! name of longitude, latitude
1316	INTEGER :: ji, jj, jg ! loop counters
1317	INTEGER :: ix, iy ! i-,j- index
1318	REAL(wp) :: zlon, zlat
1319	!!----------------------------------------------------------------------
1320	DO jg = 1, SIZE(clgrd)
1321	cl1 = clgrd(jg)
1322	DO ji = 1, SIZE(plon)
1323	DO jj = 1, SIZE(plat)
1324	zlon = plon(ji)
1325	zlat = plat(jj)
1326	! modifications for RAMA moorings
1327	IF( zlon == 67. .AND. zlat == 15. ) zlon = 65.
1328	IF( zlon == 90. .AND. zlat <= -4. ) zlon = 95.
1329	IF( zlon == 95. .AND. zlat == -4. ) zlat = -5.
1330	! modifications for PIRATA moorings
1331	IF( zlon == -38. .AND. zlat == -19. ) zlon = -34.
1332	IF( zlon == -38. .AND. zlat == -14. ) zlon = -32.
1333	IF( zlon == -38. .AND. zlat == -8. ) zlon = -30.
1334	IF( zlon == -38. .AND. zlat == 0. ) zlon = -35.
1335	IF( zlon == -23. .AND. zlat == 20. ) zlat = 21.
1336	IF( zlon == -10. .AND. zlat == -14. ) zlat = -10.
1337	IF( zlon == -10. .AND. zlat == -8. ) zlat = -6.
1338	IF( zlon == -10. .AND. zlat == 4. ) THEN ; zlon = 0. ; zlat = 0. ; ENDIF
1339	CALL dom_ngb( zlon, zlat, ix, iy, cl1 )
1340	IF( zlon >= 0. ) THEN
1341	IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT( zlon), 'e'
1342	ELSE ; WRITE(clon, '(f5.1,a)') zlon , 'e'
1343	ENDIF
1344	ELSE
1345	IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT(-zlon), 'w'
1346	ELSE ; WRITE(clon, '(f5.1,a)') -zlon , 'w'
1347	ENDIF
1348	ENDIF
1349	IF( zlat >= 0. ) THEN
1350	IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT( zlat), 'n'
1351	ELSE ; WRITE(clat, '(f4.1,a)') zlat , 'n'
1352	ENDIF
1353	ELSE
1354	IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT(-zlat), 's'
1355	ELSE ; WRITE(clat, '(f4.1,a)') -zlat , 's'
1356	ENDIF
1357	ENDIF
1358	clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon))
1359	CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)
1360	CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff )
1361	CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname))
1362	CALL iom_update_file_name(TRIM(clname)//cl1)
1363	END DO
1364	END DO
1365	END DO
1366
1367	END SUBROUTINE set_mooring
1368
1369
1370	SUBROUTINE iom_update_file_name( cdid )
1371	!!----------------------------------------------------------------------
1372	!! * ROUTINE iom_update_file_name *
1373	!!
1374	!! ** Purpose :
1375	!!
1376	!!----------------------------------------------------------------------
1377	CHARACTER(LEN=*) , INTENT(in) :: cdid
1378	!
1379	CHARACTER(LEN=256) :: clname
1380	CHARACTER(LEN=20) :: clfreq
1381	CHARACTER(LEN=20) :: cldate
1382	INTEGER :: idx
1383	INTEGER :: jn
1384	INTEGER :: itrlen
1385	INTEGER :: iyear, imonth, iday, isec
1386	REAL(wp) :: zsec
1387	LOGICAL :: llexist
1388	!!----------------------------------------------------------------------
1389
1390	DO jn = 1,2
1391
1392	IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq )
1393	IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname )
1394
1395	IF ( TRIM(clname) /= '' ) THEN
1396
1397	idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
1398	DO WHILE ( idx /= 0 )
1399	clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname))
1400	idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@')
1401	END DO
1402
1403	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1404	DO WHILE ( idx /= 0 )
1405	IF ( TRIM(clfreq) /= '' ) THEN
1406	itrlen = LEN_TRIM(clfreq)
1407	IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1)
1408	clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname))
1409	ELSE
1410	CALL ctl_stop('error in the name of file id '//TRIM(cdid), &
1411	& ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) )
1412	ENDIF
1413	idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@')
1414	END DO
1415
1416	idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
1417	DO WHILE ( idx /= 0 )
1418	cldate = iom_sdate( fjulday - rdttra(1) / rday )
1419	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname))
1420	idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@')
1421	END DO
1422
1423	idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
1424	DO WHILE ( idx /= 0 )
1425	cldate = iom_sdate( fjulday - rdttra(1) / rday, ldfull = .TRUE. )
1426	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname))
1427	idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@')
1428	END DO
1429
1430	idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
1431	DO WHILE ( idx /= 0 )
1432	cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. )
1433	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname))
1434	idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@')
1435	END DO
1436
1437	idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
1438	DO WHILE ( idx /= 0 )
1439	cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. )
1440	clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname))
1441	idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@')
1442	END DO
1443
1444	IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname )
1445	IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname )
1446
1447	ENDIF
1448
1449	END DO
1450
1451	END SUBROUTINE iom_update_file_name
1452
1453
1454	FUNCTION iom_sdate( pjday, ld24, ldfull )
1455	!!----------------------------------------------------------------------
1456	!! * ROUTINE iom_sdate *
1457	!!
1458	!! ** Purpose : send back the date corresponding to the given julian day
1459	!!
1460	!!----------------------------------------------------------------------
1461	REAL(wp), INTENT(in ) :: pjday ! julian day
1462	LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00
1463	LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss
1464	!
1465	CHARACTER(LEN=20) :: iom_sdate
1466	CHARACTER(LEN=50) :: clfmt ! format used to write the date
1467	INTEGER :: iyear, imonth, iday, ihour, iminute, isec
1468	REAL(wp) :: zsec
1469	LOGICAL :: ll24, llfull
1470	!
1471	IF( PRESENT(ld24) ) THEN ; ll24 = ld24
1472	ELSE ; ll24 = .FALSE.
1473	ENDIF
1474
1475	IF( PRESENT(ldfull) ) THEN ; llfull = ldfull
1476	ELSE ; llfull = .FALSE.
1477	ENDIF
1478
1479	CALL ju2ymds( pjday, iyear, imonth, iday, zsec )
1480	isec = NINT(zsec)
1481
1482	IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day
1483	CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec )
1484	isec = 86400
1485	ENDIF
1486
1487	IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date
1488	ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1
1489	ENDIF
1490
1491	IF( llfull ) THEN
1492	clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2"
1493	ihour = isec / 3600
1494	isec = MOD(isec, 3600)
1495	iminute = isec / 60
1496	isec = MOD(isec, 60)
1497	WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec ! date of the end of run
1498	ELSE
1499	WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run
1500	ENDIF
1501
1502	END FUNCTION iom_sdate
1503
1504	#else
1505
1506
1507	SUBROUTINE iom_setkt( kt, cdname )
1508	INTEGER , INTENT(in):: kt
1509	CHARACTER(LEN=*), INTENT(in) :: cdname
1510	IF( .FALSE. ) WRITE(numout,*) kt, cdname ! useless test to avoid compilation warnings
1511	END SUBROUTINE iom_setkt
1512
1513	SUBROUTINE iom_context_finalize( cdname )
1514	CHARACTER(LEN=*), INTENT(in) :: cdname
1515	IF( .FALSE. ) WRITE(numout,*) cdname ! useless test to avoid compilation warnings
1516	END SUBROUTINE iom_context_finalize
1517
1518	#endif
1519
1520	LOGICAL FUNCTION iom_use( cdname )
1521	CHARACTER(LEN=*), INTENT(in) :: cdname
1522	#if defined key_iomput
1523	iom_use = xios_field_is_active( cdname )
1524	#else
1525	iom_use = .FALSE.
1526	#endif
1527	END FUNCTION iom_use
1528
1529	!!======================================================================
1530	END MODULE iom

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

Download in other formats: