Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

.#fliocom.f90.2.21 @ 4036

Last change on this file since 4036 was 3847, checked in by ymipsl, 10 years ago

Add IOIPSL in the configuration.
Temporary configuration.
Makefile is ready for Curie

File size: 160.7 KB

Line
1	!$Header: /home/ioipsl/CVSROOT/IOIPSL/src/fliocom.f90,v 2.31 2006/02/27 16:24:04 adm Exp $
2	!-
3	MODULE fliocom
4	!---------------------------------------------------------------------
5	USE netcdf
6	!-
7	USE defprec
8	USE calendar, ONLY : lock_calendar,ioget_calendar, &
9	& ioconf_calendar,ju2ymds,ymds2ju
10	USE errioipsl, ONLY : ipslerr,ipsldbg
11	USE stringop, ONLY : strlowercase
12	!-
13	IMPLICIT NONE
14	!-
15	PRIVATE
16	!-
17	PUBLIC :: &
18	& fliocrfd, fliopstc, fliodefv, flioputv, flioputa, &
19	& flioopfd, flioinqf, flioinqn, fliogstc, &
20	& flioinqv, fliogetv, flioinqa, fliogeta, &
21	& fliorenv, fliorena, fliodela, fliocpya, &
22	& flioqstc, fliosync, flioclo, fliodmpf, &
23	& flio_dom_set, flio_dom_unset, &
24	& flio_dom_defset, flio_dom_defunset, flio_dom_definq, &
25	& flio_dom_file, flio_dom_att
26	!-
27	!!--------------------------------------------------------------------
28	!! The following PUBLIC parameters (with "flio_" prefix)
29	!! are used in the module "fliocom" :
30	!!
31	!! flio_max_files : maximum number of simultaneously opened files
32	!! flio_max_dims : maximum number of dimensions for a file
33	!! flio_max_var_dims : maximum number of dimensions for a variable
34	!!
35	!! FLIO_DOM_NONE : "named constant" for no_domain identifier
36	!! FLIO_DOM_DEFAULT : "named constant" for default_domain identifier
37	!!
38	!! flio_i : standard INTEGER external type
39	!! flio_r : standard REAL external type
40	!! flio_c : CHARACTER external type
41	!! flio_i1 : INTEGER*1 external type
42	!! flio_i2 : INTEGER*2 external type
43	!! flio_i4 : INTEGER*4 external type
44	!! flio_r4 : REAL*4 external type
45	!! flio_r8 : REAL*8 external type
46	!!--------------------------------------------------------------------
47	INTEGER,PARAMETER,PUBLIC :: &
48	& flio_max_files=100, flio_max_dims=10, flio_max_var_dims=5
49	INTEGER,PARAMETER,PUBLIC :: &
50	& flio_i = -1, flio_r = -2, flio_c =nf90_char, &
51	& flio_i1=nf90_int1, flio_i2=nf90_int2, flio_i4=nf90_int4, &
52	& flio_r4=nf90_real4, flio_r8=nf90_real8
53	!-
54	INTEGER,PARAMETER,PUBLIC :: FLIO_DOM_NONE =-1
55	INTEGER,PARAMETER,PUBLIC :: FLIO_DOM_DEFAULT = 0
56	!-
57	!!--------------------------------------------------------------------
58	!! The "fliocrfd" routine creates a model file
59	!! which contains the dimensions needed.
60	!!
61	!! SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,mode,c_f_n)
62	!!
63	!! INPUT
64	!!
65	!! (C) f_n : Name of the file to be created
66	!! (C) f_d_n(:) : Array of (max nb_fd_mx) names of the dimensions
67	!! (I) f_d_l(:) : Array of (max nb_fd_mx) lengths of the dimensions
68	!! For an unlimited dimension, enter a length of -1.
69	!! Actually, only one unlimited dimension is supported.
70	!!
71	!! OUTPUT
72	!!
73	!! (I) f_i : Model file identifier
74	!!
75	!! Optional INPUT arguments
76	!!
77	!! (I) id_dom : Identifier of a domain defined by calling
78	!! "flio_dom_set". If this argument is present,
79	!! and not equal to FLIO_DOM_NONE, it will be
80	!! appended to the file name and
81	!! the attributes describing the related DOMAIN
82	!! will be put in the created file.
83	!! This argument can be equal to FLIO_DOM_DEFAULT
84	!! (see "flio_dom_defset").
85	!! (C) mode : Mode used to create the file.
86	!! If this argument is present with the value "REP"
87	!! or the value "REPLACE", the file will be created
88	!! in mode "CLOBBER", else the file will be created
89	!! in mode "NOCLOBBER".
90	!!
91	!! Optional OUTPUT arguments
92	!!
93	!! (C) c_f_n : Name of the created file.
94	!! This name can be different of "f_n",
95	!! if a suffix is added to the original name
96	!! (".nc" or "DOMAIN_identifier.nc").
97	!! The length of "c_f_n" must be sufficient
98	!! to receive the created file name.
99	!!
100	!!- NOTES
101	!!
102	!! The names used to identify the spatio-temporal dimensions
103	!! (dimension associated to a coordinate variable)
104	!! are the following :
105	!!
106	!! Axis Names
107	!!
108	!! x 'x[...]' 'lon[...]'
109	!! y 'y[...]' 'lat[...]'
110	!! z 'z[...]' 'lev[...]' 'plev[...]' 'depth[...]'
111	!! t 't' 'time' 'tstep[...]' 'time_counter[...]'
112	!!
113	!! Please, apply these rules so that coordinates are
114	!! correctly defined.
115	!!--------------------------------------------------------------------
116	!-
117	!!--------------------------------------------------------------------
118	!! The "fliopstc" routine defines the major coordinates system
119	!! (spatio-temporal axis) of the model file (created by fliocrfd).
120	!!
121	!! SUBROUTINE fliopstc &
122	!! & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
123	!! & t_axis,t_init,t_step,t_calendar)
124	!!
125	!! INPUT
126	!!
127	!! (I) f_i : Model file identifier
128	!!
129	!! Optional INPUT arguments
130	!!
131	!! (R) x_axis(:) : longitudinal grids
132	!! (R) x_axis_2d(:,:) : longitudinal grids
133	!! (R) y_axis(:) : latitudinal grids
134	!! (R) y_axis_2d(:,:) : latitudinal grids
135	!! (R) z_axis(:) : vertical grid
136	!! (I) t_axis(:) : timesteps on the time axis
137	!! (R) t_init : date in julian days at the beginning
138	!! (R) t_step : timestep in seconds between t_axis steps
139	!! (C) t_calendar : calendar
140	!!
141	!! [x/y]_axis and [x/y]_axis_2d are mutually exclusive.
142	!!
143	!!- NOTES
144	!!
145	!! The variables corresponding to the spatio-temporal coordinates
146	!! are created according to the following characteristics :
147	!!
148	!!- Longitude axis x_axis / x_axis_2d
149	!! Variable name 'lon' / 'nav_lon'
150	!! Attributes Values
151	!! 'axis' "X"
152	!! 'standard_name' "longitude"
153	!! 'units' "degrees_east"
154	!! 'valid_min' MINVAL(x_axis/x_axis_2d)
155	!! 'valid_max' MAXVAL(x_axis/x_axis_2d)
156	!!
157	!!- Latitude axis y_axis / y_axis_2d
158	!! Variable name 'lat' / 'nav_lat'
159	!! Attributes Values
160	!! 'axis' "Y"
161	!! 'standard_name' "latitude"
162	!! 'units' "degrees_north"
163	!! 'valid_min' MINVAL(y_axis/y_axis_2d)
164	!! 'valid_max' MAXVAL(y_axis/y_axis_2d)
165	!!
166	!!- Vertical axis z_axis
167	!! Variable name 'lev'
168	!! Attributes Values
169	!! 'axis' "Z"
170	!! 'standard_name' "level"
171	!! 'units' "sigma_level"
172	!! 'long_name' "Sigma Levels"
173	!! 'valid_min' MINVAL(z_axis)
174	!! 'valid_max' MAXVAL(z_axis)
175	!!
176	!!- Time axis t_axis
177	!! Variable name 'time'
178	!! Attributes Values
179	!! 'axis' "T"
180	!! 'standard_name' "time"
181	!! 'long_name' "time steps"
182	!! ['calendar' user/default valued]
183	!! 'units' calculated
184	!!
185	!! If you are not satisfied, it is possible
186	!! to rename variables ("fliorenv")
187	!! or overload the values of attributes ("flioputa").
188	!! Be careful : the new values you use must allow to read variables
189	!! as coordinates.
190	!!
191	!! The dimensions associated to the coordinates variables
192	!! are searched according to their names (see "fliocrfd")
193	!!--------------------------------------------------------------------
194	!-
195	INTERFACE fliodefv
196	!!--------------------------------------------------------------------
197	!! The "fliodefv" routines define a variable in a model file.
198	!!
199	!! SUBROUTINE fliodefv &
200	!! & (f_i,v_n,[v_d],v_t, &
201	!! & axis,standard_name,long_name,units,valid_min,valid_max)
202	!!
203	!! INPUT
204	!!
205	!! (I) f_i : Model file identifier
206	!! (C) v_n : Name of variable to be defined
207	!! (I) [v_d] :
208	!! "not present"
209	!! --> scalar variable
210	!! "array of one or several integers containing
211	!! the identifiers of the dimensions of the variable
212	!! (in the order specified to "fliocrfd"
213	!! or obtained from "flioopfd")"
214	!! --> multidimensioned variable
215	!!
216	!! Optional INPUT arguments
217	!!
218	!! (I) v_t : External type of the variable
219	!! "present" --> see flio_..
220	!! "not present" --> type of standard real
221	!! (C) axis,standard_name,long_name,units : Attributes
222	!! (axis should be used only for coordinates)
223	!! (R) valid_min,valid_max : Attributes
224	!!--------------------------------------------------------------------
225	MODULE PROCEDURE &
226	& fliodv_r0d,fliodv_rnd
227	END INTERFACE
228	!-
229	INTERFACE flioputv
230	!!--------------------------------------------------------------------
231	!! The "flioputv" routines put a variable (defined by fliodefv)
232	!! in a model file.
233	!!
234	!! SUBROUTINE flioputv (f_i,v_n,v_v,start,count)
235	!!
236	!! INPUT
237	!!
238	!! (I) f_i : model file identifier
239	!! (C) v_n : name of the variable to be written
240	!! (R/I) v_v : scalar or array (up to flio_max_var_dims dimensions)
241	!! containing the (standard) real/integer values
242	!!
243	!! Optional INPUT arguments
244	!!
245	!! (I) start(:) : array of integers specifying the index
246	!! where the first data value will be written
247	!! (I) count(:) : array of integers specifying the number of
248	!! indices that will be written along each dimension
249	!! (not present if v_v is a scalar)
250	!!--------------------------------------------------------------------
251	!?INTEGERS of KIND 1 are not supported on all computers
252	MODULE PROCEDURE &
253	& fliopv_i40,fliopv_i41,fliopv_i42,fliopv_i43,fliopv_i44,fliopv_i45, &
254	& fliopv_i20,fliopv_i21,fliopv_i22,fliopv_i23,fliopv_i24,fliopv_i25, &
255	!& fliopv_i10,fliopv_i11,fliopv_i12,fliopv_i13,fliopv_i14,fliopv_i15, &
256	& fliopv_r40,fliopv_r41,fliopv_r42,fliopv_r43,fliopv_r44,fliopv_r45, &
257	& fliopv_r80,fliopv_r81,fliopv_r82,fliopv_r83,fliopv_r84,fliopv_r85
258	END INTERFACE
259	!-
260	INTERFACE flioputa
261	!!--------------------------------------------------------------------
262	!! The "flioputa" routines put a value for an attribute
263	!! in a model file.
264	!! If this attribute does not exist, it will be created.
265	!!
266	!! SUBROUTINE flioputa (f_i,v_n,a_n,a_v)
267	!!
268	!! INPUT
269	!!
270	!! (I) f_i : Model file identifier
271	!! (C) v_n : Name of variable to which the attribute is assigned.
272	!! If this name is "?", the attribute will be global.
273	!! (C) a_n : Name of the attribute to be defined.
274	!! ( ) a_v : scalar or array of real (kind 4 or 8) or integer values,
275	!! or character string
276	!!--------------------------------------------------------------------
277	MODULE PROCEDURE &
278	& fliopa_r4_0d,fliopa_r4_1d,fliopa_r8_0d,fliopa_r8_1d, &
279	& fliopa_i4_0d,fliopa_i4_1d,fliopa_tx_0d
280	END INTERFACE
281	!-
282	!!--------------------------------------------------------------------
283	!! The "flioopfd" routine opens an existing model file,
284	!! and returns the dimensions used in the file and a file identifier.
285	!! This information can be used to allocate the space needed
286	!! to extract the data from the file.
287	!!
288	!! SUBROUTINE flioopfd (f_n,f_i,mode,nb_dim,nb_var,nb_gat)
289	!!
290	!! INPUT
291	!!
292	!! (C) f_n : Name of the file to be opened
293	!!
294	!! OUTPUT
295	!!
296	!! (I) f_i : Model file identifier
297	!!
298	!! Optional INPUT arguments
299	!!
300	!! (C) mode : Access mode to the file.
301	!! If this argument is present with the value "WRITE",
302	!! the file will be accessed in mode "READ-WRITE",
303	!! else the file will be accessed in mode "READ-ONLY".
304	!!
305	!! Optional OUTPUT arguments
306	!!
307	!! (I) nb_dim : number of dimensions
308	!! (I) nb_var : number of variables
309	!! (I) nb_gat : number of global attributes
310	!!--------------------------------------------------------------------
311	!-
312	!!--------------------------------------------------------------------
313	!! The "flioinqf" routine returns information
314	!! about an opened model file given its identifier.
315	!!
316	!! SUBROUTINE flioinqf &
317	!! & (f_i,nb_dim,nb_var,nb_gat,id_uld,id_dim,ln_dim)
318	!!
319	!! INPUT
320	!!
321	!! (I) f_i : Model file identifier
322	!!
323	!! Optional OUTPUT arguments
324	!!
325	!! (I) nb_dim : number of dimensions
326	!! (I) nb_var : number of variables
327	!! (I) nb_gat : number of global attributes
328	!! (I) id_uld : identifier of the unlimited dimension (0 if none)
329	!! (I) id_dim(:) : identifiers of the dimensions
330	!! (I) ln_dim(:) : lengths of the dimensions
331	!!--------------------------------------------------------------------
332	!-
333	!!--------------------------------------------------------------------
334	!! The "flioinqn" routine returns the names
335	!! of the entities encountered in an opened model file.
336	!!
337	!! SUBROUTINE flioinqn &
338	!! & (f_i,cn_dim,cn_var,cn_gat,cn_uld, &
339	!! & id_start,id_count,iv_start,iv_count,ia_start,ia_count)
340	!!
341	!! INPUT
342	!!
343	!! (I) f_i : Model file identifier
344	!!
345	!! Optional OUTPUT arguments
346	!!
347	!! (C) cn_dim(:) : names of dimensions
348	!! (C) cn_var(:) : names of variables
349	!! (C) cn_gat(:) : names of global attributes
350	!! (C) cn_uld : names of the unlimited dimension
351	!!
352	!! Optional INPUT arguments
353	!!
354	!! (I) id_start,id_count,iv_start,iv_count,ia_start,ia_count
355	!!
356	!! The prefix ( id / iv / ia ) specifies
357	!! the (dimensions/variables/global attributes) entities
358	!!
359	!! The suffix "start" specify the index from which
360	!! the first name will be retrieved (1 by default)
361	!!
362	!! The suffix "count" specifies the number of names to be retrieved
363	!! (all by default)
364	!!
365	!! If a requested entity is not available, a "?" will be returned.
366	!!--------------------------------------------------------------------
367	!-
368	!!--------------------------------------------------------------------
369	!! The "fliogstc" routine extracts the major coordinates system
370	!! (spatio-temporal axis) of the model file (opened by flioopfd).
371	!!
372	!! SUBROUTINE fliogstc &
373	!! & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
374	!! & t_axis,t_init,t_step,t_calendar, &
375	!! & x_start,x_count,y_start,y_count, &
376	!! & z_start,z_count,t_start,t_count)
377	!!
378	!! INPUT
379	!!
380	!! (I) f_i : Model file identifier
381	!!
382	!! Optional OUTPUT arguments
383	!!
384	!! (R) x_axis(:) : longitudinal grids
385	!! (R) x_axis_2d(:,:) : longitudinal grids
386	!! (R) y_axis(:) : latitudinal grids
387	!! (R) y_axis_2d(:,:) : latitudinal grids
388	!! (R) z_axis(:) : vertical grid
389	!! (I) t_axis(:) : timesteps on the time axis
390	!! (R) t_init : date in julian days at the beginning
391	!! (R) t_step : timestep in seconds between t_axis steps
392	!! (C) t_calendar : calendar attribute
393	!! (the value is "not found" if the attribute
394	!! is not present in the model file)
395	!!
396	!! [x/y]_axis and [x/y]_axis_2d are mutually exclusive.
397	!!
398	!! Optional INPUT arguments
399	!!
400	!! (I) x_start,x_count,y_start,y_count,z_start,z_count,t_start,t_count
401	!!
402	!! The prefix (x/y/z/t) specifies the concerned direction.
403	!!
404	!! The suffix "start" specify the index from which
405	!! the first data value will be read (1 by default)
406	!!
407	!! The suffix "count" specifies the number of values to be read
408	!! (all by default)
409	!!--------------------------------------------------------------------
410	!-
411	!!--------------------------------------------------------------------
412	!! The "flioinqv" routine returns information about a model
413	!! variable given its name.
414	!! This information can be used to allocate the space needed
415	!! to extract the variable from the file.
416	!!
417	!! SUBROUTINE flioinqv &
418	!! & (f_i,v_n,l_ex,nb_dims,len_dims,id_dims, &
419	!! & nb_atts,cn_atts,ia_start,ia_count)
420	!!
421	!! INPUT
422	!!
423	!! (I) f_i : Model file identifier
424	!! (C) v_n : Name of the variable
425	!!
426	!! OUTPUT
427	!!
428	!! (L) l_ex : Existence of the variable
429	!!
430	!! Optional OUTPUT arguments
431	!!
432	!! (I) v_t : External type of the variable (see flio_..)
433	!! (I) nb_dims : number of dimensions of the variable
434	!! (I) len_dims(:) : list of dimension lengths of the variable
435	!! (I) id_dims(:) : list of dimension identifiers of the variable
436	!! (I) nb_atts : number of attributes of the variable
437	!! (C) cn_atts(:) : names of the attributes
438	!!
439	!! Optional INPUT arguments
440	!!
441	!! (I) ia_start : index of the first attribute whose the name
442	!! will be retrieved (1 by default)
443	!! (I) ia_count : number of names to be retrieved (all by default)
444	!!
445	!! If a requested entity is not available, a "?" will be returned.
446	!!--------------------------------------------------------------------
447	!-
448	INTERFACE fliogetv
449	!!--------------------------------------------------------------------
450	!! The "fliogetv" routines get a variable from a model file.
451	!!
452	!! SUBROUTINE fliogetv (f_i,v_n,v_v,start,count)
453	!!
454	!! INPUT
455	!!
456	!! (I) f_i : Model file identifier
457	!! (C) v_n : Name of the variable to be read
458	!!
459	!! OUTPUT
460	!!
461	!! (R/I) v_v : scalar or array (up to flio_max_var_dims dimensions)
462	!! that will contain the (standard) real/integer values
463	!!
464	!! Optional INPUT arguments
465	!!
466	!! (I) start(:) : array of integers specifying the index
467	!! from which the first data value will be read
468	!! (I) count(:) : array of integers specifying the number of
469	!! indices that will be read along each dimension
470	!! (not present if v_v is a scalar)
471	!!--------------------------------------------------------------------
472	!?INTEGERS of KIND 1 are not supported on all computers
473	MODULE PROCEDURE &
474	& fliogv_i40,fliogv_i41,fliogv_i42,fliogv_i43,fliogv_i44,fliogv_i45, &
475	& fliogv_i20,fliogv_i21,fliogv_i22,fliogv_i23,fliogv_i24,fliogv_i25, &
476	!& fliogv_i10,fliogv_i11,fliogv_i12,fliogv_i13,fliogv_i14,fliogv_i15, &
477	& fliogv_r40,fliogv_r41,fliogv_r42,fliogv_r43,fliogv_r44,fliogv_r45, &
478	& fliogv_r80,fliogv_r81,fliogv_r82,fliogv_r83,fliogv_r84,fliogv_r85
479	END INTERFACE
480	!-
481	!!--------------------------------------------------------------------
482	!! The "flioinqa" routine returns information about an
483	!! attribute of a variable given their names, in a model file.
484	!! Information about a variable includes its existence,
485	!! and the number of values currently stored in the attribute.
486	!! For a string-valued attribute, this is the number of
487	!! characters in the string.
488	!! This information can be used to allocate the space needed
489	!! to extract the attribute from the file.
490	!!
491	!! SUBROUTINE flioinqa (f_i,v_n,a_n,l_ex,a_t,a_l)
492	!!
493	!! INPUT
494	!!
495	!! (I) f_i : Model file identifier
496	!! (C) v_n : Name of variable to which the attribute is assigned.
497	!! This name is "?" for a global attribute.
498	!! (C) a_n : Name of the concerned attribute.
499	!!
500	!! OUTPUT
501	!!
502	!! (L) l_ex : existence of the variable
503	!!
504	!! Optional OUTPUT arguments
505	!!
506	!! (I) a_t : external type of the attribute
507	!! (I) a_l : number of values of the attribute
508	!!--------------------------------------------------------------------
509	!-
510	INTERFACE fliogeta
511	!!--------------------------------------------------------------------
512	!! The "fliogeta" routines get a value for an attribute
513	!! in a model file.
514	!!
515	!! SUBROUTINE fliogeta (f_i,v_n,a_n,a_v)
516	!!
517	!! INPUT
518	!!
519	!! (I) f_i : Model file identifier
520	!! (C) v_n : Name of variable to which the attribute is assigned.
521	!! This name is "?" for a global attribute.
522	!! (C) a_n : Name of the attribute to be retrieved.
523	!! ( ) a_v : scalar or array of real (kind 4 or 8) or integer values,
524	!! or character string
525	!!--------------------------------------------------------------------
526	MODULE PROCEDURE &
527	& flioga_r4_0d,flioga_r4_1d,flioga_r8_0d,flioga_r8_1d, &
528	& flioga_i4_0d,flioga_i4_1d,flioga_tx_0d
529	END INTERFACE
530	!-
531	!!--------------------------------------------------------------------
532	!! The "fliorenv" routine renames a variable, in a model file.
533	!!
534	!! SUBROUTINE fliorenv (f_i,v_o_n,v_n_n)
535	!!
536	!! INPUT
537	!!
538	!! (I) f_i : Model file identifier
539	!! (C) v_o_n : Old name of the variable
540	!! (C) v_n_n : New name of the variable
541	!!--------------------------------------------------------------------
542	!-
543	!!--------------------------------------------------------------------
544	!! The "fliorena" routine renames an attribute
545	!! of a variable, in a model file.
546	!!
547	!! SUBROUTINE fliorena (f_i,v_n,a_o_n,a_n_n)
548	!!
549	!! INPUT
550	!!
551	!! (I) f_i : Model file identifier
552	!! (C) v_n : Name of variable to which the attribute is assigned.
553	!! This name is "?" for a global attribute.
554	!! (C) a_o_n : Old name of the concerned attribute.
555	!! (C) a_n_n : New name of the concerned attribute.
556	!!--------------------------------------------------------------------
557	!-
558	!!--------------------------------------------------------------------
559	!! The "fliodela" routine deletes an attribute in a model file.
560	!!
561	!! SUBROUTINE fliodela (f_i,v_n,a_n)
562	!!
563	!! INPUT
564	!!
565	!! (I) f_i : Model file identifier
566	!! (C) v_n : Name of variable to which the attribute is assigned.
567	!! This name is "?" for a global attribute.
568	!! (C) a_n : Name of the concerned attribute.
569	!!--------------------------------------------------------------------
570	!-
571	!!--------------------------------------------------------------------
572	!! The "fliocpya" routine copies an attribute
573	!! from one open model file to another.
574	!! It can also be used to copy an attribute from
575	!! one variable to another within the same model file.
576	!!
577	!! SUBROUTINE fliocpya (f_i_i,v_n_i,a_n,f_i_o,v_n_o)
578	!!
579	!! INPUT
580	!!
581	!! (I) f_i_i : Identifier of the input model file
582	!! (C) v_n_i : Name of the input variable
583	!! This name is "?" for a global attribute.
584	!! (C) a_n : Name of the concerned attribute.
585	!! (I) f_i_o : Identifier of the output model file
586	!! It can be the same as the input identifier.
587	!! (C) v_n_o : Name of the output variable
588	!! This name is "?" for a global attribute.
589	!!--------------------------------------------------------------------
590	!-
591	!!--------------------------------------------------------------------
592	!! The "flioqstc" routine search for a spatio-temporal coordinate
593	!! in a model file and returns its name.
594	!!
595	!! SUBROUTINE flioqstc (f_i,c_type,l_ex,c_name)
596	!!
597	!! INPUT
598	!!
599	!! (I) f_i : Model file identifier
600	!! (C) c_type : Type of the coordinate ("x"/"y"/"z"/"t")
601	!!
602	!! OUTPUT
603	!!
604	!! (L) l_ex : existence of the coordinate
605	!! (C) c_name : name of the coordinate
606	!!
607	!!- NOTES
608	!!
609	!! The following rules are used for searching variables
610	!! which are spatio-temporal coordinates (x/y/z/t).
611	!!
612	!!-- Rule 1 : we look for a correct "axis" attribute
613	!!
614	!! Axis Axis attribute Number of dimensions
615	!! (case insensitive)
616	!!
617	!! x X 1/2
618	!! y Y 1/2
619	!! z Z 1
620	!! t T 1
621	!!
622	!!-- Rule 2 : we look for a specific name
623	!!
624	!! Axis Names
625	!!
626	!! x 'nav_lon' 'lon' 'longitude'
627	!! y 'nav_lat' 'lat' 'latitude'
628	!! z 'depth' 'deptht' 'height' 'level'
629	!! 'lev' 'plev' 'sigma_level' 'layer'
630	!! t 'time' 'tstep' 'timesteps'
631	!!
632	!!-- Rule 3 : we look for a correct "units" attribute
633	!!
634	!! Axis Units
635	!! (case insensitive)
636	!!
637	!! x 'degree_e[...]' 'degrees_e[...]'
638	!! y 'degree_n[...]' 'degrees_n[...]'
639	!! z 'm[...]' 'km[...]' 'hpa[...]'
640	!! t 'week[...]' 'day[...]' 'hour[...]'
641	!! 'minute[...]' 'second[...]' 'timesteps[...]'
642	!!
643	!!-- Rule 4 : we look for a variable with one dimension
644	!!-- and which has the same name as its dimension
645	!!--------------------------------------------------------------------
646	!-
647	!!--------------------------------------------------------------------
648	!! The "fliosync" routine synchronise one or all opened model files,
649	!! to minimize data loss in case of abnormal termination.
650	!!
651	!! SUBROUTINE fliosync (f_i)
652	!!
653	!! Optional INPUT arguments
654	!!
655	!! (I) f_i : Model file identifier
656	!! If this argument is not present,
657	!! all the opened model files are synchronised.
658	!---------------------------------------------------------------------
659	!-
660	!!--------------------------------------------------------------------
661	!! The "flioclo" routine closes one or all opened model files
662	!! and frees the space needed to keep information about the files
663	!!
664	!! SUBROUTINE flioclo (f_i)
665	!!
666	!! Optional INPUT arguments
667	!!
668	!! (I) f_i : Model file identifier
669	!! If this argument is not present,
670	!! all the opened model files are closed.
671	!!--------------------------------------------------------------------
672	!-
673	!!--------------------------------------------------------------------
674	!! The "fliodmpf" routine dumps a model file
675	!! and prints the result on the standard output.
676	!!
677	!! SUBROUTINE fliodmpf (f_n)
678	!!
679	!! INPUT
680	!!
681	!! (C) f_n : Name of the model file to be dumped
682	!!--------------------------------------------------------------------
683	!-
684	!!--------------------------------------------------------------------
685	!! This "flio_dom_set" sets up the domain activity of IOIPSL.
686	!! It stores all the domain information and allows it to be stored
687	!! in the model file and change the file names.
688	!!
689	!! This routine must be called by the user before opening
690	!! the model file.
691	!!
692	!! SUBROUTINE flio_dom_set &
693	!! & (dtnb,dnb,did,dsg,dsl,dpf,dpl,dhs,dhe,cdnm,id_dom)
694	!!
695	!! INPUT
696	!!
697	!! (I) dtnb : total number of domains
698	!! (I) dnb : domain number
699	!! (I) did(:) : distributed dimensions identifiers
700	!! (up to 5 dimensions are supported)
701	!! (I) dsg(:) : total number of points for each dimension
702	!! (I) dsl(:) : local number of points for each dimension
703	!! (I) dpf(:) : position of first local point for each dimension
704	!! (I) dpl(:) : position of last local point for each dimension
705	!! (I) dhs(:) : start halo size for each dimension
706	!! (I) dhe(:) : end halo size for each dimension
707	!! (C) cdnm : Model domain definition name.
708	!! The names actually supported are :
709	!! "BOX", "APPLE", "ORANGE".
710	!! These names are case insensitive.
711	!!
712	!! OUTPUT argument
713	!!
714	!! (I) id_dom : Model domain identifier
715	!!
716	!!--------------------------------------------------------------------
717	!!
718	!!--------------------------------------------------------------------
719	!! The "flio_dom_unset" routine unsets one or all set domains
720	!! and frees the space needed to keep information about the domains
721	!!
722	!! This routine should be called by the user to free useless domains.
723	!!
724	!! SUBROUTINE flio_dom_unset (id_dom)
725	!!
726	!! Optional INPUT arguments
727	!!
728	!! (I) id_dom : Model domain identifier
729	!! >=1 & <= dom_max_nb : the domain is closed
730	!! not present : all the set model domains are unset
731	!!--------------------------------------------------------------------
732	!!
733	!!--------------------------------------------------------------------
734	!! The "flio_dom_defset" sets
735	!! the default domain identifier.
736	!!
737	!! SUBROUTINE flio_dom_defset (id_dom)
738	!!
739	!! INPUT argument
740	!!
741	!! (I) id_dom : Model default domain identifier
742	!! ( >=1 & <= dom_max_nb )
743	!! This identifier will be able to be taken by calling
744	!! "flio_dom_definq" and used to create model files
745	!! with the corresponding domain definitions
746	!!--------------------------------------------------------------------
747	!!
748	!!--------------------------------------------------------------------
749	!! The "flio_dom_defunset" routine unsets
750	!! the default domain identifier.
751	!!
752	!! SUBROUTINE flio_dom_defunset ()
753	!!
754	!!--------------------------------------------------------------------
755	!!
756	!!--------------------------------------------------------------------
757	!! The "flio_dom_definq" routine inquires about
758	!! the default domain identifier.
759	!! You should call this procedure to safeguard the current
760	!! default domain identifier if you wish to use locally
761	!! another default domain, in order to restore it.
762	!!
763	!! SUBROUTINE flio_dom_definq (id_dom)
764	!!
765	!! OUTPUT argument
766	!!
767	!! (I) id_dom : Model default domain identifier
768	!! IF no default domain identifier has been set,
769	!! the returned value is "FLIO_DOM_NONE".
770	!!--------------------------------------------------------------------
771	!-
772	!---------------------------------------------------------------------
773	! This is the data we keep concerning each file we open
774	!---------------------------------------------------------------------
775	!- For each file
776	!- (I) nw_id(f_i) : index to access at this file
777	!- (I) nw_nd(f_i) : number of dimensions
778	!- (I) nw_nv(f_i) : number of variables
779	!- (I) nw_na(f_i) : number of global attributes
780	!- (I) nw_un(f_i) : ID of the first unlimited dimension
781	!- (L) lw_hm(f_i) : for mode handling (.TRUE. define, .FALSE. data)
782	!- (I) nw_di(:,f_i) : dimension IDs in the file "f_i"
783	!- (I) nw_dl(:,f_i) : dimension lengths in the file "f_i"
784	!- (I) nw_ai(:,f_i) : dimension Ids for the axis in the file "f_i"
785	!---------------------------------------------------------------------
786	INTEGER,PARAMETER :: &
787	& nb_fi_mx=flio_max_files, &
788	& nb_fd_mx=flio_max_dims, &
789	& nb_vd_mx=flio_max_var_dims
790	INTEGER,PARAMETER :: nb_ax_mx=4
791	!-
792	INTEGER,PARAMETER :: k_lon=1, k_lat=2, k_lev=3, k_tim=4
793	!-
794	INTEGER,DIMENSION(nb_fi_mx),SAVE :: &
795	& nw_id=-1,nw_nd,nw_nv,nw_na,nw_un
796	LOGICAL,DIMENSION(nb_fi_mx),SAVE :: lw_hm
797	INTEGER,DIMENSION(nb_fd_mx,nb_fi_mx),SAVE :: nw_di=-1,nw_dl=-1
798	INTEGER,DIMENSION(nb_ax_mx,nb_fi_mx),SAVE :: nw_ai=-1
799	!-
800	! Maximum number of simultaneously defined domains
801	INTEGER,PARAMETER :: dom_max_nb=10
802	!-
803	! Maximum number of distributed dimensions for each domain
804	INTEGER,PARAMETER :: dom_max_dims=5
805	!-
806	! Default domain identifier
807	INTEGER,SAVE :: id_def_dom=FLIO_DOM_NONE
808	!-
809	! Supported domain definition names
810	INTEGER,PARAMETER :: n_dns=3, l_dns=7
811	CHARACTER(LEN=l_dns),DIMENSION(n_dns),SAVE :: &
812	& c_dns=(/ "box ","apple ","orange "/)
813	!-
814	! DOMAINS related variables
815	INTEGER,DIMENSION(1:dom_max_nb),SAVE :: &
816	& d_d_n=-1, d_n_t=0, d_n_c=0
817	INTEGER,DIMENSION(1:dom_max_dims,1:dom_max_nb),SAVE :: &
818	& d_d_i, d_s_g, d_s_l, d_p_f, d_p_l, d_h_s, d_h_e
819	CHARACTER(LEN=l_dns),DIMENSION(1:dom_max_nb),SAVE :: c_d_t
820	!-
821	!===
822	CONTAINS
823	!===
824	!-
825	!---------------------------------------------------------------------
826	!- Public procedures
827	!---------------------------------------------------------------------
828	!-
829	!===
830	SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,mode,c_f_n)
831	!---------------------------------------------------------------------
832	IMPLICIT NONE
833	!-
834	CHARACTER(LEN=*),INTENT(IN) :: f_n
835	CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: f_d_n
836	INTEGER,DIMENSION(:),INTENT(IN) :: f_d_l
837	INTEGER,INTENT(OUT) :: f_i
838	INTEGER,OPTIONAL,INTENT(IN) :: id_dom
839	CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
840	CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: c_f_n
841	!-
842	INTEGER :: i_rc,f_e,idid,ii,m_c,n_u
843	CHARACTER(LEN=NF90_MAX_NAME) :: f_nw
844	!-
845	LOGICAL :: l_dbg
846	!---------------------------------------------------------------------
847	CALL ipsldbg (old_status=l_dbg)
848	!-
849	IF (l_dbg) THEN
850	WRITE(,) "->fliocrfd - file name : ",TRIM(f_n)
851	ENDIF
852	!-
853	! Search for a free local identifier
854	f_i = flio_rid()
855	IF (f_i < 0) THEN
856	CALL ipslerr (3,'fliocrfd', &
857	& 'Too many files.','Please increase nb_fi_mx', &
858	& 'in module fliocom.f90.')
859	ENDIF
860	!-
861	! Update the name of the file
862	f_nw = f_n
863	CALL flio_dom_file (f_nw,id_dom)
864	!-
865	! Check the dimensions
866	IF (SIZE(f_d_l) /= SIZE(f_d_n)) THEN
867	CALL ipslerr (3,'fliocrfd', &
868	& 'The number of names is not equal to the number of lengths', &
869	& 'for the dimensions of the file',TRIM(f_nw))
870	ENDIF
871	IF (SIZE(f_d_l) > nb_fd_mx) THEN
872	CALL ipslerr (3,'fliocrfd', &
873	& 'Too many dimensions','to create the file',TRIM(f_nw))
874	ENDIF
875	!-
876	! Check the mode
877	IF (PRESENT(mode)) THEN
878	IF ( (TRIM(MODE) == "REPLACE").OR.(TRIM(MODE) == "REP") ) THEN
879	m_c = NF90_CLOBBER
880	ELSE
881	m_c = NF90_NOCLOBBER
882	ENDIF
883	ELSE
884	m_c = NF90_NOCLOBBER
885	ENDIF
886	!-
887	! Create file (and enter the definition mode)
888	i_rc = NF90_CREATE(f_nw,m_c,f_e)
889	lw_hm(f_i) = .TRUE.
890	IF (i_rc /= NF90_NOERR) THEN
891	CALL ipslerr (3,'fliocrfd', &
892	& 'Could not create file :',TRIM(f_nw),'(Use REPLACE mode)')
893	ENDIF
894	!-
895	IF (l_dbg) THEN
896	WRITE(,) ' fliocrfd, external model file-id : ',f_e
897	ENDIF
898	!-
899	! Create dimensions
900	n_u = 0
901	DO ii=1,SIZE(f_d_l)
902	IF (f_d_l(ii) == -1) THEN
903	IF (n_u == 0) THEN
904	i_rc = NF90_DEF_DIM(f_e,TRIM(f_d_n(ii)),NF90_UNLIMITED,idid)
905	n_u = n_u+1
906	ELSE
907	CALL ipslerr (3,'fliocrfd', &
908	& 'Can not handle more than one unlimited dimension', &
909	& 'for file :',TRIM(f_nw))
910	ENDIF
911	ELSE IF (f_d_l(ii) > 0) THEN
912	i_rc = NF90_DEF_DIM(f_e,TRIM(f_d_n(ii)),f_d_l(ii),idid)
913	ENDIF
914	IF ( ((f_d_l(ii) == -1).OR.(f_d_l(ii) > 0)) &
915	& .AND.(i_rc /= NF90_NOERR) ) THEN
916	CALL ipslerr (3,'fliocrfd', &
917	& 'One dimension can not be defined', &
918	& 'for the file :',TRIM(f_nw))
919	ENDIF
920	ENDDO
921	!-
922	! Define "Conventions" global attribute
923	i_rc = NF90_PUT_ATT(f_e,NF90_GLOBAL,'Conventions',"CF-1.0")
924	!-
925	! Add the DOMAIN attributes if needed
926	CALL flio_dom_att (f_e,id_dom)
927	!-
928	! Keep the file information
929	nw_id(f_i) = f_e
930	CALL flio_inf (f_e, &
931	& nb_dims=nw_nd(f_i),id_unlm=nw_un(f_i),nb_atts=nw_na(f_i), &
932	& nn_idm=nw_di(:,f_i),nn_ldm=nw_dl(:,f_i),nn_aid=nw_ai(:,f_i))
933	!-
934	! Return the created file name if needed
935	IF (PRESENT(c_f_n)) THEN
936	IF (LEN(c_f_n) >= LEN_TRIM(f_nw)) THEN
937	c_f_n = TRIM(f_nw)
938	ELSE
939	CALL ipslerr (3,'fliocrfd', &
940	& 'the length of "c_f_n" is not sufficient to receive', &
941	& 'the name of the created file :',TRIM(f_nw))
942	ENDIF
943	ENDIF
944	!-
945	IF (l_dbg) THEN
946	WRITE(,) '<-fliocrfd'
947	ENDIF
948	!----------------------
949	END SUBROUTINE fliocrfd
950	!===
951	SUBROUTINE fliopstc &
952	& (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
953	& t_axis,t_init,t_step,t_calendar)
954	!---------------------------------------------------------------------
955	IMPLICIT NONE
956	!-
957	INTEGER,INTENT(IN) :: f_i
958	REAL,DIMENSION(:),OPTIONAL,INTENT(IN) :: x_axis,y_axis
959	REAL,DIMENSION(:,:),OPTIONAL,INTENT(IN) :: x_axis_2d,y_axis_2d
960	REAL,DIMENSION(:),OPTIONAL,INTENT(IN) :: z_axis
961	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: t_axis
962	CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: t_calendar
963	REAL,OPTIONAL,INTENT(IN) :: t_init,t_step
964	!-
965	INTEGER :: i_rc,f_e
966	INTEGER :: lonid,latid,levid,timeid
967	INTEGER :: j_yy,j_mo,j_dd,j_hh,j_mn,j_ss
968	REAL :: dt,r_ss,v_min,v_max
969	INTEGER :: k,k_1,k_2
970	LOGICAL :: l_tmp
971	CHARACTER(LEN=20) :: c_tmp1
972	CHARACTER(LEN=40) :: c_tmp2
973	CHARACTER(LEN=80) :: c_tmp3
974	!-
975	LOGICAL :: l_dbg
976	!---------------------------------------------------------------------
977	CALL ipsldbg (old_status=l_dbg)
978	!-
979	IF (l_dbg) THEN
980	WRITE(,) "->fliopstc"
981	ENDIF
982	!-
983	! Retrieve the external file index
984	CALL flio_qvid ('fliopstc',f_i,f_e)
985	!-
986	! Validate the coherence of the arguments
987	!-
988	IF ( (PRESENT(x_axis).AND.PRESENT(x_axis_2d)) &
989	& .OR.(PRESENT(y_axis).AND.PRESENT(y_axis_2d)) ) THEN
990	CALL ipslerr (3,'fliopstc', &
991	& 'The [x/y]_axis arguments', &
992	& 'are not coherent :',&
993	& 'can not handle two [x/y]_axis')
994	ENDIF
995	!-
996	IF ( PRESENT(x_axis).OR.PRESENT(x_axis_2d) &
997	& .OR.PRESENT(y_axis).OR.PRESENT(y_axis_2d) ) THEN
998	k_1=nw_ai(k_lon,f_i); k_2=nw_ai(k_lat,f_i);
999	ENDIF
1000	!-
1001	! Define the longitude axis
1002	!-
1003	IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
1004	!---
1005	IF (l_dbg) THEN
1006	WRITE(,) ' fliopstc : Define the Longitude axis'
1007	ENDIF
1008	!---
1009	IF (PRESENT(x_axis)) THEN
1010	IF (SIZE(x_axis) /= nw_dl(k_1,f_i)) THEN
1011	CALL ipslerr (3,'fliopstc', &
1012	& 'Invalid x_axis dimension :', &
1013	& 'not equal to the dimension', &
1014	& 'defined at the creation of the file')
1015	ENDIF
1016	ELSE
1017	IF ( (SIZE(x_axis_2d,DIM=1) /= nw_dl(k_1,f_i)) &
1018	& .OR.(SIZE(x_axis_2d,DIM=2) /= nw_dl(k_2,f_i)) ) THEN
1019	CALL ipslerr (3,'fliopstc', &
1020	& 'Invalid x_axis_2d dimensions :', &
1021	& 'not equal to the dimensions', &
1022	& 'defined at the creation of the file')
1023	ENDIF
1024	ENDIF
1025	!---
1026	CALL flio_hdm (f_i,f_e,.TRUE.)
1027	IF (PRESENT(x_axis)) THEN
1028	i_rc = NF90_DEF_VAR(f_e,"lon",NF90_REAL4, &
1029	& nw_di(k_1,f_i),lonid)
1030	v_min = MINVAL(x_axis)
1031	v_max = MAXVAL(x_axis)
1032	ELSE
1033	i_rc = NF90_DEF_VAR(f_e,"nav_lon",NF90_REAL4, &
1034	& nw_di((/k_1,k_2/),f_i),lonid)
1035	v_min = MINVAL(x_axis_2d)
1036	v_max = MAXVAL(x_axis_2d)
1037	ENDIF
1038	i_rc = NF90_PUT_ATT(f_e,lonid,"axis","X")
1039	i_rc = NF90_PUT_ATT(f_e,lonid,'standard_name',"longitude")
1040	i_rc = NF90_PUT_ATT(f_e,lonid,'units',"degrees_east")
1041	i_rc = NF90_PUT_ATT(f_e,lonid,'valid_min',REAL(v_min,KIND=4))
1042	i_rc = NF90_PUT_ATT(f_e,lonid,'valid_max',REAL(v_max,KIND=4))
1043	ENDIF
1044	!-
1045	! Define the Latitude axis
1046	!-
1047	IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
1048	!---
1049	IF (l_dbg) THEN
1050	WRITE(,) ' fliopstc : Define the Latitude axis'
1051	ENDIF
1052	!---
1053	IF (PRESENT(y_axis)) THEN
1054	IF (SIZE(y_axis) /= nw_dl(k_2,f_i)) THEN
1055	CALL ipslerr (3,'fliopstc', &
1056	& 'Invalid y_axis dimension :', &
1057	& 'not equal to the dimension', &
1058	& 'defined at the creation of the file')
1059	ENDIF
1060	ELSE
1061	IF ( (SIZE(y_axis_2d,DIM=1) /= nw_dl(k_1,f_i)) &
1062	& .OR.(SIZE(y_axis_2d,DIM=2) /= nw_dl(k_2,f_i)) ) THEN
1063	CALL ipslerr (3,'fliopstc', &
1064	& 'Invalid y_axis_2d dimensions :', &
1065	& 'not equal to the dimensions', &
1066	& 'defined at the creation of the file')
1067	ENDIF
1068	ENDIF
1069	!---
1070	CALL flio_hdm (f_i,f_e,.TRUE.)
1071	IF (PRESENT(y_axis)) THEN
1072	i_rc = NF90_DEF_VAR(f_e,"lat",NF90_REAL4, &
1073	& nw_di(k_2,f_i),latid)
1074	v_min = MINVAL(y_axis)
1075	v_max = MAXVAL(y_axis)
1076	ELSE
1077	i_rc = NF90_DEF_VAR(f_e,"nav_lat",NF90_REAL4, &
1078	& nw_di((/k_1,k_2/),f_i),latid)
1079	v_min = MINVAL(y_axis_2d)
1080	v_max = MAXVAL(y_axis_2d)
1081	ENDIF
1082	i_rc = NF90_PUT_ATT(f_e,latid,"axis","Y")
1083	i_rc = NF90_PUT_ATT(f_e,latid,'standard_name',"latitude")
1084	i_rc = NF90_PUT_ATT(f_e,latid,'units',"degrees_north")
1085	i_rc = NF90_PUT_ATT(f_e,latid,'valid_min',REAL(v_min,KIND=4))
1086	i_rc = NF90_PUT_ATT(f_e,latid,'valid_max',REAL(v_max,KIND=4))
1087	ENDIF
1088	!-
1089	! Define the Vertical axis
1090	!-
1091	IF (PRESENT(z_axis)) THEN
1092	!---
1093	IF (l_dbg) THEN
1094	WRITE(,) ' fliopstc : Define the Vertical axis'
1095	ENDIF
1096	!---
1097	k_1=nw_ai(k_lev,f_i);
1098	!---
1099	IF (SIZE(z_axis) /= nw_dl(k_1,f_i)) THEN
1100	CALL ipslerr (3,'fliopstc', &
1101	& 'Invalid z_axis dimension :', &
1102	& 'not equal to the dimension', &
1103	& 'defined at the creation of the file')
1104	ENDIF
1105	!---
1106	v_min = MINVAL(z_axis)
1107	v_max = MAXVAL(z_axis)
1108	!---
1109	CALL flio_hdm (f_i,f_e,.TRUE.)
1110	i_rc = NF90_DEF_VAR(f_e,'lev',NF90_REAL4, &
1111	& nw_di(k_1,f_i),levid)
1112	i_rc = NF90_PUT_ATT(f_e,levid,"axis","Z")
1113	i_rc = NF90_PUT_ATT(f_e,levid,'standard_name','level')
1114	i_rc = NF90_PUT_ATT(f_e,levid,'units','sigma_level')
1115	i_rc = NF90_PUT_ATT(f_e,levid,'long_name','Sigma Levels')
1116	i_rc = NF90_PUT_ATT(f_e,levid,'valid_min',REAL(v_min,KIND=4))
1117	i_rc = NF90_PUT_ATT(f_e,levid,'valid_max',REAL(v_max,KIND=4))
1118	ENDIF
1119	!-
1120	! Define the Time axis
1121	!-
1122	IF (PRESENT(t_axis).AND.PRESENT(t_init).AND.PRESENT(t_step)) THEN
1123	!---
1124	IF (l_dbg) THEN
1125	WRITE(,) ' fliopstc : Define the Time axis'
1126	ENDIF
1127	!---
1128	k_1=nw_ai(k_tim,f_i);
1129	!---
1130	IF ( (nw_dl(k_1,f_i) /= 0) &
1131	& .AND.(SIZE(t_axis) /= nw_dl(k_1,f_i)) ) THEN
1132	CALL ipslerr (3,'fliopstc', &
1133	& 'Invalid t_axis dimension :', &
1134	& 'not equal to the dimension', &
1135	& 'defined at the creation of the file')
1136	ENDIF
1137	!-- Retrieve the calendar date
1138	CALL lock_calendar (old_status=l_tmp)
1139	IF (PRESENT(t_calendar)) THEN
1140	CALL ioget_calendar (c_tmp1)
1141	CALL lock_calendar (new_status=.FALSE.)
1142	CALL ioconf_calendar (TRIM(t_calendar))
1143	ENDIF
1144	CALL ju2ymds (t_init,j_yy,j_mo,j_dd,r_ss)
1145	IF (PRESENT(t_calendar)) THEN
1146	CALL lock_calendar (new_status=.FALSE.)
1147	CALL ioconf_calendar (TRIM(c_tmp1))
1148	ENDIF
1149	CALL lock_calendar (new_status=l_tmp)
1150	!--
1151	k=NINT(r_ss)
1152	j_hh=k/3600
1153	k=k-3600*j_hh
1154	j_mn=k/60
1155	j_ss=k-60*j_mn
1156	!-- Calculate the step unit
1157	IF (ABS(t_step) >= 604800.) THEN
1158	dt = t_step/604800.
1159	c_tmp2 = 'weeks'
1160	ELSE IF (ABS(t_step) >= 86400.) THEN
1161	dt = t_step/86400.
1162	c_tmp2 = 'days'
1163	ELSE IF (ABS(t_step) >= 3600.) THEN
1164	dt = t_step/3600.
1165	c_tmp2 = 'hours'
1166	ELSE IF (ABS(t_step) >= 60.) THEN
1167	dt = t_step/60.
1168	c_tmp2 = 'minutes'
1169	ELSE
1170	dt = t_step
1171	c_tmp2 = 'seconds'
1172	ENDIF
1173	!---
1174	c_tmp1 = ''
1175	IF (ABS(dt-NINT(dt)) <= ABS(10.*EPSILON(dt))) THEN
1176	IF (NINT(dt) /= 1) THEN
1177	WRITE (UNIT=c_tmp1,FMT='(I15)') NINT(dt)
1178	ENDIF
1179	ELSE
1180	IF (dt < 1.) THEN
1181	WRITE (UNIT=c_tmp1,FMT='(F8.5)') dt
1182	ELSE
1183	WRITE (UNIT=c_tmp1,FMT='(F17.5)') dt
1184	ENDIF
1185	DO k=LEN_TRIM(c_tmp1),1,-1
1186	IF (c_tmp1(k:k) /= '0') THEN
1187	EXIT
1188	ELSE
1189	c_tmp1(k:k) = ' '
1190	ENDIF
1191	ENDDO
1192	ENDIF
1193	c_tmp2 = TRIM(c_tmp1)//' '//TRIM(c_tmp2)
1194	WRITE (UNIT=c_tmp3, &
1195	& FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
1196	& TRIM(ADJUSTL(c_tmp2))//' since ',j_yy,j_mo,j_dd,j_hh,j_mn,j_ss
1197	!---
1198	CALL flio_hdm (f_i,f_e,.TRUE.)
1199	i_rc = NF90_DEF_VAR(f_e,'time',NF90_REAL4, &
1200	& nw_di(k_1,f_i),timeid)
1201	i_rc = NF90_PUT_ATT(f_e,timeid,"axis",'T')
1202	i_rc = NF90_PUT_ATT(f_e,timeid,'standard_name','time')
1203	i_rc = NF90_PUT_ATT(f_e,timeid,'long_name','time steps')
1204	IF (PRESENT(t_calendar)) THEN
1205	i_rc = NF90_PUT_ATT(f_e,timeid,'calendar',TRIM(t_calendar))
1206	ENDIF
1207	i_rc = NF90_PUT_ATT(f_e,timeid,'units',TRIM(c_tmp3))
1208	ELSE IF (PRESENT(t_axis).OR.PRESENT(t_init).OR.PRESENT(t_step)) THEN
1209	CALL ipslerr (3,'fliopstc', &
1210	& 'For time axis and coordinates', &
1211	& 'arguments t_axis AND t_init AND t_step', &
1212	& 'must be PRESENT')
1213	ENDIF
1214	!-
1215	! Ensuring data mode
1216	!-
1217	CALL flio_hdm (f_i,f_e,.FALSE.)
1218	!-
1219	! Create the longitude axis
1220	!-
1221	IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
1222	IF (l_dbg) THEN
1223	WRITE(,) ' fliopstc : Create the Longitude axis'
1224	ENDIF
1225	IF (PRESENT(x_axis)) THEN
1226	i_rc = NF90_PUT_VAR(f_e,lonid,x_axis(:))
1227	ELSE
1228	i_rc = NF90_PUT_VAR(f_e,lonid,x_axis_2d(:,:))
1229	ENDIF
1230	ENDIF
1231	!-
1232	! Create the Latitude axis
1233	!-
1234	IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
1235	IF (l_dbg) THEN
1236	WRITE(,) ' fliopstc : Create the Latitude axis'
1237	ENDIF
1238	IF (PRESENT(y_axis)) THEN
1239	i_rc = NF90_PUT_VAR(f_e,latid,y_axis(:))
1240	ELSE
1241	i_rc = NF90_PUT_VAR(f_e,latid,y_axis_2d(:,:))
1242	ENDIF
1243	ENDIF
1244	!-
1245	! Create the Vertical axis
1246	!-
1247	IF (PRESENT(z_axis)) THEN
1248	IF (l_dbg) THEN
1249	WRITE(,) ' fliopstc : Create the Vertical axis'
1250	ENDIF
1251	i_rc = NF90_PUT_VAR(f_e,levid,z_axis(:))
1252	ENDIF
1253	!-
1254	! Create the Time axis
1255	!-
1256	IF (PRESENT(t_axis)) THEN
1257	IF (l_dbg) THEN
1258	WRITE(,) ' fliopstc : Create the Time axis'
1259	ENDIF
1260	i_rc = NF90_PUT_VAR(f_e,timeid,REAL(t_axis(:)))
1261	ENDIF
1262	!-
1263	! Keep all this information
1264	!-
1265	CALL flio_inf (f_e,nb_vars=nw_nv(f_i),nb_atts=nw_na(f_i))
1266	!-
1267	IF (l_dbg) THEN
1268	WRITE(,) "<-fliopstc"
1269	ENDIF
1270	!----------------------
1271	END SUBROUTINE fliopstc
1272	!===
1273	SUBROUTINE fliodv_r0d &
1274	& (f_i,v_n,v_t, &
1275	& axis,standard_name,long_name,units,valid_min,valid_max)
1276	!---------------------------------------------------------------------
1277	IMPLICIT NONE
1278	!-
1279	INTEGER,INTENT(IN) :: f_i
1280	CHARACTER(LEN=*),INTENT(IN) :: v_n
1281	INTEGER,OPTIONAL,INTENT(IN) :: v_t
1282	CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
1283	& axis,standard_name,long_name,units
1284	REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max
1285	!---------------------------------------------------------------------
1286	CALL flio_udv &
1287	& (f_i,0,v_n,(/0/),v_t, &
1288	& axis,standard_name,long_name,units,valid_min,valid_max)
1289	!------------------------
1290	END SUBROUTINE fliodv_r0d
1291	!===
1292	SUBROUTINE fliodv_rnd &
1293	& (f_i,v_n,v_d,v_t, &
1294	& axis,standard_name,long_name,units,valid_min,valid_max)
1295	!---------------------------------------------------------------------
1296	IMPLICIT NONE
1297	!-
1298	INTEGER,INTENT(IN) :: f_i
1299	CHARACTER(LEN=*),INTENT(IN) :: v_n
1300	INTEGER,DIMENSION(:),INTENT(IN) :: v_d
1301	INTEGER,OPTIONAL,INTENT(IN) :: v_t
1302	CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
1303	& axis,standard_name,long_name,units
1304	REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max
1305	!---------------------------------------------------------------------
1306	CALL flio_udv &
1307	& (f_i,SIZE(v_d),v_n,v_d,v_t, &
1308	& axis,standard_name,long_name,units,valid_min,valid_max)
1309	!------------------------
1310	END SUBROUTINE fliodv_rnd
1311	!===
1312	SUBROUTINE flio_udv &
1313	& (f_i,n_d,v_n,v_d,v_t, &
1314	& axis,standard_name,long_name,units,valid_min,valid_max)
1315	!---------------------------------------------------------------------
1316	IMPLICIT NONE
1317	!-
1318	INTEGER,INTENT(IN) :: f_i,n_d
1319	CHARACTER(LEN=*),INTENT(IN) :: v_n
1320	INTEGER,DIMENSION(:),INTENT(IN) :: v_d
1321	INTEGER,OPTIONAL,INTENT(IN) :: v_t
1322	CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
1323	& axis,standard_name,long_name,units
1324	REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max
1325	!-
1326	INTEGER :: f_e,m_k,i_v,i_rc,ii,idd
1327	INTEGER,DIMENSION(nb_vd_mx) :: a_i
1328	!-
1329	LOGICAL :: l_dbg
1330	!---------------------------------------------------------------------
1331	CALL ipsldbg (old_status=l_dbg)
1332	!-
1333	IF (l_dbg) THEN
1334	WRITE(,) "->fliodefv ",TRIM(v_n)," ",n_d,"D"
1335	ENDIF
1336	!-
1337	! Retrieve the external file index
1338	CALL flio_qvid ('fliodefv',f_i,f_e)
1339	!-
1340	IF (n_d > 0) THEN
1341	IF (n_d > nb_vd_mx) THEN
1342	CALL ipslerr (3,'fliodefv', &
1343	& 'Too many dimensions', &
1344	& 'required for the variable',TRIM(v_n))
1345	ENDIF
1346	ENDIF
1347	!-
1348	DO ii=1,n_d
1349	IF ( (v_d(ii) >= 1).AND.(v_d(ii) <= nb_fd_mx) ) THEN
1350	idd = nw_di(v_d(ii),f_i)
1351	IF (idd > 0) THEN
1352	a_i(ii) = idd
1353	ELSE
1354	CALL ipslerr (3,'fliodefv', &
1355	& 'Invalid dimension identifier','(not defined)',' ')
1356	ENDIF
1357	ELSE
1358	CALL ipslerr (3,'fliodefv', &
1359	& 'Invalid dimension identifier','(not supported)',' ')
1360	ENDIF
1361	ENDDO
1362	!-
1363	i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
1364	IF (i_rc /= NF90_NOERR) THEN
1365	CALL flio_hdm (f_i,f_e,.TRUE.)
1366	!---
1367	IF (PRESENT(v_t)) THEN
1368	IF (v_t == flio_i) THEN
1369	IF (i_std == i_8) THEN
1370	!-------- Not yet supported by NETCDF
1371	!-------- m_k = flio_i8
1372	m_k = flio_i4
1373	ELSE
1374	m_k = flio_i4
1375	ENDIF
1376	ELSE IF (v_t == flio_r) THEN
1377	IF (r_std == r_8) THEN
1378	m_k = flio_r8
1379	ELSE
1380	m_k = flio_r4
1381	ENDIF
1382	ELSE
1383	m_k = v_t
1384	ENDIF
1385	ELSE IF (r_std == r_8) THEN
1386	m_k = flio_r8
1387	ELSE
1388	m_k = flio_r4
1389	ENDIF
1390	IF (n_d > 0) THEN
1391	i_rc = NF90_DEF_VAR(f_e,v_n,m_k,a_i(1:n_d),i_v)
1392	ELSE
1393	i_rc = NF90_DEF_VAR(f_e,v_n,m_k,i_v)
1394	ENDIF
1395	IF (i_rc /= NF90_NOERR) THEN
1396	CALL ipslerr (3,'fliodefv', &
1397	& 'Variable '//TRIM(v_n)//' not defined','Error :', &
1398	& TRIM(NF90_STRERROR(i_rc)))
1399	ENDIF
1400	nw_nv(f_i) = nw_nv(f_i)+1
1401	!---
1402	IF (PRESENT(axis)) THEN
1403	i_rc = NF90_PUT_ATT(f_e,i_v,'axis',TRIM(axis))
1404	ENDIF
1405	IF (PRESENT(standard_name)) THEN
1406	i_rc = NF90_PUT_ATT(f_e,i_v,'standard_name',TRIM(standard_name))
1407	ENDIF
1408	IF (PRESENT(long_name)) THEN
1409	i_rc = NF90_PUT_ATT(f_e,i_v,'long_name',TRIM(long_name))
1410	ENDIF
1411	IF (PRESENT(units)) THEN
1412	i_rc = NF90_PUT_ATT(f_e,i_v,'units',TRIM(units))
1413	ENDIF
1414	IF (PRESENT(valid_min)) THEN
1415	i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',valid_min)
1416	ENDIF
1417	IF (PRESENT(valid_max)) THEN
1418	i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',valid_max)
1419	ENDIF
1420	!---
1421	ELSE
1422	CALL ipslerr (3,'fliodefv','Variable',TRIM(v_n),'already exist')
1423	ENDIF
1424	!-
1425	IF (l_dbg) THEN
1426	WRITE(,) "<-fliodefv"
1427	ENDIF
1428	!----------------------
1429	END SUBROUTINE flio_udv
1430	!===
1431	SUBROUTINE fliopv_i40 (f_i,v_n,v_v,start)
1432	!---------------------------------------------------------------------
1433	IMPLICIT NONE
1434	!-
1435	INTEGER,INTENT(IN) :: f_i
1436	CHARACTER(LEN=*),INTENT(IN) :: v_n
1437	INTEGER(KIND=i_4),INTENT(IN) :: v_v
1438	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
1439	!---------------------------------------------------------------------
1440	CALL flio_upv (f_i,v_n,i_40=v_v,start=start)
1441	!------------------------
1442	END SUBROUTINE fliopv_i40
1443	!===
1444	SUBROUTINE fliopv_i41 (f_i,v_n,v_v,start,count)
1445	!---------------------------------------------------------------------
1446	IMPLICIT NONE
1447	!-
1448	INTEGER,INTENT(IN) :: f_i
1449	CHARACTER(LEN=*),INTENT(IN) :: v_n
1450	INTEGER(KIND=i_4),DIMENSION(:),INTENT(IN) :: v_v
1451	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1452	!---------------------------------------------------------------------
1453	CALL flio_upv (f_i,v_n,i_41=v_v,start=start,count=count)
1454	!------------------------
1455	END SUBROUTINE fliopv_i41
1456	!===
1457	SUBROUTINE fliopv_i42 (f_i,v_n,v_v,start,count)
1458	!---------------------------------------------------------------------
1459	IMPLICIT NONE
1460	!-
1461	INTEGER,INTENT(IN) :: f_i
1462	CHARACTER(LEN=*),INTENT(IN) :: v_n
1463	INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(IN) :: v_v
1464	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1465	!---------------------------------------------------------------------
1466	CALL flio_upv (f_i,v_n,i_42=v_v,start=start,count=count)
1467	!------------------------
1468	END SUBROUTINE fliopv_i42
1469	!===
1470	SUBROUTINE fliopv_i43 (f_i,v_n,v_v,start,count)
1471	!---------------------------------------------------------------------
1472	IMPLICIT NONE
1473	!-
1474	INTEGER,INTENT(IN) :: f_i
1475	CHARACTER(LEN=*),INTENT(IN) :: v_n
1476	INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(IN) :: v_v
1477	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1478	!---------------------------------------------------------------------
1479	CALL flio_upv (f_i,v_n,i_43=v_v,start=start,count=count)
1480	!------------------------
1481	END SUBROUTINE fliopv_i43
1482	!===
1483	SUBROUTINE fliopv_i44 (f_i,v_n,v_v,start,count)
1484	!---------------------------------------------------------------------
1485	IMPLICIT NONE
1486	!-
1487	INTEGER,INTENT(IN) :: f_i
1488	CHARACTER(LEN=*),INTENT(IN) :: v_n
1489	INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
1490	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1491	!---------------------------------------------------------------------
1492	CALL flio_upv (f_i,v_n,i_44=v_v,start=start,count=count)
1493	!------------------------
1494	END SUBROUTINE fliopv_i44
1495	!===
1496	SUBROUTINE fliopv_i45 (f_i,v_n,v_v,start,count)
1497	!---------------------------------------------------------------------
1498	IMPLICIT NONE
1499	!-
1500	INTEGER,INTENT(IN) :: f_i
1501	CHARACTER(LEN=*),INTENT(IN) :: v_n
1502	INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
1503	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1504	!---------------------------------------------------------------------
1505	CALL flio_upv (f_i,v_n,i_45=v_v,start=start,count=count)
1506	!------------------------
1507	END SUBROUTINE fliopv_i45
1508	!===
1509	SUBROUTINE fliopv_i20 (f_i,v_n,v_v,start)
1510	!---------------------------------------------------------------------
1511	IMPLICIT NONE
1512	!-
1513	INTEGER,INTENT(IN) :: f_i
1514	CHARACTER(LEN=*),INTENT(IN) :: v_n
1515	INTEGER(KIND=i_2),INTENT(IN) :: v_v
1516	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
1517	!---------------------------------------------------------------------
1518	CALL flio_upv (f_i,v_n,i_20=v_v,start=start)
1519	!------------------------
1520	END SUBROUTINE fliopv_i20
1521	!===
1522	SUBROUTINE fliopv_i21 (f_i,v_n,v_v,start,count)
1523	!---------------------------------------------------------------------
1524	IMPLICIT NONE
1525	!-
1526	INTEGER,INTENT(IN) :: f_i
1527	CHARACTER(LEN=*),INTENT(IN) :: v_n
1528	INTEGER(KIND=i_2),DIMENSION(:),INTENT(IN) :: v_v
1529	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1530	!---------------------------------------------------------------------
1531	CALL flio_upv (f_i,v_n,i_21=v_v,start=start,count=count)
1532	!------------------------
1533	END SUBROUTINE fliopv_i21
1534	!===
1535	SUBROUTINE fliopv_i22 (f_i,v_n,v_v,start,count)
1536	!---------------------------------------------------------------------
1537	IMPLICIT NONE
1538	!-
1539	INTEGER,INTENT(IN) :: f_i
1540	CHARACTER(LEN=*),INTENT(IN) :: v_n
1541	INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(IN) :: v_v
1542	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1543	!---------------------------------------------------------------------
1544	CALL flio_upv (f_i,v_n,i_22=v_v,start=start,count=count)
1545	!------------------------
1546	END SUBROUTINE fliopv_i22
1547	!===
1548	SUBROUTINE fliopv_i23 (f_i,v_n,v_v,start,count)
1549	!---------------------------------------------------------------------
1550	IMPLICIT NONE
1551	!-
1552	INTEGER,INTENT(IN) :: f_i
1553	CHARACTER(LEN=*),INTENT(IN) :: v_n
1554	INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(IN) :: v_v
1555	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1556	!---------------------------------------------------------------------
1557	CALL flio_upv (f_i,v_n,i_23=v_v,start=start,count=count)
1558	!------------------------
1559	END SUBROUTINE fliopv_i23
1560	!===
1561	SUBROUTINE fliopv_i24 (f_i,v_n,v_v,start,count)
1562	!---------------------------------------------------------------------
1563	IMPLICIT NONE
1564	!-
1565	INTEGER,INTENT(IN) :: f_i
1566	CHARACTER(LEN=*),INTENT(IN) :: v_n
1567	INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
1568	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1569	!---------------------------------------------------------------------
1570	CALL flio_upv (f_i,v_n,i_24=v_v,start=start,count=count)
1571	!------------------------
1572	END SUBROUTINE fliopv_i24
1573	!===
1574	SUBROUTINE fliopv_i25 (f_i,v_n,v_v,start,count)
1575	!---------------------------------------------------------------------
1576	IMPLICIT NONE
1577	!-
1578	INTEGER,INTENT(IN) :: f_i
1579	CHARACTER(LEN=*),INTENT(IN) :: v_n
1580	INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
1581	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1582	!---------------------------------------------------------------------
1583	CALL flio_upv (f_i,v_n,i_25=v_v,start=start,count=count)
1584	!------------------------
1585	END SUBROUTINE fliopv_i25
1586	!===
1587	!?INTEGERS of KIND 1 are not supported on all computers
1588	!?SUBROUTINE fliopv_i10 (f_i,v_n,v_v,start)
1589	!?!---------------------------------------------------------------------
1590	!? IMPLICIT NONE
1591	!?!-
1592	!? INTEGER,INTENT(IN) :: f_i
1593	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
1594	!? INTEGER(KIND=i_1),INTENT(IN) :: v_v
1595	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
1596	!?!---------------------------------------------------------------------
1597	!? CALL flio_upv (f_i,v_n,i_10=v_v,start=start)
1598	!?!------------------------
1599	!?END SUBROUTINE fliopv_i10
1600	!?!===
1601	!?SUBROUTINE fliopv_i11 (f_i,v_n,v_v,start,count)
1602	!?!---------------------------------------------------------------------
1603	!? IMPLICIT NONE
1604	!?!-
1605	!? INTEGER,INTENT(IN) :: f_i
1606	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
1607	!? INTEGER(KIND=i_1),DIMENSION(:),INTENT(IN) :: v_v
1608	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1609	!?!---------------------------------------------------------------------
1610	!? CALL flio_upv (f_i,v_n,i_11=v_v,start=start,count=count)
1611	!?!------------------------
1612	!?END SUBROUTINE fliopv_i11
1613	!?!===
1614	!?SUBROUTINE fliopv_i12 (f_i,v_n,v_v,start,count)
1615	!?!---------------------------------------------------------------------
1616	!? IMPLICIT NONE
1617	!?!-
1618	!? INTEGER,INTENT(IN) :: f_i
1619	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
1620	!? INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(IN) :: v_v
1621	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1622	!?!---------------------------------------------------------------------
1623	!? CALL flio_upv (f_i,v_n,i_12=v_v,start=start,count=count)
1624	!?!------------------------
1625	!?END SUBROUTINE fliopv_i12
1626	!?!===
1627	!?SUBROUTINE fliopv_i13 (f_i,v_n,v_v,start,count)
1628	!?!---------------------------------------------------------------------
1629	!? IMPLICIT NONE
1630	!?!-
1631	!? INTEGER,INTENT(IN) :: f_i
1632	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
1633	!? INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(IN) :: v_v
1634	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1635	!?!---------------------------------------------------------------------
1636	!? CALL flio_upv (f_i,v_n,i_13=v_v,start=start,count=count)
1637	!?!------------------------
1638	!?END SUBROUTINE fliopv_i13
1639	!?!===
1640	!?SUBROUTINE fliopv_i14 (f_i,v_n,v_v,start,count)
1641	!?!---------------------------------------------------------------------
1642	!? IMPLICIT NONE
1643	!?!-
1644	!? INTEGER,INTENT(IN) :: f_i
1645	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
1646	!? INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
1647	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1648	!?!---------------------------------------------------------------------
1649	!? CALL flio_upv (f_i,v_n,i_14=v_v,start=start,count=count)
1650	!?!------------------------
1651	!?END SUBROUTINE fliopv_i14
1652	!?!===
1653	!?SUBROUTINE fliopv_i15 (f_i,v_n,v_v,start,count)
1654	!?!---------------------------------------------------------------------
1655	!? IMPLICIT NONE
1656	!?!-
1657	!? INTEGER,INTENT(IN) :: f_i
1658	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
1659	!? INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
1660	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1661	!?!---------------------------------------------------------------------
1662	!? CALL flio_upv (f_i,v_n,i_15=v_v,start=start,count=count)
1663	!?!------------------------
1664	!?END SUBROUTINE fliopv_i15
1665	!===
1666	SUBROUTINE fliopv_r40 (f_i,v_n,v_v,start)
1667	!---------------------------------------------------------------------
1668	IMPLICIT NONE
1669	!-
1670	INTEGER,INTENT(IN) :: f_i
1671	CHARACTER(LEN=*),INTENT(IN) :: v_n
1672	REAL(KIND=r_4),INTENT(IN) :: v_v
1673	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
1674	!---------------------------------------------------------------------
1675	CALL flio_upv (f_i,v_n,r_40=v_v,start=start)
1676	!------------------------
1677	END SUBROUTINE fliopv_r40
1678	!===
1679	SUBROUTINE fliopv_r41 (f_i,v_n,v_v,start,count)
1680	!---------------------------------------------------------------------
1681	IMPLICIT NONE
1682	!-
1683	INTEGER,INTENT(IN) :: f_i
1684	CHARACTER(LEN=*),INTENT(IN) :: v_n
1685	REAL(KIND=r_4),DIMENSION(:),INTENT(IN) :: v_v
1686	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1687	!---------------------------------------------------------------------
1688	CALL flio_upv (f_i,v_n,r_41=v_v,start=start,count=count)
1689	!------------------------
1690	END SUBROUTINE fliopv_r41
1691	!===
1692	SUBROUTINE fliopv_r42 (f_i,v_n,v_v,start,count)
1693	!---------------------------------------------------------------------
1694	IMPLICIT NONE
1695	!-
1696	INTEGER,INTENT(IN) :: f_i
1697	CHARACTER(LEN=*),INTENT(IN) :: v_n
1698	REAL(KIND=r_4),DIMENSION(:,:),INTENT(IN) :: v_v
1699	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1700	!---------------------------------------------------------------------
1701	CALL flio_upv (f_i,v_n,r_42=v_v,start=start,count=count)
1702	!------------------------
1703	END SUBROUTINE fliopv_r42
1704	!===
1705	SUBROUTINE fliopv_r43 (f_i,v_n,v_v,start,count)
1706	!---------------------------------------------------------------------
1707	IMPLICIT NONE
1708	!-
1709	INTEGER,INTENT(IN) :: f_i
1710	CHARACTER(LEN=*),INTENT(IN) :: v_n
1711	REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(IN) :: v_v
1712	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1713	!---------------------------------------------------------------------
1714	CALL flio_upv (f_i,v_n,r_43=v_v,start=start,count=count)
1715	!------------------------
1716	END SUBROUTINE fliopv_r43
1717	!===
1718	SUBROUTINE fliopv_r44 (f_i,v_n,v_v,start,count)
1719	!---------------------------------------------------------------------
1720	IMPLICIT NONE
1721	!-
1722	INTEGER,INTENT(IN) :: f_i
1723	CHARACTER(LEN=*),INTENT(IN) :: v_n
1724	REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
1725	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1726	!---------------------------------------------------------------------
1727	CALL flio_upv (f_i,v_n,r_44=v_v,start=start,count=count)
1728	!------------------------
1729	END SUBROUTINE fliopv_r44
1730	!===
1731	SUBROUTINE fliopv_r45 (f_i,v_n,v_v,start,count)
1732	!---------------------------------------------------------------------
1733	IMPLICIT NONE
1734	!-
1735	INTEGER,INTENT(IN) :: f_i
1736	CHARACTER(LEN=*),INTENT(IN) :: v_n
1737	REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
1738	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1739	!---------------------------------------------------------------------
1740	CALL flio_upv (f_i,v_n,r_45=v_v,start=start,count=count)
1741	!------------------------
1742	END SUBROUTINE fliopv_r45
1743	!===
1744	SUBROUTINE fliopv_r80 (f_i,v_n,v_v,start)
1745	!---------------------------------------------------------------------
1746	IMPLICIT NONE
1747	!-
1748	INTEGER,INTENT(IN) :: f_i
1749	CHARACTER(LEN=*),INTENT(IN) :: v_n
1750	REAL(KIND=r_8),INTENT(IN) :: v_v
1751	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
1752	!---------------------------------------------------------------------
1753	CALL flio_upv (f_i,v_n,r_80=v_v,start=start)
1754	!------------------------
1755	END SUBROUTINE fliopv_r80
1756	!===
1757	SUBROUTINE fliopv_r81 (f_i,v_n,v_v,start,count)
1758	!---------------------------------------------------------------------
1759	IMPLICIT NONE
1760	!-
1761	INTEGER,INTENT(IN) :: f_i
1762	CHARACTER(LEN=*),INTENT(IN) :: v_n
1763	REAL(KIND=r_8),DIMENSION(:),INTENT(IN) :: v_v
1764	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1765	!---------------------------------------------------------------------
1766	CALL flio_upv (f_i,v_n,r_81=v_v,start=start,count=count)
1767	!------------------------
1768	END SUBROUTINE fliopv_r81
1769	!===
1770	SUBROUTINE fliopv_r82 (f_i,v_n,v_v,start,count)
1771	!---------------------------------------------------------------------
1772	IMPLICIT NONE
1773	!-
1774	INTEGER,INTENT(IN) :: f_i
1775	CHARACTER(LEN=*),INTENT(IN) :: v_n
1776	REAL(KIND=r_8),DIMENSION(:,:),INTENT(IN) :: v_v
1777	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1778	!---------------------------------------------------------------------
1779	CALL flio_upv (f_i,v_n,r_82=v_v,start=start,count=count)
1780	!------------------------
1781	END SUBROUTINE fliopv_r82
1782	!===
1783	SUBROUTINE fliopv_r83 (f_i,v_n,v_v,start,count)
1784	!---------------------------------------------------------------------
1785	IMPLICIT NONE
1786	!-
1787	INTEGER,INTENT(IN) :: f_i
1788	CHARACTER(LEN=*),INTENT(IN) :: v_n
1789	REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(IN) :: v_v
1790	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1791	!---------------------------------------------------------------------
1792	CALL flio_upv (f_i,v_n,r_83=v_v,start=start,count=count)
1793	!------------------------
1794	END SUBROUTINE fliopv_r83
1795	!===
1796	SUBROUTINE fliopv_r84 (f_i,v_n,v_v,start,count)
1797	!---------------------------------------------------------------------
1798	IMPLICIT NONE
1799	!-
1800	INTEGER,INTENT(IN) :: f_i
1801	CHARACTER(LEN=*),INTENT(IN) :: v_n
1802	REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
1803	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1804	!---------------------------------------------------------------------
1805	CALL flio_upv (f_i,v_n,r_84=v_v,start=start,count=count)
1806	!------------------------
1807	END SUBROUTINE fliopv_r84
1808	!===
1809	SUBROUTINE fliopv_r85 (f_i,v_n,v_v,start,count)
1810	!---------------------------------------------------------------------
1811	IMPLICIT NONE
1812	!-
1813	INTEGER,INTENT(IN) :: f_i
1814	CHARACTER(LEN=*),INTENT(IN) :: v_n
1815	REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
1816	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
1817	!---------------------------------------------------------------------
1818	CALL flio_upv (f_i,v_n,r_85=v_v,start=start,count=count)
1819	!------------------------
1820	END SUBROUTINE fliopv_r85
1821	!===
1822	SUBROUTINE flio_upv &
1823	& (f_i,v_n, &
1824	& i_40,i_41,i_42,i_43,i_44,i_45, &
1825	& i_20,i_21,i_22,i_23,i_24,i_25, &
1826	!? & i_10,i_11,i_12,i_13,i_14,i_15, &
1827	& r_40,r_41,r_42,r_43,r_44,r_45, &
1828	& r_80,r_81,r_82,r_83,r_84,r_85, &
1829	& start,count)
1830	!---------------------------------------------------------------------
1831	IMPLICIT NONE
1832	!-
1833	INTEGER,INTENT(IN) :: f_i
1834	CHARACTER(LEN=*),INTENT(IN) :: v_n
1835	INTEGER(KIND=i_4),INTENT(IN),OPTIONAL :: i_40
1836	INTEGER(KIND=i_4),DIMENSION(:),INTENT(IN),OPTIONAL :: i_41
1837	INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(IN),OPTIONAL :: i_42
1838	INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: i_43
1839	INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: i_44
1840	INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: i_45
1841	INTEGER(KIND=i_2),INTENT(IN),OPTIONAL :: i_20
1842	INTEGER(KIND=i_2),DIMENSION(:),INTENT(IN),OPTIONAL :: i_21
1843	INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(IN),OPTIONAL :: i_22
1844	INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: i_23
1845	INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: i_24
1846	INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: i_25
1847	!?INTEGERS of KIND 1 are not supported on all computers
1848	!?INTEGER(KIND=i_1),INTENT(IN),OPTIONAL :: i_10
1849	!?INTEGER(KIND=i_1),DIMENSION(:),INTENT(IN),OPTIONAL :: i_11
1850	!?INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(IN),OPTIONAL :: i_12
1851	!?INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: i_13
1852	!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: i_14
1853	!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: i_15
1854	REAL(KIND=r_4),INTENT(IN),OPTIONAL :: r_40
1855	REAL(KIND=r_4),DIMENSION(:),INTENT(IN),OPTIONAL :: r_41
1856	REAL(KIND=r_4),DIMENSION(:,:),INTENT(IN),OPTIONAL :: r_42
1857	REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: r_43
1858	REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: r_44
1859	REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: r_45
1860	REAL(KIND=r_8),INTENT(IN),OPTIONAL :: r_80
1861	REAL(KIND=r_8),DIMENSION(:),INTENT(IN),OPTIONAL :: r_81
1862	REAL(KIND=r_8),DIMENSION(:,:),INTENT(IN),OPTIONAL :: r_82
1863	REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: r_83
1864	REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: r_84
1865	REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: r_85
1866	INTEGER,DIMENSION(:),INTENT(IN),OPTIONAL :: start,count
1867	!-
1868	INTEGER :: f_e,i_v,i_rc
1869	CHARACTER(LEN=5) :: cvr_d
1870	!-
1871	LOGICAL :: l_dbg
1872	!---------------------------------------------------------------------
1873	CALL ipsldbg (old_status=l_dbg)
1874	!-
1875	IF (l_dbg) THEN
1876	IF (PRESENT(i_40)) THEN; cvr_d = "I1 0D";
1877	ELSE IF (PRESENT(i_41)) THEN; cvr_d = "I1 1D";
1878	ELSE IF (PRESENT(i_42)) THEN; cvr_d = "I1 2D";
1879	ELSE IF (PRESENT(i_43)) THEN; cvr_d = "I1 3D";
1880	ELSE IF (PRESENT(i_44)) THEN; cvr_d = "I1 4D";
1881	ELSE IF (PRESENT(i_45)) THEN; cvr_d = "I1 5D";
1882	ELSE IF (PRESENT(i_20)) THEN; cvr_d = "I2 0D";
1883	ELSE IF (PRESENT(i_21)) THEN; cvr_d = "I2 1D";
1884	ELSE IF (PRESENT(i_22)) THEN; cvr_d = "I2 2D";
1885	ELSE IF (PRESENT(i_23)) THEN; cvr_d = "I2 3D";
1886	ELSE IF (PRESENT(i_24)) THEN; cvr_d = "I2 4D";
1887	ELSE IF (PRESENT(i_25)) THEN; cvr_d = "I2 5D";
1888	!? ELSE IF (PRESENT(i_10)) THEN; cvr_d = "I4 0D";
1889	!? ELSE IF (PRESENT(i_11)) THEN; cvr_d = "I4 1D";
1890	!? ELSE IF (PRESENT(i_12)) THEN; cvr_d = "I4 2D";
1891	!? ELSE IF (PRESENT(i_13)) THEN; cvr_d = "I4 3D";
1892	!? ELSE IF (PRESENT(i_14)) THEN; cvr_d = "I4 4D";
1893	!? ELSE IF (PRESENT(i_15)) THEN; cvr_d = "I4 5D";
1894	ELSE IF (PRESENT(r_40)) THEN; cvr_d = "R4 0D";
1895	ELSE IF (PRESENT(r_41)) THEN; cvr_d = "R4 1D";
1896	ELSE IF (PRESENT(r_42)) THEN; cvr_d = "R4 2D";
1897	ELSE IF (PRESENT(r_43)) THEN; cvr_d = "R4 3D";
1898	ELSE IF (PRESENT(r_44)) THEN; cvr_d = "R4 4D";
1899	ELSE IF (PRESENT(r_45)) THEN; cvr_d = "R4 5D";
1900	ELSE IF (PRESENT(r_80)) THEN; cvr_d = "R8 0D";
1901	ELSE IF (PRESENT(r_81)) THEN; cvr_d = "R8 1D";
1902	ELSE IF (PRESENT(r_82)) THEN; cvr_d = "R8 2D";
1903	ELSE IF (PRESENT(r_83)) THEN; cvr_d = "R8 3D";
1904	ELSE IF (PRESENT(r_84)) THEN; cvr_d = "R8 4D";
1905	ELSE IF (PRESENT(r_85)) THEN; cvr_d = "R8 5D";
1906	ENDIF
1907	WRITE(,) "->flioputv ",TRIM(v_n)," ",TRIM(cvr_d)
1908	ENDIF
1909	!-
1910	! Retrieve the external file index
1911	CALL flio_qvid ('flioputv',f_i,f_e)
1912	!-
1913	! Ensuring data mode
1914	!-
1915	CALL flio_hdm (f_i,f_e,.FALSE.)
1916	!-
1917	i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
1918	IF (i_rc == NF90_NOERR) THEN
1919	IF (PRESENT(i_40)) THEN
1920	i_rc = NF90_PUT_VAR(f_e,i_v,i_40,start=start)
1921	ELSE IF (PRESENT(i_41)) THEN
1922	i_rc = NF90_PUT_VAR(f_e,i_v,i_41,start=start,count=count)
1923	ELSE IF (PRESENT(i_42)) THEN
1924	i_rc = NF90_PUT_VAR(f_e,i_v,i_42,start=start,count=count)
1925	ELSE IF (PRESENT(i_43)) THEN
1926	i_rc = NF90_PUT_VAR(f_e,i_v,i_43,start=start,count=count)
1927	ELSE IF (PRESENT(i_44)) THEN
1928	i_rc = NF90_PUT_VAR(f_e,i_v,i_44,start=start,count=count)
1929	ELSE IF (PRESENT(i_45)) THEN
1930	i_rc = NF90_PUT_VAR(f_e,i_v,i_45,start=start,count=count)
1931	ELSE IF (PRESENT(i_20)) THEN
1932	i_rc = NF90_PUT_VAR(f_e,i_v,i_20,start=start)
1933	ELSE IF (PRESENT(i_21)) THEN
1934	i_rc = NF90_PUT_VAR(f_e,i_v,i_21,start=start,count=count)
1935	ELSE IF (PRESENT(i_22)) THEN
1936	i_rc = NF90_PUT_VAR(f_e,i_v,i_22,start=start,count=count)
1937	ELSE IF (PRESENT(i_23)) THEN
1938	i_rc = NF90_PUT_VAR(f_e,i_v,i_23,start=start,count=count)
1939	ELSE IF (PRESENT(i_24)) THEN
1940	i_rc = NF90_PUT_VAR(f_e,i_v,i_24,start=start,count=count)
1941	ELSE IF (PRESENT(i_25)) THEN
1942	i_rc = NF90_PUT_VAR(f_e,i_v,i_25,start=start,count=count)
1943	!? ELSE IF (PRESENT(i_10)) THEN
1944	!? i_rc = NF90_PUT_VAR(f_e,i_v,i_10,start=start)
1945	!? ELSE IF (PRESENT(i_11)) THEN
1946	!? i_rc = NF90_PUT_VAR(f_e,i_v,i_11,start=start,count=count)
1947	!? ELSE IF (PRESENT(i_12)) THEN
1948	!? i_rc = NF90_PUT_VAR(f_e,i_v,i_12,start=start,count=count)
1949	!? ELSE IF (PRESENT(i_13)) THEN
1950	!? i_rc = NF90_PUT_VAR(f_e,i_v,i_13,start=start,count=count)
1951	!? ELSE IF (PRESENT(i_14)) THEN
1952	!? i_rc = NF90_PUT_VAR(f_e,i_v,i_14,start=start,count=count)
1953	!? ELSE IF (PRESENT(i_15)) THEN
1954	!? i_rc = NF90_PUT_VAR(f_e,i_v,i_15,start=start,count=count)
1955	ELSE IF (PRESENT(r_40)) THEN
1956	i_rc = NF90_PUT_VAR(f_e,i_v,r_40,start=start)
1957	ELSE IF (PRESENT(r_41)) THEN
1958	i_rc = NF90_PUT_VAR(f_e,i_v,r_41,start=start,count=count)
1959	ELSE IF (PRESENT(r_42)) THEN
1960	i_rc = NF90_PUT_VAR(f_e,i_v,r_42,start=start,count=count)
1961	ELSE IF (PRESENT(r_43)) THEN
1962	i_rc = NF90_PUT_VAR(f_e,i_v,r_43,start=start,count=count)
1963	ELSE IF (PRESENT(r_44)) THEN
1964	i_rc = NF90_PUT_VAR(f_e,i_v,r_44,start=start,count=count)
1965	ELSE IF (PRESENT(r_45)) THEN
1966	i_rc = NF90_PUT_VAR(f_e,i_v,r_45,start=start,count=count)
1967	ELSE IF (PRESENT(r_80)) THEN
1968	i_rc = NF90_PUT_VAR(f_e,i_v,r_80,start=start)
1969	ELSE IF (PRESENT(r_81)) THEN
1970	i_rc = NF90_PUT_VAR(f_e,i_v,r_81,start=start,count=count)
1971	ELSE IF (PRESENT(r_82)) THEN
1972	i_rc = NF90_PUT_VAR(f_e,i_v,r_82,start=start,count=count)
1973	ELSE IF (PRESENT(r_83)) THEN
1974	i_rc = NF90_PUT_VAR(f_e,i_v,r_83,start=start,count=count)
1975	ELSE IF (PRESENT(r_84)) THEN
1976	i_rc = NF90_PUT_VAR(f_e,i_v,r_84,start=start,count=count)
1977	ELSE IF (PRESENT(r_85)) THEN
1978	i_rc = NF90_PUT_VAR(f_e,i_v,r_85,start=start,count=count)
1979	ENDIF
1980	IF (i_rc /= NF90_NOERR) THEN
1981	CALL ipslerr (3,'flioputv', &
1982	& 'Variable '//TRIM(v_n)//' not put','Error :', &
1983	& TRIM(NF90_STRERROR(i_rc)))
1984	ENDIF
1985	ELSE
1986	CALL ipslerr (3,'flioputv','Variable',TRIM(v_n),'not defined')
1987	ENDIF
1988	!-
1989	IF (l_dbg) THEN
1990	WRITE(,) "<-flioputv"
1991	ENDIF
1992	!----------------------
1993	END SUBROUTINE flio_upv
1994	!===
1995	SUBROUTINE fliopa_r4_0d (f_i,v_n,a_n,a_v)
1996	!---------------------------------------------------------------------
1997	IMPLICIT NONE
1998	!-
1999	INTEGER,INTENT(IN) :: f_i
2000	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
2001	REAL(KIND=4),INTENT(IN) :: a_v
2002	!---------------------------------------------------------------------
2003	CALL flio_upa (f_i,1,v_n,a_n,avr4=(/a_v/))
2004	!--------------------------
2005	END SUBROUTINE fliopa_r4_0d
2006	!===
2007	SUBROUTINE fliopa_r4_1d (f_i,v_n,a_n,a_v)
2008	!---------------------------------------------------------------------
2009	IMPLICIT NONE
2010	!-
2011	INTEGER,INTENT(IN) :: f_i
2012	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
2013	REAL(KIND=4),DIMENSION(:),INTENT(IN) :: a_v
2014	!---------------------------------------------------------------------
2015	CALL flio_upa (f_i,SIZE(a_v),v_n,a_n,avr4=a_v)
2016	!--------------------------
2017	END SUBROUTINE fliopa_r4_1d
2018	!===
2019	SUBROUTINE fliopa_r8_0d (f_i,v_n,a_n,a_v)
2020	!---------------------------------------------------------------------
2021	IMPLICIT NONE
2022	!-
2023	INTEGER,INTENT(IN) :: f_i
2024	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
2025	REAL(KIND=8),INTENT(IN) :: a_v
2026	!---------------------------------------------------------------------
2027	CALL flio_upa (f_i,1,v_n,a_n,avr8=(/a_v/))
2028	!--------------------------
2029	END SUBROUTINE fliopa_r8_0d
2030	!===
2031	SUBROUTINE fliopa_r8_1d (f_i,v_n,a_n,a_v)
2032	!---------------------------------------------------------------------
2033	IMPLICIT NONE
2034	!-
2035	INTEGER,INTENT(IN) :: f_i
2036	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
2037	REAL(KIND=8),DIMENSION(:),INTENT(IN) :: a_v
2038	!---------------------------------------------------------------------
2039	CALL flio_upa (f_i,SIZE(a_v),v_n,a_n,avr8=a_v)
2040	!--------------------------
2041	END SUBROUTINE fliopa_r8_1d
2042	!===
2043	SUBROUTINE fliopa_i4_0d (f_i,v_n,a_n,a_v)
2044	!---------------------------------------------------------------------
2045	IMPLICIT NONE
2046	!-
2047	INTEGER,INTENT(IN) :: f_i
2048	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
2049	INTEGER(KIND=4),INTENT(IN) :: a_v
2050	!---------------------------------------------------------------------
2051	CALL flio_upa (f_i,1,v_n,a_n,avi4=(/a_v/))
2052	!--------------------------
2053	END SUBROUTINE fliopa_i4_0d
2054	!===
2055	SUBROUTINE fliopa_i4_1d (f_i,v_n,a_n,a_v)
2056	!---------------------------------------------------------------------
2057	IMPLICIT NONE
2058	!-
2059	INTEGER,INTENT(IN) :: f_i
2060	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
2061	INTEGER(KIND=4),DIMENSION(:),INTENT(IN) :: a_v
2062	!---------------------------------------------------------------------
2063	CALL flio_upa (f_i,SIZE(a_v),v_n,a_n,avi4=a_v)
2064	!--------------------------
2065	END SUBROUTINE fliopa_i4_1d
2066	!===
2067	SUBROUTINE fliopa_tx_0d (f_i,v_n,a_n,a_v)
2068	!---------------------------------------------------------------------
2069	IMPLICIT NONE
2070	!-
2071	INTEGER,INTENT(IN) :: f_i
2072	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
2073	CHARACTER(LEN=*),INTENT(IN) :: a_v
2074	!---------------------------------------------------------------------
2075	CALL flio_upa (f_i,1,v_n,a_n,avtx=a_v)
2076	!--------------------------
2077	END SUBROUTINE fliopa_tx_0d
2078	!===
2079	SUBROUTINE flio_upa (f_i,l_a,v_n,a_n,avr4,avr8,avi4,avtx)
2080	!---------------------------------------------------------------------
2081	IMPLICIT NONE
2082	!-
2083	INTEGER,INTENT(IN) :: f_i,l_a
2084	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
2085	REAL(KIND=4),DIMENSION(:),OPTIONAL,INTENT(IN) :: avr4
2086	REAL(KIND=8),DIMENSION(:),OPTIONAL,INTENT(IN) :: avr8
2087	INTEGER(KIND=4),DIMENSION(:),OPTIONAL,INTENT(IN) :: avi4
2088	CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: avtx
2089	!-
2090	INTEGER :: f_e,i_v,i_a,i_rc
2091	!-
2092	LOGICAL :: l_dbg
2093	!---------------------------------------------------------------------
2094	CALL ipsldbg (old_status=l_dbg)
2095	!-
2096	IF (l_dbg) THEN
2097	WRITE(,) "->flioputa ",TRIM(v_n)," ",TRIM(a_n)
2098	ENDIF
2099	!-
2100	! Retrieve the external file index
2101	CALL flio_qvid ('flioputa',f_i,f_e)
2102	!-
2103	IF (TRIM(v_n) == '?') THEN
2104	i_v = NF90_GLOBAL
2105	ELSE
2106	i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
2107	IF (i_rc /= NF90_NOERR) THEN
2108	CALL ipslerr (3,'flioputa', &
2109	'Variable :',TRIM(v_n),'not found')
2110	ENDIF
2111	ENDIF
2112	!-
2113	i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,attnum=i_a)
2114	IF ( (i_v == NF90_GLOBAL).AND.(i_rc /= NF90_NOERR) ) THEN
2115	nw_na(f_i) = nw_na(f_i)+1
2116	ENDIF
2117	CALL flio_hdm (f_i,f_e,.TRUE.)
2118	IF (PRESENT(avr4)) THEN
2119	i_rc = NF90_PUT_ATT(f_e,i_v,a_n,avr4(1:l_a))
2120	ELSE IF (PRESENT(avr8)) THEN
2121	i_rc = NF90_PUT_ATT(f_e,i_v,a_n,avr8(1:l_a))
2122	ELSE IF (PRESENT(avi4)) THEN
2123	i_rc = NF90_PUT_ATT(f_e,i_v,a_n,avi4(1:l_a))
2124	ELSE IF (PRESENT(avtx)) THEN
2125	i_rc = NF90_PUT_ATT(f_e,i_v,a_n,TRIM(avtx))
2126	ENDIF
2127	!-
2128	IF (l_dbg) THEN
2129	WRITE(,) "<-flioputa"
2130	ENDIF
2131	!----------------------
2132	END SUBROUTINE flio_upa
2133	!===
2134	SUBROUTINE flioopfd (f_n,f_i,mode,nb_dim,nb_var,nb_gat)
2135	!---------------------------------------------------------------------
2136	IMPLICIT NONE
2137	!-
2138	CHARACTER(LEN=*),INTENT(IN) :: f_n
2139	INTEGER,INTENT(OUT) :: f_i
2140	CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: mode
2141	INTEGER,OPTIONAL,INTENT(OUT) :: nb_dim,nb_var,nb_gat
2142	!-
2143	INTEGER :: i_rc,f_e,m_c
2144	!-
2145	LOGICAL :: l_dbg
2146	!---------------------------------------------------------------------
2147	CALL ipsldbg (old_status=l_dbg)
2148	!-
2149	IF (l_dbg) THEN
2150	WRITE(,) '->flioopfd, file name : ',TRIM(f_n)
2151	ENDIF
2152	!-
2153	! Search for a free local identifier
2154	!-
2155	f_i = flio_rid()
2156	IF (f_i < 0) THEN
2157	CALL ipslerr (3,'flioopfd', &
2158	'Too many files.','Please increase nb_fi_mx', &
2159	'in module fliocom.f90.')
2160	ENDIF
2161	!-
2162	! Check the mode
2163	!-
2164	IF (PRESENT(mode)) THEN
2165	IF (TRIM(MODE) == "WRITE") THEN
2166	m_c = NF90_WRITE
2167	ELSE
2168	m_c = NF90_NOWRITE
2169	ENDIF
2170	ELSE
2171	m_c = NF90_NOWRITE
2172	ENDIF
2173	!-
2174	! Open the file.
2175	!-
2176	i_rc = NF90_OPEN(TRIM(f_n),m_c,f_e)
2177	IF (i_rc /= NF90_NOERR) THEN
2178	CALL ipslerr (3,'flioopfd', &
2179	& 'Could not open file :',TRIM(f_n),' ')
2180	ENDIF
2181	!-
2182	IF (l_dbg) THEN
2183	WRITE(,) ' flioopfd, model file-id : ',f_e
2184	ENDIF
2185	!-
2186	! Retrieve and keep information about the file
2187	!-
2188	nw_id(f_i) = f_e
2189	lw_hm(f_i) = .FALSE.
2190	CALL flio_inf (f_e, &
2191	& nb_dims=nw_nd(f_i),nb_vars=nw_nv(f_i), &
2192	& nb_atts=nw_na(f_i),id_unlm=nw_un(f_i), &
2193	& nn_idm=nw_di(:,f_i),nn_ldm=nw_dl(:,f_i),nn_aid=nw_ai(:,f_i))
2194	!-
2195	! Return information to the user
2196	!-
2197	IF (PRESENT(nb_dim)) THEN
2198	nb_dim = nw_nd(f_i)
2199	ENDIF
2200	IF (PRESENT(nb_var)) THEN
2201	nb_var = nw_nv(f_i)
2202	ENDIF
2203	IF (PRESENT(nb_gat)) THEN
2204	nb_gat = nw_na(f_i)
2205	ENDIF
2206	!-
2207	IF (l_dbg) THEN
2208	WRITE(*,'(" flioopfd - dimensions :",/,(5(1X,I10),:))') &
2209	& nw_dl(:,f_i)
2210	WRITE(,) "<-flioopfd"
2211	ENDIF
2212	!----------------------
2213	END SUBROUTINE flioopfd
2214	!===
2215	SUBROUTINE flioinqf &
2216	& (f_i,nb_dim,nb_var,nb_gat,id_uld,id_dim,ln_dim)
2217	!---------------------------------------------------------------------
2218	IMPLICIT NONE
2219	!-
2220	INTEGER,INTENT(IN) :: f_i
2221	INTEGER,OPTIONAL,INTENT(OUT) :: nb_dim,nb_var,nb_gat,id_uld
2222	INTEGER,OPTIONAL,INTENT(OUT),DIMENSION(:) :: id_dim,ln_dim
2223	!-
2224	INTEGER :: lll
2225	!-
2226	LOGICAL :: l_dbg
2227	!---------------------------------------------------------------------
2228	CALL ipsldbg (old_status=l_dbg)
2229	!-
2230	IF (l_dbg) THEN
2231	WRITE(,) "->flioinqf"
2232	ENDIF
2233	!-
2234	IF ( (f_i < 1).OR.(f_i > nb_fi_mx) ) THEN
2235	CALL ipslerr (2,'flioinqf', &
2236	& 'Invalid file identifier',' ',' ')
2237	ELSE IF (nw_id(f_i) <= 0) THEN
2238	CALL ipslerr (2,'flioinqf', &
2239	& 'Unable to inquire about the file :','probably','not opened')
2240	ELSE
2241	IF (PRESENT(nb_dim)) THEN
2242	nb_dim = nw_nd(f_i)
2243	ENDIF
2244	IF (PRESENT(nb_var)) THEN
2245	nb_var = nw_nv(f_i)
2246	ENDIF
2247	IF (PRESENT(nb_gat)) THEN
2248	nb_gat = nw_na(f_i)
2249	ENDIF
2250	IF (PRESENT(id_uld)) THEN
2251	id_uld = nw_un(f_i)
2252	ENDIF
2253	IF (PRESENT(id_dim)) THEN
2254	lll = SIZE(id_dim)
2255	IF (lll < nw_nd(f_i)) THEN
2256	CALL ipslerr (2,'flioinqf', &
2257	& 'Only the first identifiers', &
2258	& 'of the dimensions','will be returned')
2259	ENDIF
2260	lll=MIN(SIZE(id_dim),nw_nd(f_i))
2261	id_dim(1:lll) = nw_di(1:lll,f_i)
2262	ENDIF
2263	IF (PRESENT(ln_dim)) THEN
2264	lll = SIZE(ln_dim)
2265	IF (lll < nw_nd(f_i)) THEN
2266	CALL ipslerr (2,'flioinqf', &
2267	& 'Only the first lengths', &
2268	& 'of the dimensions','will be returned')
2269	ENDIF
2270	lll=MIN(SIZE(ln_dim),nw_nd(f_i))
2271	ln_dim(1:lll) = nw_dl(1:lll,f_i)
2272	ENDIF
2273	ENDIF
2274	!-
2275	IF (l_dbg) THEN
2276	WRITE(,) "<-flioinqf"
2277	ENDIF
2278	!----------------------
2279	END SUBROUTINE flioinqf
2280	!===
2281	SUBROUTINE flioinqn &
2282	& (f_i,cn_dim,cn_var,cn_gat,cn_uld, &
2283	& id_start,id_count,iv_start,iv_count,ia_start,ia_count)
2284	!---------------------------------------------------------------------
2285	IMPLICIT NONE
2286	!-
2287	INTEGER,INTENT(IN) :: f_i
2288	CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: &
2289	& cn_dim,cn_var,cn_gat
2290	CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: &
2291	& cn_uld
2292	INTEGER,OPTIONAL,INTENT(IN) :: &
2293	& id_start,id_count,iv_start,iv_count,ia_start,ia_count
2294	!-
2295	INTEGER :: f_e,i_s,i_w,iws,iwc,i_rc
2296	LOGICAL :: l_ok
2297	!-
2298	LOGICAL :: l_dbg
2299	!---------------------------------------------------------------------
2300	CALL ipsldbg (old_status=l_dbg)
2301	!-
2302	IF (l_dbg) THEN
2303	WRITE(,) "->flioinqn"
2304	ENDIF
2305	!-
2306	! Retrieve the external file index
2307	CALL flio_qvid ('flioinqn',f_i,f_e)
2308	!-
2309	IF (PRESENT(cn_dim)) THEN
2310	l_ok = .TRUE.
2311	i_s = SIZE(cn_dim)
2312	DO i_w=1,i_s
2313	cn_dim(i_w)(:) = '?'
2314	ENDDO
2315	IF (PRESENT(id_start)) THEN
2316	iws = id_start
2317	ELSE
2318	iws = 1
2319	ENDIF
2320	IF (PRESENT(id_count)) THEN
2321	iwc = id_count
2322	ELSE
2323	iwc = nw_nd(f_i)
2324	ENDIF
2325	IF (iws > nw_nd(f_i)) THEN
2326	l_ok = .FALSE.
2327	CALL ipslerr (2,'flioinqn', &
2328	& 'The start index of requested dimensions', &
2329	& 'is greater than the number of dimensions', &
2330	& 'in the file')
2331	ELSE IF (iws < 1) THEN
2332	l_ok = .FALSE.
2333	CALL ipslerr (2,'flioinqn', &
2334	& 'The start index of requested dimensions', &
2335	& 'is invalid', &
2336	& '( < 1 )')
2337	ENDIF
2338	IF ((iws+iwc-1) > nw_nd(f_i)) THEN
2339	CALL ipslerr (2,'flioinqn', &
2340	& 'The number of requested dimensions', &
2341	& 'is greater than the number of dimensions', &
2342	& 'in the file')
2343	ENDIF
2344	IF (iwc > i_s) THEN
2345	CALL ipslerr (2,'flioinqn', &
2346	& 'The number of dimensions to retrieve', &
2347	& 'is greater than the size of the array,', &
2348	& 'only the first dimensions of the file will be returned')
2349	ELSE IF (iwc < 1) THEN
2350	l_ok = .FALSE.
2351	CALL ipslerr (2,'flioinqn', &
2352	& 'The number of requested dimensions', &
2353	& 'is invalid', &
2354	& '( < 1 )')
2355	ENDIF
2356	IF (l_ok) THEN
2357	DO i_w=1,MIN(iwc,i_s,nw_nd(f_i)-iws+1)
2358	i_rc = NF90_INQUIRE_DIMENSION(f_e,i_w+iws-1,name=cn_dim(i_w))
2359	ENDDO
2360	ENDIF
2361	ENDIF
2362	!-
2363	IF (PRESENT(cn_var)) THEN
2364	l_ok = .TRUE.
2365	i_s = SIZE(cn_var)
2366	DO i_w=1,i_s
2367	cn_var(i_w)(:) = '?'
2368	ENDDO
2369	IF (PRESENT(iv_start)) THEN
2370	iws = iv_start
2371	ELSE
2372	iws = 1
2373	ENDIF
2374	IF (PRESENT(iv_count)) THEN
2375	iwc = iv_count
2376	ELSE
2377	iwc = nw_nv(f_i)
2378	ENDIF
2379	IF (iws > nw_nv(f_i)) THEN
2380	l_ok = .FALSE.
2381	CALL ipslerr (2,'flioinqn', &
2382	& 'The start index of requested variables', &
2383	& 'is greater than the number of variables', &
2384	& 'in the file')
2385	ELSE IF (iws < 1) THEN
2386	l_ok = .FALSE.
2387	CALL ipslerr (2,'flioinqn', &
2388	& 'The start index of requested variables', &
2389	& 'is invalid', &
2390	& '( < 1 )')
2391	ENDIF
2392	IF ((iws+iwc-1) > nw_nv(f_i)) THEN
2393	CALL ipslerr (2,'flioinqn', &
2394	& 'The number of requested variables', &
2395	& 'is greater than the number of variables', &
2396	& 'in the file')
2397	ENDIF
2398	IF (iwc > i_s) THEN
2399	CALL ipslerr (2,'flioinqn', &
2400	& 'The number of variables to retrieve', &
2401	& 'is greater than the size of the array,', &
2402	& 'only the first variables of the file will be returned')
2403	ELSE IF (iwc < 1) THEN
2404	l_ok = .FALSE.
2405	CALL ipslerr (2,'flioinqn', &
2406	& 'The number of requested variables', &
2407	& 'is invalid', &
2408	& '( < 1 )')
2409	ENDIF
2410	IF (l_ok) THEN
2411	DO i_w=1,MIN(iwc,i_s,nw_nv(f_i)-iws+1)
2412	i_rc = NF90_INQUIRE_VARIABLE(f_e,i_w+iws-1,name=cn_var(i_w))
2413	ENDDO
2414	ENDIF
2415	ENDIF
2416	!-
2417	IF (PRESENT(cn_gat)) THEN
2418	l_ok = .TRUE.
2419	i_s = SIZE(cn_gat)
2420	DO i_w=1,i_s
2421	cn_gat(i_w)(:) = '?'
2422	ENDDO
2423	IF (PRESENT(ia_start)) THEN
2424	iws = ia_start
2425	ELSE
2426	iws = 1
2427	ENDIF
2428	IF (PRESENT(ia_count)) THEN
2429	iwc = ia_count
2430	ELSE
2431	iwc = nw_na(f_i)
2432	ENDIF
2433	IF (iws > nw_na(f_i)) THEN
2434	l_ok = .FALSE.
2435	CALL ipslerr (2,'flioinqn', &
2436	& 'The start index of requested global attributes', &
2437	& 'is greater than the number of global attributes', &
2438	& 'in the file')
2439	ELSE IF (iws < 1) THEN
2440	l_ok = .FALSE.
2441	CALL ipslerr (2,'flioinqn', &
2442	& 'The start index of requested global attributes', &
2443	& 'is invalid', &
2444	& '( < 1 )')
2445	ENDIF
2446	IF ((iws+iwc-1) > nw_na(f_i)) THEN
2447	CALL ipslerr (2,'flioinqn', &
2448	& 'The number of requested global attributes', &
2449	& 'is greater than the number of global attributes', &
2450	& 'in the file')
2451	ENDIF
2452	IF (iwc > i_s) THEN
2453	CALL ipslerr (2,'flioinqn', &
2454	& 'The number of global attributes to retrieve', &
2455	& 'is greater than the size of the array,', &
2456	& 'only the first global attributes of the file will be returned')
2457	ELSE IF (iwc < 1) THEN
2458	l_ok = .FALSE.
2459	CALL ipslerr (2,'flioinqn', &
2460	& 'The number of requested global attributes', &
2461	& 'is invalid', &
2462	& '( < 1 )')
2463	ENDIF
2464	IF (l_ok) THEN
2465	DO i_w=1,MIN(iwc,i_s,nw_na(f_i)-iws+1)
2466	i_rc = NF90_INQ_ATTNAME(f_e, &
2467	& NF90_GLOBAL,i_w+iws-1,name=cn_gat(i_w))
2468	ENDDO
2469	ENDIF
2470	ENDIF
2471	!-
2472	IF (PRESENT(cn_uld)) THEN
2473	cn_uld = '?'
2474	IF (nw_un(f_i) > 0) THEN
2475	i_rc = NF90_INQUIRE_DIMENSION(f_e,nw_un(f_i),name=cn_uld)
2476	ENDIF
2477	ENDIF
2478	!-
2479	IF (l_dbg) THEN
2480	WRITE(,) "<-flioinqn"
2481	ENDIF
2482	!----------------------
2483	END SUBROUTINE flioinqn
2484	!===
2485	SUBROUTINE fliogstc &
2486	& (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
2487	& t_axis,t_init,t_step,t_calendar, &
2488	& x_start,x_count,y_start,y_count, &
2489	& z_start,z_count,t_start,t_count)
2490	!---------------------------------------------------------------------
2491	IMPLICIT NONE
2492	!-
2493	INTEGER,INTENT(IN) :: f_i
2494	REAL,DIMENSION(:),OPTIONAL,INTENT(OUT) :: x_axis,y_axis
2495	REAL,DIMENSION(:,:),OPTIONAL,INTENT(OUT) :: x_axis_2d,y_axis_2d
2496	REAL,DIMENSION(:),OPTIONAL,INTENT(OUT) :: z_axis
2497	INTEGER,DIMENSION(:),OPTIONAL,INTENT(OUT) :: t_axis
2498	REAL,OPTIONAL,INTENT(OUT) :: t_init,t_step
2499	CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: t_calendar
2500	INTEGER,OPTIONAL,INTENT(IN) :: &
2501	& x_start,x_count,y_start,y_count,z_start,z_count,t_start,t_count
2502	!-
2503	INTEGER :: i_rc,f_e,i_v,it_t,nbdim,kv
2504	INTEGER :: m_x,i_x,l_x,m_y,i_y,l_y,m_z,i_z,l_z,m_t,i_t,l_t
2505	CHARACTER(LEN=NF90_MAX_NAME) :: name
2506	CHARACTER(LEN=80) :: units
2507	CHARACTER(LEN=20) :: c_tmp
2508	CHARACTER(LEN=1) :: c_1
2509	REAL :: r_yy,r_mo,r_dd,r_ss,dtv,dtn
2510	INTEGER :: j_yy,j_mo,j_dd,j_hh,j_mn,j_ss
2511	LOGICAL :: l_ok,l_tmp
2512	!-
2513	REAL,DIMENSION(:),ALLOCATABLE :: v_tmp
2514	!-
2515	LOGICAL :: l_dbg
2516	!---------------------------------------------------------------------
2517	CALL ipsldbg (old_status=l_dbg)
2518	!-
2519	IF (l_dbg) THEN
2520	WRITE(,) "->fliogstc"
2521	ENDIF
2522	!-
2523	! Retrieve the external file index
2524	CALL flio_qvid ('fliogstc',f_i,f_e)
2525	!-
2526	! Validate the coherence of the arguments
2527	!-
2528	IF ( (PRESENT(x_axis).AND.PRESENT(x_axis_2d)) &
2529	& .OR.(PRESENT(y_axis).AND.PRESENT(y_axis_2d)) ) THEN
2530	CALL ipslerr (3,'fliogstc', &
2531	& 'The [x/y]_axis arguments', &
2532	& 'are not coherent :',&
2533	& 'can not handle two [x/y]_axis')
2534	ENDIF
2535	!-
2536	! Retrieve spatio-temporal dimensions
2537	!-
2538	IF (nw_ai(k_lon,f_i) > 0) THEN
2539	m_x = nw_dl(nw_ai(k_lon,f_i),f_i);
2540	ELSE
2541	m_x = -1;
2542	ENDIF
2543	IF (nw_ai(k_lat,f_i) > 0) THEN
2544	m_y = nw_dl(nw_ai(k_lat,f_i),f_i);
2545	ELSE
2546	m_y = -1;
2547	ENDIF
2548	IF (nw_ai(k_lev,f_i) > 0) THEN
2549	m_z = nw_dl(nw_ai(k_lev,f_i),f_i);
2550	ELSE
2551	m_z = -1;
2552	ENDIF
2553	IF (nw_ai(k_tim,f_i) > 0) THEN
2554	m_t = nw_dl(nw_ai(k_tim,f_i),f_i);
2555	ELSE
2556	m_t = -1;
2557	ENDIF
2558	!-
2559	IF (l_dbg) THEN
2560	WRITE(*,'(" fliogstc - dimensions :",/,(5(1X,I10),:))') &
2561	& m_x,m_y,m_z,m_t
2562	ENDIF
2563	!-
2564	! Initialize the x-y indices
2565	!-
2566	IF ( PRESENT(x_axis) &
2567	& .OR.PRESENT(x_axis_2d) &
2568	& .OR.PRESENT(y_axis_2d) ) THEN
2569	IF (PRESENT(x_start)) THEN
2570	i_x = x_start
2571	ELSE
2572	i_x = 1
2573	ENDIF
2574	IF (PRESENT(x_count)) THEN
2575	l_x = x_count
2576	ELSE
2577	l_x = m_x-i_x+1
2578	ENDIF
2579	ENDIF
2580	IF ( PRESENT(y_axis) &
2581	& .OR.PRESENT(y_axis_2d) &
2582	& .OR.PRESENT(x_axis_2d) ) THEN
2583	IF (PRESENT(y_start)) THEN
2584	i_y = y_start
2585	ELSE
2586	i_y = 1
2587	ENDIF
2588	IF (PRESENT(y_count)) THEN
2589	l_y = y_count
2590	ELSE
2591	l_y = m_y-i_y+1
2592	ENDIF
2593	ENDIF
2594	IF (PRESENT(x_axis)) THEN
2595	IF (m_x <= 0) THEN
2596	CALL ipslerr (3,'fliogstc', &
2597	& 'Requested x_axis', &
2598	& 'but the coordinate is not present','in the file')
2599	ELSE IF ((i_x+l_x-1) > m_x) THEN
2600	CALL ipslerr (3,'fliogstc', &
2601	& 'The requested size for the x_axis', &
2602	& 'is greater than the size of the coordinate','in the file')
2603	ENDIF
2604	ENDIF
2605	IF (PRESENT(y_axis)) THEN
2606	IF (m_y <= 0) THEN
2607	CALL ipslerr (3,'fliogstc', &
2608	& 'Requested y_axis', &
2609	& 'but the coordinate is not present','in the file')
2610	ELSE IF ((i_y+l_y-1) > m_y) THEN
2611	CALL ipslerr (3,'fliogstc', &
2612	& 'The requested size for the y_axis', &
2613	& 'is greater than the size of the coordinate','in the file')
2614	ENDIF
2615	ENDIF
2616	IF (PRESENT(x_axis_2d).OR.PRESENT(y_axis_2d) )THEN
2617	IF ( (m_x <= 0).OR.(m_y <= 0) ) THEN
2618	CALL ipslerr (3,'fliogstc', &
2619	& 'Requested [x/y]_axis_2d', &
2620	& 'but the coordinates are not iboth present','in the file')
2621	ELSE IF ( ((i_x+l_x-1) > m_x).OR.((i_y+l_y-1) > m_y) ) THEN
2622	CALL ipslerr (3,'fliogstc', &
2623	& 'The requested size for the [x/y]_axis_2d', &
2624	& 'is greater than the size of the coordinate','in the file')
2625	ENDIF
2626	ENDIF
2627	!-
2628	! Ensuring data mode
2629	!-
2630	CALL flio_hdm (f_i,f_e,.FALSE.)
2631	!-
2632	! Extracting the x coordinate, if needed
2633	!-
2634	IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
2635	CALL flio_qax (f_i,'x',i_v,nbdim)
2636	IF (i_v > 0) THEN
2637	IF (nbdim == 1) THEN
2638	IF (PRESENT(x_axis)) THEN
2639	i_rc = NF90_GET_VAR(f_e,i_v,x_axis, &
2640	& start=(/i_x/),count=(/l_x/))
2641	ELSE
2642	ALLOCATE(v_tmp(l_x))
2643	i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
2644	& start=(/i_x/),count=(/l_x/))
2645	DO kv=1,l_y
2646	x_axis_2d(:,kv) = v_tmp(:)
2647	ENDDO
2648	DEALLOCATE(v_tmp)
2649	ENDIF
2650	ELSE IF (nbdim == 2) THEN
2651	IF (PRESENT(x_axis)) THEN
2652	l_ok = .TRUE.
2653	IF (l_y > 1) THEN
2654	ALLOCATE(v_tmp(l_y))
2655	DO kv=i_x,i_x+l_x-1
2656	i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
2657	& start=(/kv,i_y/),count=(/1,l_y/))
2658	IF (ANY(v_tmp(2:l_y) /= v_tmp(1))) THEN
2659	l_ok = .FALSE.
2660	EXIT
2661	ENDIF
2662	ENDDO
2663	DEALLOCATE(v_tmp)
2664	ENDIF
2665	IF (l_ok) THEN
2666	i_rc = NF90_GET_VAR(f_e,i_v,x_axis, &
2667	& start=(/i_x,i_y/),count=(/l_x,1/))
2668	ELSE
2669	CALL ipslerr (3,'fliogstc', &
2670	& 'Requested 1D x_axis', &
2671	& 'which have 2 not regular dimensions', &
2672	& 'in the file')
2673	ENDIF
2674	ELSE
2675	i_rc = NF90_GET_VAR(f_e,i_v,x_axis_2d, &
2676	& start=(/i_x,i_y/),count=(/l_x,l_y/))
2677	ENDIF
2678	ELSE
2679	CALL ipslerr (3,'fliogstc', &
2680	& 'Can not handle x_axis', &
2681	& 'that have more than 2 dimensions', &
2682	& 'in the file')
2683	ENDIF
2684	ELSE
2685	CALL ipslerr (3,'fliogstc','No x_axis found','in the file',' ')
2686	ENDIF
2687	ENDIF
2688	!-
2689	! Extracting the y coordinate, if needed
2690	!-
2691	IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
2692	CALL flio_qax (f_i,'y',i_v,nbdim)
2693	IF (i_v > 0) THEN
2694	IF (nbdim == 1) THEN
2695	IF (PRESENT(y_axis)) THEN
2696	i_rc = NF90_GET_VAR(f_e,i_v,y_axis, &
2697	& start=(/i_y/),count=(/l_y/))
2698	ELSE
2699	ALLOCATE(v_tmp(l_y))
2700	i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
2701	& start=(/i_y/),count=(/l_y/))
2702	DO kv=1,l_x
2703	y_axis_2d(kv,:) = v_tmp(:)
2704	ENDDO
2705	DEALLOCATE(v_tmp)
2706	ENDIF
2707	ELSE IF (nbdim == 2) THEN
2708	IF (PRESENT(y_axis)) THEN
2709	l_ok = .TRUE.
2710	IF (l_x > 1) THEN
2711	ALLOCATE(v_tmp(l_x))
2712	DO kv=i_y,i_y+l_y-1
2713	i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
2714	& start=(/i_x,kv/),count=(/l_x,1/))
2715	IF (ANY(v_tmp(2:l_x) /= v_tmp(1))) THEN
2716	l_ok = .FALSE.
2717	EXIT
2718	ENDIF
2719	ENDDO
2720	DEALLOCATE(v_tmp)
2721	ENDIF
2722	IF (l_ok) THEN
2723	i_rc = NF90_GET_VAR(f_e,i_v,y_axis, &
2724	& start=(/i_x,i_y/),count=(/1,l_y/))
2725	ELSE
2726	CALL ipslerr (3,'fliogstc', &
2727	& 'Requested 1D y_axis', &
2728	& 'which have 2 not regular dimensions', &
2729	& 'in the file')
2730	ENDIF
2731	ELSE
2732	i_rc = NF90_GET_VAR(f_e,i_v,y_axis_2d, &
2733	& start=(/i_x,i_y/),count=(/l_x,l_y/))
2734	ENDIF
2735	ELSE
2736	CALL ipslerr (3,'fliogstc', &
2737	& 'Can not handle y axis', &
2738	& 'that have more than 2 dimensions', &
2739	& 'in the file')
2740	ENDIF
2741	ELSE
2742	CALL ipslerr (3,'fliogstc','No y_axis found','in the file',' ')
2743	ENDIF
2744	ENDIF
2745	!-
2746	! Extracting the z coordinate, if needed
2747	!-
2748	IF (PRESENT(z_axis)) THEN
2749	IF (PRESENT(z_start)) THEN
2750	i_z = z_start
2751	ELSE
2752	i_z = 1
2753	ENDIF
2754	IF (PRESENT(z_count)) THEN
2755	l_z = z_count
2756	ELSE
2757	l_z = m_z-i_z+1
2758	ENDIF
2759	IF ((i_z+l_z-1) > m_z) THEN
2760	CALL ipslerr (3,'fliogstc', &
2761	& 'The requested size for the z axis', &
2762	& 'is greater than the size of the coordinate',&
2763	& 'in the file')
2764	ENDIF
2765	CALL flio_qax (f_i,'z',i_v,nbdim)
2766	IF (i_v > 0) THEN
2767	IF (nbdim == 1) THEN
2768	i_rc = NF90_GET_VAR(f_e,i_v,z_axis, &
2769	& start=(/i_z/),count=(/l_z/))
2770	ELSE
2771	CALL ipslerr (3,'fliogstc', &
2772	& 'Can not handle z_axis', &
2773	& 'that have more than 1 dimension', &
2774	& 'in the file')
2775	ENDIF
2776	ELSE
2777	CALL ipslerr (3,'fliogstc','No z_axis found','in the file',' ')
2778	ENDIF
2779	ENDIF
2780	!-
2781	! Extracting the t coordinate, if needed
2782	!-
2783	IF (PRESENT(t_axis).OR.PRESENT(t_init).OR.PRESENT(t_step)) THEN
2784	CALL flio_qax (f_i,'t',i_v,nbdim)
2785	IF (i_v < 0) THEN
2786	CALL ipslerr (3,'fliogstc','No t_axis found','in the file',' ')
2787	ENDIF
2788	!---
2789	IF (l_dbg) THEN
2790	WRITE(,) ' fliogstc - get time details'
2791	ENDIF
2792	!---
2793	!-- Get all the details for the time
2794	!-- Prefered method is '"time_steps" since'
2795	!---
2796	name=''
2797	i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v,name=name)
2798	units=''
2799	i_rc = NF90_GET_ATT(f_e,i_v,'units',units)
2800	IF (INDEX(units,' since ') > 0) THEN
2801	it_t = 1
2802	ELSE IF (INDEX(name,'tstep') > 0) THEN
2803	it_t = 2
2804	ELSE
2805	it_t = 0;
2806	ENDIF
2807	ENDIF
2808	!-
2809	! Extracting the t coordinate, if needed
2810	!-
2811	IF (PRESENT(t_axis)) THEN
2812	IF (PRESENT(t_start)) THEN
2813	i_t = t_start
2814	ELSE
2815	i_t = 1
2816	ENDIF
2817	IF (PRESENT(t_count)) THEN
2818	l_t = t_count
2819	ELSE
2820	l_t = m_t-i_t+1
2821	ENDIF
2822	IF ((i_t+l_t-1) > m_t) THEN
2823	CALL ipslerr (3,'fliogstc', &
2824	& 'The requested size for the t axis', &
2825	& 'is greater than the size of the coordinate',&
2826	& 'in the file')
2827	ENDIF
2828	ALLOCATE(v_tmp(l_t))
2829	i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
2830	& start=(/i_t/),count=(/l_t/))
2831	t_axis(1:l_t) = NINT(v_tmp(1:l_t))
2832	DEALLOCATE(v_tmp)
2833	!---
2834	IF (l_dbg) THEN
2835	WRITE(,) ' fliogstc - first time : ',t_axis(1:1)
2836	ENDIF
2837	ENDIF
2838	!-
2839	! Extracting the time at the beginning, if needed
2840	!-
2841	IF (PRESENT(t_init)) THEN
2842	!-- Find the calendar
2843	CALL lock_calendar (old_status=l_tmp)
2844	CALL ioget_calendar (c_tmp)
2845	units = ''
2846	i_rc = NF90_GET_ATT(f_e,i_v,'calendar',units)
2847	IF (i_rc == NF90_NOERR) THEN
2848	CALL lock_calendar (new_status=.FALSE.)
2849	CALL ioconf_calendar (TRIM(units))
2850	ENDIF
2851	IF (it_t == 1) THEN
2852	units = ''
2853	i_rc = NF90_GET_ATT(f_e,i_v,'units',units)
2854	units = units(INDEX(units,' since ')+7:LEN_TRIM(units))
2855	READ (units,'(I4.4,5(A,I2.2))') &
2856	& j_yy,c_1,j_mo,c_1,j_dd,c_1,j_hh,c_1,j_mn,c_1,j_ss
2857	r_ss = j_hh3600.+j_mn60.+j_ss
2858	CALL ymds2ju (j_yy,j_mo,j_dd,r_ss,t_init)
2859	ELSE IF (it_t == 2) THEN
2860	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'year0',r_yy)
2861	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'month0',r_mo)
2862	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'day0',r_dd)
2863	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'sec0',r_ss)
2864	j_yy = NINT(r_yy); j_mo = NINT(r_mo); j_dd = NINT(r_dd);
2865	CALL ymds2ju (j_yy,j_mo,j_dd,r_ss,t_init)
2866	ELSE
2867	t_init = 0.
2868	ENDIF
2869	CALL lock_calendar (new_status=.FALSE.)
2870	CALL ioconf_calendar (TRIM(c_tmp))
2871	CALL lock_calendar (new_status=l_tmp)
2872	IF (l_dbg) THEN
2873	WRITE(,) ' fliogstc - time_type : '
2874	WRITE(,) it_t
2875	WRITE(,) ' fliogstc - year month day second t_init : '
2876	WRITE(,) j_yy,j_mo,j_dd,r_ss,t_init
2877	ENDIF
2878	ENDIF
2879	!-
2880	! Extracting the timestep in seconds, if needed
2881	!-
2882	IF (PRESENT(t_step)) THEN
2883	IF (it_t == 1) THEN
2884	units = ''
2885	i_rc = NF90_GET_ATT(f_e,i_v,'units',units)
2886	units = ADJUSTL(units(1:INDEX(units,' since ')-1))
2887	dtn = 1.
2888	IF (INDEX(units,"week") /= 0) THEN
2889	kv = INDEX(units,"week")
2890	dtv = 604800.
2891	ELSE IF (INDEX(units,"day") /= 0) THEN
2892	kv = INDEX(units,"day")
2893	dtv = 86400.
2894	ELSE IF (INDEX(units,"h") /= 0) THEN
2895	kv = INDEX(units,"h")
2896	dtv = 3600.
2897	ELSE IF (INDEX(units,"min") /= 0) THEN
2898	kv = INDEX(units,"min")
2899	dtv = 60.
2900	ELSE IF (INDEX(units,"sec") /= 0) THEN
2901	kv = INDEX(units,"sec")
2902	dtv = 1.
2903	ELSE IF (INDEX(units,"timesteps") /= 0) THEN
2904	kv = INDEX(units,"timesteps")
2905	i_rc = NF90_GET_ATT(f_e,i_v,'tstep_sec',dtv)
2906	IF (i_rc /= NF90_NOERR) THEN
2907	CALL ipslerr (3,'fliogstc','"timesteps" value', &
2908	& 'not found','in the file')
2909	ENDIF
2910	ELSE
2911	kv = 1
2912	dtv = 1.
2913	ENDIF
2914	IF (kv > 1) THEN
2915	READ (unit=units(1:kv-1),FMT=*) dtn
2916	ENDIF
2917	t_step = dtn*dtv
2918	ELSE IF (it_t == 2) THEN
2919	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'delta_tstep_sec',t_step)
2920	ELSE
2921	t_step = 1.
2922	ENDIF
2923	ENDIF
2924	!-
2925	! Extracting the calendar attribute, if needed
2926	!-
2927	IF (PRESENT(t_calendar)) THEN
2928	units = ''
2929	i_rc = NF90_GET_ATT(f_e,i_v,'calendar',units)
2930	IF (i_rc == NF90_NOERR) THEN
2931	t_calendar = units
2932	ELSE
2933	t_calendar = "not found"
2934	ENDIF
2935	ENDIF
2936	!-
2937	IF (l_dbg) THEN
2938	WRITE(,) "<-fliogstc"
2939	ENDIF
2940	!----------------------
2941	END SUBROUTINE fliogstc
2942	!===
2943	SUBROUTINE flioinqv &
2944	& (f_i,v_n,l_ex,v_t,nb_dims,len_dims,id_dims, &
2945	& nb_atts,cn_atts,ia_start,ia_count)
2946	!---------------------------------------------------------------------
2947	IMPLICIT NONE
2948	!-
2949	INTEGER,INTENT(IN) :: f_i
2950	CHARACTER(LEN=*),INTENT(IN) :: v_n
2951	LOGICAL,INTENT(OUT) :: l_ex
2952	INTEGER,OPTIONAL,INTENT(OUT) :: v_t,nb_dims,nb_atts
2953	INTEGER,OPTIONAL,INTENT(OUT),DIMENSION(:) :: len_dims,id_dims
2954	CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: cn_atts
2955	INTEGER,OPTIONAL,INTENT(IN) :: ia_start,ia_count
2956	!-
2957	INTEGER :: f_e,i_v,n_w,i_s,i_w,iws,iwc,i_rc
2958	LOGICAL :: l_ok
2959	INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dim_ids
2960	!-
2961	LOGICAL :: l_dbg
2962	!---------------------------------------------------------------------
2963	CALL ipsldbg (old_status=l_dbg)
2964	!-
2965	IF (l_dbg) THEN
2966	WRITE(,) "->flioinqv ",TRIM(v_n)
2967	ENDIF
2968	!-
2969	! Retrieve the external file index
2970	CALL flio_qvid ('flioinqv',f_i,f_e)
2971	!-
2972	i_v = -1
2973	i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
2974	!-
2975	l_ex = ( (i_v >= 0).AND.(i_rc == NF90_NOERR) )
2976	!-
2977	IF (l_ex) THEN
2978	IF (PRESENT(v_t)) THEN
2979	i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v,xtype=v_t)
2980	ENDIF
2981	n_w = -1
2982	IF (PRESENT(nb_dims).OR.PRESENT(len_dims)) THEN
2983	i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v, &
2984	& ndims=n_w,dimids=dim_ids)
2985	IF (PRESENT(nb_dims)) THEN
2986	nb_dims = n_w
2987	ENDIF
2988	IF (PRESENT(len_dims)) THEN
2989	i_s = SIZE(len_dims)
2990	len_dims(:) = -1
2991	IF (i_s < n_w) THEN
2992	CALL ipslerr (2,'flioinqv', &
2993	& 'Only the first dimensions of the variable', &
2994	& TRIM(v_n),'will be returned')
2995	ENDIF
2996	DO i_w=1,MIN(n_w,i_s)
2997	i_rc = NF90_INQUIRE_DIMENSION(f_e,dim_ids(i_w), &
2998	& len=len_dims(i_w))
2999	ENDDO
3000	ENDIF
3001	IF (PRESENT(id_dims)) THEN
3002	i_s = SIZE(id_dims)
3003	id_dims(:) = -1
3004	IF (i_s < n_w) THEN
3005	CALL ipslerr (2,'flioinqv', &
3006	& 'The number of dimensions to retrieve', &
3007	& 'is greater than the size of the array,', &
3008	& 'only the first dimensions of "' &
3009	& //TRIM(v_n)//'" will be returned')
3010	ENDIF
3011	i_w = MIN(n_w,i_s)
3012	id_dims(1:i_w) = dim_ids(1:i_w)
3013	ENDIF
3014	ENDIF
3015	IF (PRESENT(nb_atts).OR.PRESENT(cn_atts)) THEN
3016	i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v,nAtts=n_w)
3017	IF (PRESENT(nb_atts)) THEN
3018	nb_atts = n_w
3019	ENDIF
3020	IF (PRESENT(cn_atts)) THEN
3021	l_ok = .TRUE.
3022	i_s = SIZE(cn_atts)
3023	DO i_w=1,i_s
3024	cn_atts(i_w)(:) = '?'
3025	ENDDO
3026	IF (PRESENT(ia_start)) THEN
3027	iws = ia_start
3028	ELSE
3029	iws = 1
3030	ENDIF
3031	IF (PRESENT(ia_count)) THEN
3032	iwc = ia_count
3033	ELSE
3034	iwc = n_w
3035	ENDIF
3036	IF (iws > n_w) THEN
3037	l_ok = .FALSE.
3038	CALL ipslerr (2,'flioinqv', &
3039	& 'The start index of requested attributes', &
3040	& 'is greater than the number of attributes of', &
3041	& '"'//TRIM(v_n)//'"')
3042	ELSE IF (iws < 1) THEN
3043	l_ok = .FALSE.
3044	CALL ipslerr (2,'flioinqv', &
3045	& 'The start index of requested attributes', &
3046	& 'is invalid ( < 1 ) for', &
3047	& '"'//TRIM(v_n)//'"')
3048	ENDIF
3049	IF ((iws+iwc-1) > n_w) THEN
3050	CALL ipslerr (2,'flioinqv', &
3051	& 'The number of requested attributes', &
3052	& 'is greater than the number of attributes of', &
3053	& '"'//TRIM(v_n)//'"')
3054	ENDIF
3055	IF (iwc > i_s) THEN
3056	CALL ipslerr (2,'flioinqv', &
3057	& 'The number of attributes to retrieve', &
3058	& 'is greater than the size of the array,', &
3059	& 'only the first attributes of "' &
3060	& //TRIM(v_n)//'" will be returned')
3061	ELSE IF (iwc < 1) THEN
3062	l_ok = .FALSE.
3063	CALL ipslerr (2,'flioinqv', &
3064	& 'The number of requested attributes', &
3065	& 'is invalid ( < 1 ) for', &
3066	& '"'//TRIM(v_n)//'"')
3067	ENDIF
3068	IF (l_ok) THEN
3069	DO i_w=1,MIN(iwc,i_s,n_w-iws+1)
3070	i_rc = NF90_INQ_ATTNAME(f_e, &
3071	& i_v,i_w+iws-1,name=cn_atts(i_w))
3072	ENDDO
3073	ENDIF
3074	ENDIF
3075	ENDIF
3076	ENDIF
3077	!-
3078	IF (l_dbg) THEN
3079	WRITE(,) "<-flioinqv"
3080	ENDIF
3081	!----------------------
3082	END SUBROUTINE flioinqv
3083	!===
3084	SUBROUTINE fliogv_i40 (f_i,v_n,v_v,start)
3085	!---------------------------------------------------------------------
3086	IMPLICIT NONE
3087	!-
3088	INTEGER,INTENT(IN) :: f_i
3089	CHARACTER(LEN=*),INTENT(IN) :: v_n
3090	INTEGER(KIND=i_4),INTENT(OUT) :: v_v
3091	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
3092	!---------------------------------------------------------------------
3093	CALL flio_ugv (f_i,v_n,i_40=v_v,start=start)
3094	!------------------------
3095	END SUBROUTINE fliogv_i40
3096	!===
3097	SUBROUTINE fliogv_i41 (f_i,v_n,v_v,start,count)
3098	!---------------------------------------------------------------------
3099	IMPLICIT NONE
3100	!-
3101	INTEGER,INTENT(IN) :: f_i
3102	CHARACTER(LEN=*),INTENT(IN) :: v_n
3103	INTEGER(KIND=i_4),DIMENSION(:),INTENT(OUT) :: v_v
3104	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3105	!---------------------------------------------------------------------
3106	CALL flio_ugv (f_i,v_n,i_41=v_v,start=start,count=count)
3107	!------------------------
3108	END SUBROUTINE fliogv_i41
3109	!===
3110	SUBROUTINE fliogv_i42 (f_i,v_n,v_v,start,count)
3111	!---------------------------------------------------------------------
3112	IMPLICIT NONE
3113	!-
3114	INTEGER,INTENT(IN) :: f_i
3115	CHARACTER(LEN=*),INTENT(IN) :: v_n
3116	INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(OUT) :: v_v
3117	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3118	!---------------------------------------------------------------------
3119	CALL flio_ugv (f_i,v_n,i_42=v_v,start=start,count=count)
3120	!------------------------
3121	END SUBROUTINE fliogv_i42
3122	!===
3123	SUBROUTINE fliogv_i43 (f_i,v_n,v_v,start,count)
3124	!---------------------------------------------------------------------
3125	IMPLICIT NONE
3126	!-
3127	INTEGER,INTENT(IN) :: f_i
3128	CHARACTER(LEN=*),INTENT(IN) :: v_n
3129	INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(OUT) :: v_v
3130	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3131	!---------------------------------------------------------------------
3132	CALL flio_ugv (f_i,v_n,i_43=v_v,start=start,count=count)
3133	!------------------------
3134	END SUBROUTINE fliogv_i43
3135	!===
3136	SUBROUTINE fliogv_i44 (f_i,v_n,v_v,start,count)
3137	!---------------------------------------------------------------------
3138	IMPLICIT NONE
3139	!-
3140	INTEGER,INTENT(IN) :: f_i
3141	CHARACTER(LEN=*),INTENT(IN) :: v_n
3142	INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
3143	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3144	!---------------------------------------------------------------------
3145	CALL flio_ugv (f_i,v_n,i_44=v_v,start=start,count=count)
3146	!------------------------
3147	END SUBROUTINE fliogv_i44
3148	!===
3149	SUBROUTINE fliogv_i45 (f_i,v_n,v_v,start,count)
3150	!---------------------------------------------------------------------
3151	IMPLICIT NONE
3152	!-
3153	INTEGER,INTENT(IN) :: f_i
3154	CHARACTER(LEN=*),INTENT(IN) :: v_n
3155	INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
3156	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3157	!---------------------------------------------------------------------
3158	CALL flio_ugv (f_i,v_n,i_45=v_v,start=start,count=count)
3159	!------------------------
3160	END SUBROUTINE fliogv_i45
3161	!===
3162	SUBROUTINE fliogv_i20 (f_i,v_n,v_v,start)
3163	!---------------------------------------------------------------------
3164	IMPLICIT NONE
3165	!-
3166	INTEGER,INTENT(IN) :: f_i
3167	CHARACTER(LEN=*),INTENT(IN) :: v_n
3168	INTEGER(KIND=i_2),INTENT(OUT) :: v_v
3169	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
3170	!---------------------------------------------------------------------
3171	CALL flio_ugv (f_i,v_n,i_20=v_v,start=start)
3172	!------------------------
3173	END SUBROUTINE fliogv_i20
3174	!===
3175	SUBROUTINE fliogv_i21 (f_i,v_n,v_v,start,count)
3176	!---------------------------------------------------------------------
3177	IMPLICIT NONE
3178	!-
3179	INTEGER,INTENT(IN) :: f_i
3180	CHARACTER(LEN=*),INTENT(IN) :: v_n
3181	INTEGER(KIND=i_2),DIMENSION(:),INTENT(OUT) :: v_v
3182	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3183	!---------------------------------------------------------------------
3184	CALL flio_ugv (f_i,v_n,i_21=v_v,start=start,count=count)
3185	!------------------------
3186	END SUBROUTINE fliogv_i21
3187	!===
3188	SUBROUTINE fliogv_i22 (f_i,v_n,v_v,start,count)
3189	!---------------------------------------------------------------------
3190	IMPLICIT NONE
3191	!-
3192	INTEGER,INTENT(IN) :: f_i
3193	CHARACTER(LEN=*),INTENT(IN) :: v_n
3194	INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(OUT) :: v_v
3195	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3196	!---------------------------------------------------------------------
3197	CALL flio_ugv (f_i,v_n,i_22=v_v,start=start,count=count)
3198	!------------------------
3199	END SUBROUTINE fliogv_i22
3200	!===
3201	SUBROUTINE fliogv_i23 (f_i,v_n,v_v,start,count)
3202	!---------------------------------------------------------------------
3203	IMPLICIT NONE
3204	!-
3205	INTEGER,INTENT(IN) :: f_i
3206	CHARACTER(LEN=*),INTENT(IN) :: v_n
3207	INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(OUT) :: v_v
3208	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3209	!---------------------------------------------------------------------
3210	CALL flio_ugv (f_i,v_n,i_23=v_v,start=start,count=count)
3211	!------------------------
3212	END SUBROUTINE fliogv_i23
3213	!===
3214	SUBROUTINE fliogv_i24 (f_i,v_n,v_v,start,count)
3215	!---------------------------------------------------------------------
3216	IMPLICIT NONE
3217	!-
3218	INTEGER,INTENT(IN) :: f_i
3219	CHARACTER(LEN=*),INTENT(IN) :: v_n
3220	INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
3221	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3222	!---------------------------------------------------------------------
3223	CALL flio_ugv (f_i,v_n,i_24=v_v,start=start,count=count)
3224	!------------------------
3225	END SUBROUTINE fliogv_i24
3226	!===
3227	SUBROUTINE fliogv_i25 (f_i,v_n,v_v,start,count)
3228	!---------------------------------------------------------------------
3229	IMPLICIT NONE
3230	!-
3231	INTEGER,INTENT(IN) :: f_i
3232	CHARACTER(LEN=*),INTENT(IN) :: v_n
3233	INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
3234	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3235	!---------------------------------------------------------------------
3236	CALL flio_ugv (f_i,v_n,i_25=v_v,start=start,count=count)
3237	!------------------------
3238	END SUBROUTINE fliogv_i25
3239	!===
3240	!?INTEGERS of KIND 1 are not supported on all computers
3241	!?SUBROUTINE fliogv_i10 (f_i,v_n,v_v,start)
3242	!?!---------------------------------------------------------------------
3243	!? IMPLICIT NONE
3244	!?!-
3245	!? INTEGER,INTENT(IN) :: f_i
3246	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
3247	!? INTEGER(KIND=i_1),INTENT(OUT) :: v_v
3248	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
3249	!?!---------------------------------------------------------------------
3250	!? CALL flio_ugv (f_i,v_n,i_10=v_v,start=start)
3251	!?!------------------------
3252	!?END SUBROUTINE fliogv_i10
3253	!?!===
3254	!?SUBROUTINE fliogv_i11 (f_i,v_n,v_v,start,count)
3255	!?!---------------------------------------------------------------------
3256	!? IMPLICIT NONE
3257	!?!-
3258	!? INTEGER,INTENT(IN) :: f_i
3259	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
3260	!? INTEGER(KIND=i_1),DIMENSION(:),INTENT(OUT) :: v_v
3261	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3262	!?!---------------------------------------------------------------------
3263	!? CALL flio_ugv (f_i,v_n,i_11=v_v,start=start,count=count)
3264	!?!------------------------
3265	!?END SUBROUTINE fliogv_i11
3266	!?!===
3267	!?SUBROUTINE fliogv_i12 (f_i,v_n,v_v,start,count)
3268	!?!---------------------------------------------------------------------
3269	!? IMPLICIT NONE
3270	!?!-
3271	!? INTEGER,INTENT(IN) :: f_i
3272	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
3273	!? INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(OUT) :: v_v
3274	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3275	!?!---------------------------------------------------------------------
3276	!? CALL flio_ugv (f_i,v_n,i_12=v_v,start=start,count=count)
3277	!?!------------------------
3278	!?END SUBROUTINE fliogv_i12
3279	!?!===
3280	!?SUBROUTINE fliogv_i13 (f_i,v_n,v_v,start,count)
3281	!?!---------------------------------------------------------------------
3282	!? IMPLICIT NONE
3283	!?!-
3284	!? INTEGER,INTENT(IN) :: f_i
3285	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
3286	!? INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(OUT) :: v_v
3287	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3288	!?!---------------------------------------------------------------------
3289	!? CALL flio_ugv (f_i,v_n,i_13=v_v,start=start,count=count)
3290	!?!------------------------
3291	!?END SUBROUTINE fliogv_i13
3292	!?!===
3293	!?SUBROUTINE fliogv_i14 (f_i,v_n,v_v,start,count)
3294	!?!---------------------------------------------------------------------
3295	!? IMPLICIT NONE
3296	!?!-
3297	!? INTEGER,INTENT(IN) :: f_i
3298	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
3299	!? INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
3300	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3301	!?!---------------------------------------------------------------------
3302	!? CALL flio_ugv (f_i,v_n,i_14=v_v,start=start,count=count)
3303	!?!------------------------
3304	!?END SUBROUTINE fliogv_i14
3305	!?!===
3306	!?SUBROUTINE fliogv_i15 (f_i,v_n,v_v,start,count)
3307	!?!---------------------------------------------------------------------
3308	!? IMPLICIT NONE
3309	!?!-
3310	!? INTEGER,INTENT(IN) :: f_i
3311	!? CHARACTER(LEN=*),INTENT(IN) :: v_n
3312	!? INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
3313	!? INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3314	!?!---------------------------------------------------------------------
3315	!? CALL flio_ugv (f_i,v_n,i_15=v_v,start=start,count=count)
3316	!?!------------------------
3317	!?END SUBROUTINE fliogv_i15
3318	!===
3319	SUBROUTINE fliogv_r40 (f_i,v_n,v_v,start)
3320	!---------------------------------------------------------------------
3321	IMPLICIT NONE
3322	!-
3323	INTEGER,INTENT(IN) :: f_i
3324	CHARACTER(LEN=*),INTENT(IN) :: v_n
3325	REAL(KIND=r_4),INTENT(OUT) :: v_v
3326	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
3327	!---------------------------------------------------------------------
3328	CALL flio_ugv (f_i,v_n,r_40=v_v,start=start)
3329	!------------------------
3330	END SUBROUTINE fliogv_r40
3331	!===
3332	SUBROUTINE fliogv_r41 (f_i,v_n,v_v,start,count)
3333	!---------------------------------------------------------------------
3334	IMPLICIT NONE
3335	!-
3336	INTEGER,INTENT(IN) :: f_i
3337	CHARACTER(LEN=*),INTENT(IN) :: v_n
3338	REAL(KIND=r_4),DIMENSION(:),INTENT(OUT) :: v_v
3339	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3340	!---------------------------------------------------------------------
3341	CALL flio_ugv (f_i,v_n,r_41=v_v,start=start,count=count)
3342	!------------------------
3343	END SUBROUTINE fliogv_r41
3344	!===
3345	SUBROUTINE fliogv_r42 (f_i,v_n,v_v,start,count)
3346	!---------------------------------------------------------------------
3347	IMPLICIT NONE
3348	!-
3349	INTEGER,INTENT(IN) :: f_i
3350	CHARACTER(LEN=*),INTENT(IN) :: v_n
3351	REAL(KIND=r_4),DIMENSION(:,:),INTENT(OUT) :: v_v
3352	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3353	!---------------------------------------------------------------------
3354	CALL flio_ugv (f_i,v_n,r_42=v_v,start=start,count=count)
3355	!------------------------
3356	END SUBROUTINE fliogv_r42
3357	!===
3358	SUBROUTINE fliogv_r43 (f_i,v_n,v_v,start,count)
3359	!---------------------------------------------------------------------
3360	IMPLICIT NONE
3361	!-
3362	INTEGER,INTENT(IN) :: f_i
3363	CHARACTER(LEN=*),INTENT(IN) :: v_n
3364	REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(OUT) :: v_v
3365	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3366	!---------------------------------------------------------------------
3367	CALL flio_ugv (f_i,v_n,r_43=v_v,start=start,count=count)
3368	!------------------------
3369	END SUBROUTINE fliogv_r43
3370	!===
3371	SUBROUTINE fliogv_r44 (f_i,v_n,v_v,start,count)
3372	!---------------------------------------------------------------------
3373	IMPLICIT NONE
3374	!-
3375	INTEGER,INTENT(IN) :: f_i
3376	CHARACTER(LEN=*),INTENT(IN) :: v_n
3377	REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
3378	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3379	!---------------------------------------------------------------------
3380	CALL flio_ugv (f_i,v_n,r_44=v_v,start=start,count=count)
3381	!------------------------
3382	END SUBROUTINE fliogv_r44
3383	!===
3384	SUBROUTINE fliogv_r45 (f_i,v_n,v_v,start,count)
3385	!---------------------------------------------------------------------
3386	IMPLICIT NONE
3387	!-
3388	INTEGER,INTENT(IN) :: f_i
3389	CHARACTER(LEN=*),INTENT(IN) :: v_n
3390	REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
3391	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3392	!---------------------------------------------------------------------
3393	CALL flio_ugv (f_i,v_n,r_45=v_v,start=start,count=count)
3394	!------------------------
3395	END SUBROUTINE fliogv_r45
3396	!===
3397	SUBROUTINE fliogv_r80 (f_i,v_n,v_v,start)
3398	!---------------------------------------------------------------------
3399	IMPLICIT NONE
3400	!-
3401	INTEGER,INTENT(IN) :: f_i
3402	CHARACTER(LEN=*),INTENT(IN) :: v_n
3403	REAL(KIND=r_8),INTENT(OUT) :: v_v
3404	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
3405	!---------------------------------------------------------------------
3406	CALL flio_ugv (f_i,v_n,r_80=v_v,start=start)
3407	!------------------------
3408	END SUBROUTINE fliogv_r80
3409	!===
3410	SUBROUTINE fliogv_r81 (f_i,v_n,v_v,start,count)
3411	!---------------------------------------------------------------------
3412	IMPLICIT NONE
3413	!-
3414	INTEGER,INTENT(IN) :: f_i
3415	CHARACTER(LEN=*),INTENT(IN) :: v_n
3416	REAL(KIND=r_8),DIMENSION(:),INTENT(OUT) :: v_v
3417	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3418	!---------------------------------------------------------------------
3419	CALL flio_ugv (f_i,v_n,r_81=v_v,start=start,count=count)
3420	!------------------------
3421	END SUBROUTINE fliogv_r81
3422	!===
3423	SUBROUTINE fliogv_r82 (f_i,v_n,v_v,start,count)
3424	!---------------------------------------------------------------------
3425	IMPLICIT NONE
3426	!-
3427	INTEGER,INTENT(IN) :: f_i
3428	CHARACTER(LEN=*),INTENT(IN) :: v_n
3429	REAL(KIND=r_8),DIMENSION(:,:),INTENT(OUT) :: v_v
3430	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3431	!---------------------------------------------------------------------
3432	CALL flio_ugv (f_i,v_n,r_82=v_v,start=start,count=count)
3433	!------------------------
3434	END SUBROUTINE fliogv_r82
3435	!===
3436	SUBROUTINE fliogv_r83 (f_i,v_n,v_v,start,count)
3437	!---------------------------------------------------------------------
3438	IMPLICIT NONE
3439	!-
3440	INTEGER,INTENT(IN) :: f_i
3441	CHARACTER(LEN=*),INTENT(IN) :: v_n
3442	REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(OUT) :: v_v
3443	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3444	!---------------------------------------------------------------------
3445	CALL flio_ugv (f_i,v_n,r_83=v_v,start=start,count=count)
3446	!------------------------
3447	END SUBROUTINE fliogv_r83
3448	!===
3449	SUBROUTINE fliogv_r84 (f_i,v_n,v_v,start,count)
3450	!---------------------------------------------------------------------
3451	IMPLICIT NONE
3452	!-
3453	INTEGER,INTENT(IN) :: f_i
3454	CHARACTER(LEN=*),INTENT(IN) :: v_n
3455	REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
3456	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3457	!---------------------------------------------------------------------
3458	CALL flio_ugv (f_i,v_n,r_84=v_v,start=start,count=count)
3459	!------------------------
3460	END SUBROUTINE fliogv_r84
3461	!===
3462	SUBROUTINE fliogv_r85 (f_i,v_n,v_v,start,count)
3463	!---------------------------------------------------------------------
3464	IMPLICIT NONE
3465	!-
3466	INTEGER,INTENT(IN) :: f_i
3467	CHARACTER(LEN=*),INTENT(IN) :: v_n
3468	REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
3469	INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
3470	!---------------------------------------------------------------------
3471	CALL flio_ugv (f_i,v_n,r_85=v_v,start=start,count=count)
3472	!------------------------
3473	END SUBROUTINE fliogv_r85
3474	!===
3475	SUBROUTINE flio_ugv &
3476	& (f_i,v_n, &
3477	& i_40,i_41,i_42,i_43,i_44,i_45, &
3478	& i_20,i_21,i_22,i_23,i_24,i_25, &
3479	!? & i_10,i_11,i_12,i_13,i_14,i_15, &
3480	& r_40,r_41,r_42,r_43,r_44,r_45, &
3481	& r_80,r_81,r_82,r_83,r_84,r_85, &
3482	& start,count)
3483	!---------------------------------------------------------------------
3484	IMPLICIT NONE
3485	!-
3486	INTEGER,INTENT(IN) :: f_i
3487	CHARACTER(LEN=*),INTENT(IN) :: v_n
3488	INTEGER(KIND=i_4),INTENT(OUT),OPTIONAL :: i_40
3489	INTEGER(KIND=i_4),DIMENSION(:),INTENT(OUT),OPTIONAL :: i_41
3490	INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: i_42
3491	INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: i_43
3492	INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: i_44
3493	INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: i_45
3494	INTEGER(KIND=i_2),INTENT(OUT),OPTIONAL :: i_20
3495	INTEGER(KIND=i_2),DIMENSION(:),INTENT(OUT),OPTIONAL :: i_21
3496	INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: i_22
3497	INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: i_23
3498	INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: i_24
3499	INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: i_25
3500	!?INTEGERS of KIND 1 are not supported on all computers
3501	!?INTEGER(KIND=i_1),INTENT(OUT),OPTIONAL :: i_10
3502	!?INTEGER(KIND=i_1),DIMENSION(:),INTENT(OUT),OPTIONAL :: i_11
3503	!?INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: i_12
3504	!?INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: i_13
3505	!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: i_14
3506	!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: i_15
3507	REAL(KIND=r_4),INTENT(OUT),OPTIONAL :: r_40
3508	REAL(KIND=r_4),DIMENSION(:),INTENT(OUT),OPTIONAL :: r_41
3509	REAL(KIND=r_4),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: r_42
3510	REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: r_43
3511	REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: r_44
3512	REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: r_45
3513	REAL(KIND=r_8),INTENT(OUT),OPTIONAL :: r_80
3514	REAL(KIND=r_8),DIMENSION(:),INTENT(OUT),OPTIONAL :: r_81
3515	REAL(KIND=r_8),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: r_82
3516	REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: r_83
3517	REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: r_84
3518	REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: r_85
3519	INTEGER,DIMENSION(:),INTENT(IN),OPTIONAL :: start,count
3520	!-
3521	INTEGER :: f_e,i_v,i_rc
3522	CHARACTER(LEN=5) :: cvr_d
3523	!-
3524	LOGICAL :: l_dbg
3525	!---------------------------------------------------------------------
3526	CALL ipsldbg (old_status=l_dbg)
3527	!-
3528	IF (l_dbg) THEN
3529	IF (PRESENT(i_40)) THEN; cvr_d = "I1 0D";
3530	ELSE IF (PRESENT(i_41)) THEN; cvr_d = "I1 1D";
3531	ELSE IF (PRESENT(i_42)) THEN; cvr_d = "I1 2D";
3532	ELSE IF (PRESENT(i_43)) THEN; cvr_d = "I1 3D";
3533	ELSE IF (PRESENT(i_44)) THEN; cvr_d = "I1 4D";
3534	ELSE IF (PRESENT(i_45)) THEN; cvr_d = "I1 5D";
3535	ELSE IF (PRESENT(i_20)) THEN; cvr_d = "I2 0D";
3536	ELSE IF (PRESENT(i_21)) THEN; cvr_d = "I2 1D";
3537	ELSE IF (PRESENT(i_22)) THEN; cvr_d = "I2 2D";
3538	ELSE IF (PRESENT(i_23)) THEN; cvr_d = "I2 3D";
3539	ELSE IF (PRESENT(i_24)) THEN; cvr_d = "I2 4D";
3540	ELSE IF (PRESENT(i_25)) THEN; cvr_d = "I2 5D";
3541	!? ELSE IF (PRESENT(i_10)) THEN; cvr_d = "I4 0D";
3542	!? ELSE IF (PRESENT(i_11)) THEN; cvr_d = "I4 1D";
3543	!? ELSE IF (PRESENT(i_12)) THEN; cvr_d = "I4 2D";
3544	!? ELSE IF (PRESENT(i_13)) THEN; cvr_d = "I4 3D";
3545	!? ELSE IF (PRESENT(i_14)) THEN; cvr_d = "I4 4D";
3546	!? ELSE IF (PRESENT(i_15)) THEN; cvr_d = "I4 5D";
3547	ELSE IF (PRESENT(r_40)) THEN; cvr_d = "R4 0D";
3548	ELSE IF (PRESENT(r_41)) THEN; cvr_d = "R4 1D";
3549	ELSE IF (PRESENT(r_42)) THEN; cvr_d = "R4 2D";
3550	ELSE IF (PRESENT(r_43)) THEN; cvr_d = "R4 3D";
3551	ELSE IF (PRESENT(r_44)) THEN; cvr_d = "R4 4D";
3552	ELSE IF (PRESENT(r_45)) THEN; cvr_d = "R4 5D";
3553	ELSE IF (PRESENT(r_80)) THEN; cvr_d = "R8 0D";
3554	ELSE IF (PRESENT(r_81)) THEN; cvr_d = "R8 1D";
3555	ELSE IF (PRESENT(r_82)) THEN; cvr_d = "R8 2D";
3556	ELSE IF (PRESENT(r_83)) THEN; cvr_d = "R8 3D";
3557	ELSE IF (PRESENT(r_84)) THEN; cvr_d = "R8 4D";
3558	ELSE IF (PRESENT(r_85)) THEN; cvr_d = "R8 5D";
3559	ENDIF
3560	WRITE(,) "->fliogetv ",TRIM(v_n)," ",TRIM(cvr_d)
3561	ENDIF
3562	!-
3563	! Retrieve the external file index
3564	CALL flio_qvid ('fliogetv',f_i,f_e)
3565	!-
3566	! Ensuring data mode
3567	!-
3568	CALL flio_hdm (f_i,f_e,.FALSE.)
3569	!-
3570	i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
3571	IF (i_rc == NF90_NOERR) THEN
3572	IF (PRESENT(i_40)) THEN
3573	i_rc = NF90_GET_VAR(f_e,i_v,i_40,start=start)
3574	ELSE IF (PRESENT(i_41)) THEN
3575	i_rc = NF90_GET_VAR(f_e,i_v,i_41,start=start,count=count)
3576	ELSE IF (PRESENT(i_42)) THEN
3577	i_rc = NF90_GET_VAR(f_e,i_v,i_42,start=start,count=count)
3578	ELSE IF (PRESENT(i_43)) THEN
3579	i_rc = NF90_GET_VAR(f_e,i_v,i_43,start=start,count=count)
3580	ELSE IF (PRESENT(i_44)) THEN
3581	i_rc = NF90_GET_VAR(f_e,i_v,i_44,start=start,count=count)
3582	ELSE IF (PRESENT(i_45)) THEN
3583	i_rc = NF90_GET_VAR(f_e,i_v,i_45,start=start,count=count)
3584	ELSE IF (PRESENT(i_20)) THEN
3585	i_rc = NF90_GET_VAR(f_e,i_v,i_20,start=start)
3586	ELSE IF (PRESENT(i_21)) THEN
3587	i_rc = NF90_GET_VAR(f_e,i_v,i_21,start=start,count=count)
3588	ELSE IF (PRESENT(i_22)) THEN
3589	i_rc = NF90_GET_VAR(f_e,i_v,i_22,start=start,count=count)
3590	ELSE IF (PRESENT(i_23)) THEN
3591	i_rc = NF90_GET_VAR(f_e,i_v,i_23,start=start,count=count)
3592	ELSE IF (PRESENT(i_24)) THEN
3593	i_rc = NF90_GET_VAR(f_e,i_v,i_24,start=start,count=count)
3594	ELSE IF (PRESENT(i_25)) THEN
3595	i_rc = NF90_GET_VAR(f_e,i_v,i_25,start=start,count=count)
3596	!? ELSE IF (PRESENT(i_10)) THEN
3597	!? i_rc = NF90_GET_VAR(f_e,i_v,i_10,start=start)
3598	!? ELSE IF (PRESENT(i_11)) THEN
3599	!? i_rc = NF90_GET_VAR(f_e,i_v,i_11,start=start,count=count)
3600	!? ELSE IF (PRESENT(i_12)) THEN
3601	!? i_rc = NF90_GET_VAR(f_e,i_v,i_12,start=start,count=count)
3602	!? ELSE IF (PRESENT(i_13)) THEN
3603	!? i_rc = NF90_GET_VAR(f_e,i_v,i_13,start=start,count=count)
3604	!? ELSE IF (PRESENT(i_14)) THEN
3605	!? i_rc = NF90_GET_VAR(f_e,i_v,i_14,start=start,count=count)
3606	!? ELSE IF (PRESENT(i_15)) THEN
3607	!? i_rc = NF90_GET_VAR(f_e,i_v,i_15,start=start,count=count)
3608	ELSE IF (PRESENT(r_40)) THEN
3609	i_rc = NF90_GET_VAR(f_e,i_v,r_40,start=start)
3610	ELSE IF (PRESENT(r_41)) THEN
3611	i_rc = NF90_GET_VAR(f_e,i_v,r_41,start=start,count=count)
3612	ELSE IF (PRESENT(r_42)) THEN
3613	i_rc = NF90_GET_VAR(f_e,i_v,r_42,start=start,count=count)
3614	ELSE IF (PRESENT(r_43)) THEN
3615	i_rc = NF90_GET_VAR(f_e,i_v,r_43,start=start,count=count)
3616	ELSE IF (PRESENT(r_44)) THEN
3617	i_rc = NF90_GET_VAR(f_e,i_v,r_44,start=start,count=count)
3618	ELSE IF (PRESENT(r_45)) THEN
3619	i_rc = NF90_GET_VAR(f_e,i_v,r_45,start=start,count=count)
3620	ELSE IF (PRESENT(r_80)) THEN
3621	i_rc = NF90_GET_VAR(f_e,i_v,r_80,start=start)
3622	ELSE IF (PRESENT(r_81)) THEN
3623	i_rc = NF90_GET_VAR(f_e,i_v,r_81,start=start,count=count)
3624	ELSE IF (PRESENT(r_82)) THEN
3625	i_rc = NF90_GET_VAR(f_e,i_v,r_82,start=start,count=count)
3626	ELSE IF (PRESENT(r_83)) THEN
3627	i_rc = NF90_GET_VAR(f_e,i_v,r_83,start=start,count=count)
3628	ELSE IF (PRESENT(r_84)) THEN
3629	i_rc = NF90_GET_VAR(f_e,i_v,r_84,start=start,count=count)
3630	ELSE IF (PRESENT(r_85)) THEN
3631	i_rc = NF90_GET_VAR(f_e,i_v,r_85,start=start,count=count)
3632	ENDIF
3633	IF (i_rc /= NF90_NOERR) THEN
3634	CALL ipslerr (3,'fliogetv', &
3635	& 'Variable '//TRIM(v_n)//' not get','Error :', &
3636	& TRIM(NF90_STRERROR(i_rc)))
3637	ENDIF
3638	ELSE
3639	CALL ipslerr (3,'fliogetv','Variable',TRIM(v_n),'not found')
3640	ENDIF
3641	!-
3642	IF (l_dbg) THEN
3643	WRITE(,) "<-fliogetv"
3644	ENDIF
3645	!----------------------
3646	END SUBROUTINE flio_ugv
3647	!===
3648	SUBROUTINE flioinqa (f_i,v_n,a_n,l_ex,a_t,a_l)
3649	!---------------------------------------------------------------------
3650	IMPLICIT NONE
3651	!-
3652	INTEGER,INTENT(IN) :: f_i
3653	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3654	LOGICAL,INTENT(OUT) :: l_ex
3655	INTEGER,OPTIONAL,INTENT(OUT) :: a_t,a_l
3656	!-
3657	INTEGER :: i_rc,f_e,i_v,t_ea,l_ea
3658	!-
3659	LOGICAL :: l_dbg
3660	!---------------------------------------------------------------------
3661	CALL ipsldbg (old_status=l_dbg)
3662	!-
3663	IF (l_dbg) THEN
3664	WRITE(,) "->flioinqa ",TRIM(v_n),"-",TRIM(a_n)
3665	ENDIF
3666	!-
3667	! Retrieve the external file index
3668	CALL flio_qvid ('flioinqa',f_i,f_e)
3669	!-
3670	IF (TRIM(v_n) == '?') THEN
3671	i_v = NF90_GLOBAL
3672	ELSE
3673	i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
3674	IF (i_rc /= NF90_NOERR) THEN
3675	CALL ipslerr (3,'flioinqa', &
3676	'Variable :',TRIM(v_n),'not found')
3677	ENDIF
3678	ENDIF
3679	!-
3680	i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,xtype=t_ea,len=l_ea)
3681	!-
3682	l_ex = (i_rc == NF90_NOERR)
3683	!-
3684	IF (l_ex) THEN
3685	IF (PRESENT(a_t)) THEN
3686	a_t = t_ea
3687	ENDIF
3688	IF (PRESENT(a_l)) THEN
3689	a_l = l_ea
3690	ENDIF
3691	ENDIF
3692	!-
3693	IF (l_dbg) THEN
3694	WRITE(,) "<-flioinqa"
3695	ENDIF
3696	!----------------------
3697	END SUBROUTINE flioinqa
3698	!===
3699	SUBROUTINE flioga_r4_0d (f_i,v_n,a_n,a_v)
3700	!---------------------------------------------------------------------
3701	IMPLICIT NONE
3702	!-
3703	INTEGER,INTENT(IN) :: f_i
3704	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3705	REAL(KIND=4),INTENT(OUT) :: a_v
3706	!---------------------------------------------------------------------
3707	CALL flio_uga (f_i,v_n,a_n,avr_4_0=a_v)
3708	!---------------------------
3709	END SUBROUTINE flioga_r4_0d
3710	!===
3711	SUBROUTINE flioga_r4_1d (f_i,v_n,a_n,a_v)
3712	!---------------------------------------------------------------------
3713	IMPLICIT NONE
3714	!-
3715	INTEGER,INTENT(IN) :: f_i
3716	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3717	REAL(KIND=4),DIMENSION(:),INTENT(OUT) :: a_v
3718	!---------------------------------------------------------------------
3719	CALL flio_uga (f_i,v_n,a_n,avr_4_1=a_v)
3720	!--------------------------
3721	END SUBROUTINE flioga_r4_1d
3722	!===
3723	SUBROUTINE flioga_r8_0d (f_i,v_n,a_n,a_v)
3724	!---------------------------------------------------------------------
3725	IMPLICIT NONE
3726	!-
3727	INTEGER,INTENT(IN) :: f_i
3728	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3729	REAL(KIND=8),INTENT(OUT) :: a_v
3730	!---------------------------------------------------------------------
3731	CALL flio_uga (f_i,v_n,a_n,avr_8_0=a_v)
3732	!---------------------------
3733	END SUBROUTINE flioga_r8_0d
3734	!===
3735	SUBROUTINE flioga_r8_1d (f_i,v_n,a_n,a_v)
3736	!---------------------------------------------------------------------
3737	IMPLICIT NONE
3738	!-
3739	INTEGER,INTENT(IN) :: f_i
3740	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3741	REAL(KIND=8),DIMENSION(:),INTENT(OUT) :: a_v
3742	!---------------------------------------------------------------------
3743	CALL flio_uga (f_i,v_n,a_n,avr_8_1=a_v)
3744	!--------------------------
3745	END SUBROUTINE flioga_r8_1d
3746	!===
3747	SUBROUTINE flioga_i4_0d (f_i,v_n,a_n,a_v)
3748	!---------------------------------------------------------------------
3749	IMPLICIT NONE
3750	!-
3751	INTEGER,INTENT(IN) :: f_i
3752	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3753	INTEGER(KIND=4),INTENT(OUT) :: a_v
3754	!---------------------------------------------------------------------
3755	CALL flio_uga (f_i,v_n,a_n,avi_4_0=a_v)
3756	!---------------------------
3757	END SUBROUTINE flioga_i4_0d
3758	!===
3759	SUBROUTINE flioga_i4_1d (f_i,v_n,a_n,a_v)
3760	!---------------------------------------------------------------------
3761	IMPLICIT NONE
3762	!-
3763	INTEGER,INTENT(IN) :: f_i
3764	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3765	INTEGER(KIND=4),DIMENSION(:),INTENT(OUT) :: a_v
3766	!---------------------------------------------------------------------
3767	CALL flio_uga (f_i,v_n,a_n,avi_4_1=a_v)
3768	!--------------------------
3769	END SUBROUTINE flioga_i4_1d
3770	!===
3771	SUBROUTINE flioga_tx_0d (f_i,v_n,a_n,a_v)
3772	!---------------------------------------------------------------------
3773	IMPLICIT NONE
3774	!-
3775	INTEGER,INTENT(IN) :: f_i
3776	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3777	CHARACTER(LEN=*),INTENT(OUT) :: a_v
3778	!---------------------------------------------------------------------
3779	CALL flio_uga (f_i,v_n,a_n,avtx=a_v)
3780	!---------------------------
3781	END SUBROUTINE flioga_tx_0d
3782	!===
3783	SUBROUTINE flio_uga &
3784	& (f_i,v_n,a_n, &
3785	& avr_4_0,avr_4_1,avr_8_0,avr_8_1,avi_4_0,avi_4_1,avtx)
3786	!---------------------------------------------------------------------
3787	IMPLICIT NONE
3788	!-
3789	INTEGER,INTENT(IN) :: f_i
3790	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3791	REAL(KIND=4),OPTIONAL,INTENT(OUT) :: avr_4_0
3792	REAL(KIND=4),DIMENSION(:),OPTIONAL,INTENT(OUT) :: avr_4_1
3793	REAL(KIND=8),OPTIONAL,INTENT(OUT) :: avr_8_0
3794	REAL(KIND=8),DIMENSION(:),OPTIONAL,INTENT(OUT) :: avr_8_1
3795	INTEGER(KIND=4),OPTIONAL,INTENT(OUT) :: avi_4_0
3796	INTEGER(KIND=4),DIMENSION(:),OPTIONAL,INTENT(OUT) :: avi_4_1
3797	CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: avtx
3798	!-
3799	INTEGER :: f_e,l_ua,i_v,t_ea,l_ea,i_rc
3800	!-
3801	LOGICAL :: l_dbg
3802	!---------------------------------------------------------------------
3803	CALL ipsldbg (old_status=l_dbg)
3804	!-
3805	IF (l_dbg) THEN
3806	WRITE(,) "->fliogeta ",TRIM(v_n)," ",TRIM(a_n)
3807	ENDIF
3808	!-
3809	! Retrieve the external file index
3810	CALL flio_qvid ('fliogeta',f_i,f_e)
3811	!-
3812	IF (TRIM(v_n) == '?') THEN
3813	i_v = NF90_GLOBAL
3814	ELSE
3815	i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
3816	IF (i_rc /= NF90_NOERR) THEN
3817	CALL ipslerr (3,'fliogeta', &
3818	'Variable :',TRIM(v_n),'not found')
3819	ENDIF
3820	ENDIF
3821	!-
3822	i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,xtype=t_ea,len=l_ea)
3823	IF (i_rc /= NF90_NOERR) THEN
3824	CALL ipslerr (3,'fliogeta', &
3825	& 'Attribute :',TRIM(a_n),'not found')
3826	ENDIF
3827	!-
3828	IF ( (.NOT.PRESENT(avtx).AND.(t_ea == NF90_CHAR)) &
3829	& .OR.(PRESENT(avtx).AND.(t_ea /= NF90_CHAR)) ) THEN
3830	CALL ipslerr (3,'fliogeta', &
3831	& 'The external type of the attribute :',TRIM(a_n), &
3832	& 'is not compatible with the type of the argument')
3833	ENDIF
3834	!-
3835	IF (PRESENT(avr_4_1)) THEN
3836	l_ua = SIZE(avr_4_1)
3837	ELSE IF (PRESENT(avr_8_1)) THEN
3838	l_ua = SIZE(avr_8_1)
3839	ELSE IF (PRESENT(avi_4_1)) THEN
3840	l_ua = SIZE(avi_4_1)
3841	ELSE IF (PRESENT(avtx)) THEN
3842	l_ua = LEN(avtx)
3843	ELSE
3844	l_ua = 1
3845	ENDIF
3846	!-
3847	IF (l_ua < l_ea) THEN
3848	CALL ipslerr (3,'fliogeta', &
3849	'Insufficient size of the argument', &
3850	& 'to receive the values of the attribute :',TRIM(a_n))
3851	ENDIF
3852	!-
3853	IF (PRESENT(avr_4_0)) THEN
3854	i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_4_0)
3855	ELSE IF (PRESENT(avr_4_1)) THEN
3856	i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_4_1(1:l_ea))
3857	ELSE IF (PRESENT(avr_8_0)) THEN
3858	i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_8_0)
3859	ELSE IF (PRESENT(avr_8_1)) THEN
3860	i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_8_1(1:l_ea))
3861	ELSE IF (PRESENT(avi_4_0)) THEN
3862	i_rc = NF90_GET_ATT(f_e,i_v,a_n,avi_4_0)
3863	ELSE IF (PRESENT(avi_4_1)) THEN
3864	i_rc = NF90_GET_ATT(f_e,i_v,a_n,avi_4_1(1:l_ea))
3865	ELSE IF (PRESENT(avtx)) THEN
3866	i_rc = NF90_GET_ATT(f_e,i_v,a_n,avtx)
3867	ENDIF
3868	!-
3869	IF (l_dbg) THEN
3870	WRITE(,) "<-fliogeta"
3871	ENDIF
3872	!----------------------
3873	END SUBROUTINE flio_uga
3874	!===
3875	SUBROUTINE fliorenv (f_i,v_o_n,v_n_n)
3876	!---------------------------------------------------------------------
3877	IMPLICIT NONE
3878	!-
3879	INTEGER,INTENT(IN) :: f_i
3880	CHARACTER(LEN=*),INTENT(IN) :: v_o_n,v_n_n
3881	!-
3882	INTEGER :: f_e,i_v,i_rc
3883	!-
3884	LOGICAL :: l_dbg
3885	!---------------------------------------------------------------------
3886	CALL ipsldbg (old_status=l_dbg)
3887	!-
3888	IF (l_dbg) THEN
3889	WRITE(,) &
3890	& "->fliorenv ",TRIM(v_o_n),"->",TRIM(v_n_n)
3891	ENDIF
3892	!-
3893	! Retrieve the external file index
3894	CALL flio_qvid ('fliorenv',f_i,f_e)
3895	!-
3896	i_rc = NF90_INQ_VARID(f_e,v_o_n,i_v)
3897	IF (i_rc /= NF90_NOERR) THEN
3898	CALL ipslerr (2,'fliorenv', &
3899	'Variable :',TRIM(v_o_n),'not found')
3900	ELSE
3901	CALL flio_hdm (f_i,f_e,.TRUE.)
3902	i_rc = NF90_RENAME_VAR(f_e,i_v,v_n_n)
3903	IF (i_rc /= NF90_NOERR) THEN
3904	CALL ipslerr (2,'fliorenv', &
3905	'Variable :',TRIM(v_o_n),'can not be renamed')
3906	ENDIF
3907	ENDIF
3908	!-
3909	IF (l_dbg) THEN
3910	WRITE(,) "<-fliorenv"
3911	ENDIF
3912	!----------------------
3913	END SUBROUTINE fliorenv
3914	!===
3915	SUBROUTINE fliorena (f_i,v_n,a_o_n,a_n_n)
3916	!---------------------------------------------------------------------
3917	IMPLICIT NONE
3918	!-
3919	INTEGER,INTENT(IN) :: f_i
3920	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_o_n,a_n_n
3921	!-
3922	INTEGER :: f_e,i_v,i_a,i_rc
3923	!-
3924	LOGICAL :: l_dbg
3925	!---------------------------------------------------------------------
3926	CALL ipsldbg (old_status=l_dbg)
3927	!-
3928	IF (l_dbg) THEN
3929	WRITE(,) &
3930	& "->fliorena ",TRIM(v_n),"-",TRIM(a_o_n),"->",TRIM(a_n_n)
3931	ENDIF
3932	!-
3933	! Retrieve the external file index
3934	CALL flio_qvid ('fliorena',f_i,f_e)
3935	!-
3936	IF (TRIM(v_n) == '?') THEN
3937	i_v = NF90_GLOBAL
3938	ELSE
3939	i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
3940	IF (i_rc /= NF90_NOERR) THEN
3941	CALL ipslerr (3,'fliorena', &
3942	'Variable :',TRIM(v_n),'not found')
3943	ENDIF
3944	ENDIF
3945	!-
3946	i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_o_n,attnum=i_a)
3947	IF (i_rc /= NF90_NOERR) THEN
3948	CALL ipslerr (2,'fliorena', &
3949	'Attribute :',TRIM(a_o_n),'not found')
3950	ELSE
3951	CALL flio_hdm (f_i,f_e,.TRUE.)
3952	i_rc = NF90_RENAME_ATT(f_e,i_v,a_o_n,a_n_n)
3953	IF (i_rc /= NF90_NOERR) THEN
3954	CALL ipslerr (2,'fliorena', &
3955	'Attribute :',TRIM(a_o_n),'can not be renamed')
3956	ENDIF
3957	ENDIF
3958	!-
3959	IF (l_dbg) THEN
3960	WRITE(,) "<-fliorena"
3961	ENDIF
3962	!----------------------
3963	END SUBROUTINE fliorena
3964	!===
3965	SUBROUTINE fliodela (f_i,v_n,a_n)
3966	!---------------------------------------------------------------------
3967	IMPLICIT NONE
3968	!-
3969	INTEGER,INTENT(IN) :: f_i
3970	CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
3971	!-
3972	INTEGER :: f_e,i_v,i_a,i_rc
3973	!-
3974	LOGICAL :: l_dbg
3975	!---------------------------------------------------------------------
3976	CALL ipsldbg (old_status=l_dbg)
3977	!-
3978	IF (l_dbg) THEN
3979	WRITE(,) "->fliodela ",TRIM(v_n),"-",TRIM(a_n)
3980	ENDIF
3981	!-
3982	! Retrieve the external file index
3983	CALL flio_qvid ('fliodela',f_i,f_e)
3984	!-
3985	IF (TRIM(v_n) == '?') THEN
3986	i_v = NF90_GLOBAL
3987	ELSE
3988	i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
3989	IF (i_rc /= NF90_NOERR) THEN
3990	CALL ipslerr (3,'fliodela', &
3991	& 'Variable :',TRIM(v_n),'not found')
3992	ENDIF
3993	ENDIF
3994	!-
3995	i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,attnum=i_a)
3996	IF (i_rc /= NF90_NOERR) THEN
3997	CALL ipslerr (2,'fliodela', &
3998	& 'Attribute :',TRIM(a_n),'not found')
3999	ELSE
4000	IF (i_v == NF90_GLOBAL) THEN
4001	nw_na(f_i) = nw_na(f_i)-1
4002	ENDIF
4003	CALL flio_hdm (f_i,f_e,.TRUE.)
4004	i_rc = NF90_DEL_ATT(f_e,i_v,a_n)
4005	ENDIF
4006	!-
4007	IF (l_dbg) THEN
4008	WRITE(,) "<-fliodela"
4009	ENDIF
4010	!----------------------
4011	END SUBROUTINE fliodela
4012	!===
4013	SUBROUTINE fliocpya (f_i_i,v_n_i,a_n,f_i_o,v_n_o)
4014	!---------------------------------------------------------------------
4015	IMPLICIT NONE
4016	!-
4017	INTEGER,INTENT(IN) :: f_i_i,f_i_o
4018	CHARACTER(LEN=*),INTENT(IN) :: v_n_i,a_n,v_n_o
4019	!-
4020	INTEGER :: f_e_i,f_e_o,i_v_i,i_v_o,i_a,i_rc
4021	!-
4022	LOGICAL :: l_dbg
4023	!---------------------------------------------------------------------
4024	CALL ipsldbg (old_status=l_dbg)
4025	!-
4026	IF (l_dbg) THEN
4027	WRITE(,) "->fliocpya - file",f_i_i,"-",TRIM(v_n_i),"-",TRIM(a_n)
4028	WRITE(,) " copied to file ",f_i_o,"-",TRIM(v_n_o)
4029	ENDIF
4030	!-
4031	! Retrieve the external file index
4032	CALL flio_qvid ('fliocpya',f_i_i,f_e_i)
4033	CALL flio_qvid ('fliocpya',f_i_o,f_e_o)
4034	!-
4035	IF (TRIM(v_n_i) == '?') THEN
4036	i_v_i = NF90_GLOBAL
4037	ELSE
4038	i_rc = NF90_INQ_VARID(f_e_i,v_n_i,i_v_i)
4039	IF (i_rc /= NF90_NOERR) THEN
4040	CALL ipslerr (3,'fliocpya', &
4041	& 'Variable :',TRIM(v_n_i),'not found')
4042	ENDIF
4043	ENDIF
4044	!-
4045	IF (TRIM(v_n_o) == '?') THEN
4046	i_v_o = NF90_GLOBAL
4047	ELSE
4048	i_rc = NF90_INQ_VARID(f_e_o,v_n_o,i_v_o)
4049	IF (i_rc /= NF90_NOERR) THEN
4050	CALL ipslerr (3,'fliocpya', &
4051	& 'Variable :',TRIM(v_n_o),'not found')
4052	ENDIF
4053	ENDIF
4054	!-
4055	i_rc = NF90_INQUIRE_ATTRIBUTE(f_e_i,i_v_i,a_n,attnum=i_a)
4056	IF (i_rc /= NF90_NOERR) THEN
4057	CALL ipslerr (3,'fliocpya', &
4058	'Attribute :',TRIM(a_n),'not found')
4059	ELSE
4060	i_rc = NF90_INQUIRE_ATTRIBUTE(f_e_o,i_v_o,a_n,attnum=i_a)
4061	IF ( (i_v_o == NF90_GLOBAL).AND.(i_rc /= NF90_NOERR) ) THEN
4062	nw_na(f_i_o) = nw_na(f_i_o)+1
4063	ENDIF
4064	CALL flio_hdm (f_i_o,f_e_o,.TRUE.)
4065	i_rc = NF90_COPY_ATT(f_e_i,i_v_i,a_n,f_e_o,i_v_o)
4066	IF (i_rc /= NF90_NOERR) THEN
4067	CALL ipslerr (3,'fliocpya', &
4068	& 'Attribute '//TRIM(a_n)//' not copied','Error :', &
4069	& TRIM(NF90_STRERROR(i_rc)))
4070	ENDIF
4071	ENDIF
4072	!-
4073	IF (l_dbg) THEN
4074	WRITE(,) "<-fliocpya"
4075	ENDIF
4076	!----------------------
4077	END SUBROUTINE fliocpya
4078	!===
4079	SUBROUTINE flioqstc (f_i,c_type,l_ex,c_name)
4080	!---------------------------------------------------------------------
4081	IMPLICIT NONE
4082	!-
4083	INTEGER,INTENT(IN) :: f_i
4084	CHARACTER(LEN=*),INTENT(IN) :: c_type
4085	LOGICAL,INTENT(OUT) :: l_ex
4086	CHARACTER(LEN=*),INTENT(OUT) :: c_name
4087	!-
4088	CHARACTER(LEN=1) :: c_ax
4089	INTEGER :: f_e,idc,ndc,i_rc
4090	!-
4091	LOGICAL :: l_dbg
4092	!---------------------------------------------------------------------
4093	CALL ipsldbg (old_status=l_dbg)
4094	!-
4095	IF (l_dbg) THEN
4096	WRITE(,) "->flioqstc ",TRIM(c_type)
4097	ENDIF
4098	!-
4099	! Retrieve the external file index
4100	CALL flio_qvid ('flioqstc',f_i,f_e)
4101	!-
4102	c_ax = TRIM(c_type)
4103	IF ( (LEN_TRIM(c_type) == 1) &
4104	& .AND.( (c_ax == 'x').OR.(c_ax == 'y') &
4105	& .OR.(c_ax == 'z').OR.(c_ax == 't')) ) THEN
4106	CALL flio_qax (f_i,c_ax,idc,ndc)
4107	l_ex = (idc > 0)
4108	IF (l_ex) THEN
4109	i_rc = NF90_INQUIRE_VARIABLE(f_e,idc,name=c_name)
4110	ENDIF
4111	ELSE
4112	l_ex = .FALSE.
4113	CALL ipslerr (2,'flioqstc', &
4114	& 'The name of the coordinate,',TRIM(c_type),'is not valid')
4115	ENDIF
4116	!-
4117	IF (l_dbg) THEN
4118	WRITE(,) "<-flioqstc"
4119	ENDIF
4120	!----------------------
4121	END SUBROUTINE flioqstc
4122	!===
4123	SUBROUTINE fliosync (f_i)
4124	!---------------------------------------------------------------------
4125	INTEGER,INTENT(in),OPTIONAL :: f_i
4126	!-
4127	INTEGER :: i_f,f_e,i_rc,i_s,i_e
4128	!-
4129	LOGICAL :: l_dbg
4130	!---------------------------------------------------------------------
4131	CALL ipsldbg (old_status=l_dbg)
4132	!-
4133	IF (l_dbg) THEN
4134	WRITE(,) "->fliosync"
4135	ENDIF
4136	!-
4137	IF (PRESENT(f_i)) THEN
4138	IF ( (f_i >= 1).AND.(f_i <= nb_fi_mx) ) THEN
4139	i_s = f_i
4140	i_e = f_i
4141	ELSE
4142	i_s = 1
4143	i_e = 0
4144	CALL ipslerr (2,'fliosync', &
4145	& 'Invalid file identifier',' ',' ')
4146	ENDIF
4147	ELSE
4148	i_s = 1
4149	i_e = nb_fi_mx
4150	ENDIF
4151	!-
4152	! Ensuring data mode
4153	!-
4154	CALL flio_hdm (f_i,f_e,.FALSE.)
4155	!-
4156	DO i_f=i_s,i_e
4157	f_e = nw_id(i_f)
4158	IF (f_e > 0) THEN
4159	IF (l_dbg) THEN
4160	WRITE(,) ' fliosync - synchronising file number ',i_f
4161	ENDIF
4162	i_rc = NF90_SYNC(f_e)
4163	ELSE IF (PRESENT(f_i)) THEN
4164	CALL ipslerr (2,'fliosync', &
4165	& 'Unable to synchronise the file :','probably','not opened')
4166	ENDIF
4167	ENDDO
4168	!-
4169	IF (l_dbg) THEN
4170	WRITE(,) "<-fliosync"
4171	ENDIF
4172	!----------------------
4173	END SUBROUTINE fliosync
4174	!===
4175	SUBROUTINE flioclo (f_i)
4176	!---------------------------------------------------------------------
4177	INTEGER,INTENT(in),OPTIONAL :: f_i
4178	!-
4179	INTEGER :: i_f,f_e,i_rc,i_s,i_e
4180	!-
4181	LOGICAL :: l_dbg
4182	!---------------------------------------------------------------------
4183	CALL ipsldbg (old_status=l_dbg)
4184	!-
4185	IF (l_dbg) THEN
4186	WRITE(,) "->flioclo"
4187	ENDIF
4188	!-
4189	IF (PRESENT(f_i)) THEN
4190	IF ( (f_i >= 1).AND.(f_i <= nb_fi_mx) ) THEN
4191	i_s = f_i
4192	i_e = f_i
4193	ELSE
4194	i_s = 1
4195	i_e = 0
4196	CALL ipslerr (2,'flioclo', &
4197	& 'Invalid file identifier',' ',' ')
4198	ENDIF
4199	ELSE
4200	i_s = 1
4201	i_e = nb_fi_mx
4202	ENDIF
4203	!-
4204	DO i_f=i_s,i_e
4205	f_e = nw_id(i_f)
4206	IF (f_e > 0) THEN
4207	IF (l_dbg) THEN
4208	WRITE(,) ' flioclo - closing file number ',i_f
4209	ENDIF
4210	i_rc = NF90_CLOSE(f_e)
4211	nw_id(i_f) = -1
4212	ELSE IF (PRESENT(f_i)) THEN
4213	CALL ipslerr (2,'flioclo', &
4214	& 'Unable to close the file :','probably','not opened')
4215	ENDIF
4216	ENDDO
4217	!-
4218	IF (l_dbg) THEN
4219	WRITE(,) "<-flioclo"
4220	ENDIF
4221	!---------------------
4222	END SUBROUTINE flioclo
4223	!===
4224	SUBROUTINE fliodmpf (f_n)
4225	!---------------------------------------------------------------------
4226	IMPLICIT NONE
4227	!-
4228	CHARACTER(LEN=*),INTENT(IN) :: f_n
4229	!-
4230	INTEGER :: f_e,n_dims,n_vars,n_atts,i_unlm
4231	INTEGER :: i_rc,i_n,k_n,t_ea,l_ea
4232	INTEGER :: tmp_i
4233	REAL :: tmp_r
4234	INTEGER,DIMENSION(:),ALLOCATABLE :: tma_i
4235	REAL,DIMENSION(:),ALLOCATABLE :: tma_r
4236	CHARACTER(LEN=256) :: tmp_c
4237	INTEGER,DIMENSION(nb_fd_mx) :: n_idim,n_ldim
4238	INTEGER,DIMENSION(nb_ax_mx) :: n_ai
4239	CHARACTER(LEN=NF90_MAX_NAME),DIMENSION(nb_fd_mx) :: c_ndim
4240	INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid
4241	CHARACTER(LEN=NF90_MAX_NAME) :: c_name
4242	!---------------------------------------------------------------------
4243	i_rc = NF90_OPEN(TRIM(f_n),NF90_NOWRITE,f_e)
4244	IF (i_rc /= NF90_NOERR) THEN
4245	CALL ipslerr (3,'fliodmpf', &
4246	& 'Could not open file :',TRIM(f_n),' ')
4247	ENDIF
4248	!-
4249	WRITE (,) "---"
4250	WRITE (,) "--- File '",TRIM(f_n),"'"
4251	WRITE (,) "---"
4252	!-
4253	CALL flio_inf &
4254	& (f_e,nb_dims=n_dims,nb_vars=n_vars, &
4255	& nb_atts=n_atts,id_unlm=i_unlm, &
4256	& nn_idm=n_idim,nn_ldm=n_ldim,cc_ndm=c_ndim,nn_aid=n_ai)
4257	!-
4258	WRITE (,) 'External model identifier : ',f_e
4259	WRITE (,) 'Number of dimensions : ',n_dims
4260	WRITE (,) 'Number of variables : ',n_vars
4261	WRITE (,) 'ID unlimited : ',i_unlm
4262	!-
4263	WRITE (,) "---"
4264	WRITE (,) 'Presumed axis dimensions identifiers :'
4265	IF (n_ai(k_lon) > 0) THEN
4266	WRITE (,) 'x axis : ',n_ai(k_lon)
4267	ELSE
4268	WRITE (,) 'x axis : NONE'
4269	ENDIF
4270	IF (n_ai(k_lat) > 0) THEN
4271	WRITE (,) 'y axis : ',n_ai(k_lat)
4272	ELSE
4273	WRITE (,) 'y axis : NONE'
4274	ENDIF
4275	IF (n_ai(k_lev) > 0) THEN
4276	WRITE (,) 'z axis : ',n_ai(k_lev)
4277	ELSE
4278	WRITE (,) 'z axis : NONE'
4279	ENDIF
4280	IF (n_ai(k_tim) > 0) THEN
4281	WRITE (,) 't axis : ',n_ai(k_tim)
4282	ELSE
4283	WRITE (,) 't axis : NONE'
4284	ENDIF
4285	!-
4286	WRITE (,) "---"
4287	WRITE (,) 'Number of global attributes : ',n_atts
4288	DO k_n=1,n_atts
4289	i_rc = NF90_INQ_ATTNAME(f_e,NF90_GLOBAL,k_n,c_name)
4290	i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,NF90_GLOBAL,c_name, &
4291	& xtype=t_ea,len=l_ea)
4292	IF ( (t_ea == NF90_INT4).OR.(t_ea == NF90_INT2) &
4293	.OR.(t_ea == NF90_INT1) ) THEN
4294	IF (l_ea > 1) THEN
4295	ALLOCATE(tma_i(l_ea))
4296	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_i)
4297	WRITE (*,'(" ",A," :",/,(5(1X,I10),:))') &
4298	& TRIM(c_name),tma_i(1:l_ea)
4299	DEALLOCATE(tma_i)
4300	ELSE
4301	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_i)
4302	WRITE(,) ' ',TRIM(c_name),' : ',tmp_i
4303	ENDIF
4304	ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
4305	IF (l_ea > 1) THEN
4306	ALLOCATE(tma_r(l_ea))
4307	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_r)
4308	WRITE (*,'(" ",A," :",/,(5(1X,1PE11.3),:))') &
4309	& TRIM(c_name),tma_r(1:l_ea)
4310	DEALLOCATE(tma_r)
4311	ELSE
4312	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_r)
4313	WRITE(,) ' ',TRIM(c_name),' : ',tmp_r
4314	ENDIF
4315	ELSE
4316	tmp_c = ''
4317	i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_c)
4318	WRITE(,) ' ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
4319	ENDIF
4320	ENDDO
4321	!-
4322	DO i_n=1,nb_fd_mx
4323	IF (n_idim(i_n) > 0) THEN
4324	WRITE (,) "---"
4325	WRITE (,) 'Dimension id : ',n_idim(i_n)
4326	WRITE (,) 'Dimension name : ',TRIM(c_ndim(i_n))
4327	WRITE (,) 'Dimension size : ',n_ldim(i_n)
4328	ENDIF
4329	ENDDO
4330	!-
4331	DO i_n=1,n_vars
4332	i_rc = NF90_INQUIRE_VARIABLE(f_e,i_n, &
4333	& name=c_name,ndims=n_dims,dimids=idimid,nAtts=n_atts)
4334	WRITE (,) "---"
4335	WRITE (,) "Variable name : ",TRIM(c_name)
4336	WRITE (,) "Variable identifier : ",i_n
4337	WRITE (,) "Number of dimensions : ",n_dims
4338	IF (n_dims > 0) THEN
4339	WRITE (,) "Dimensions ID's : ",idimid(1:n_dims)
4340	ENDIF
4341	WRITE (,) "Number of attributes : ",n_atts
4342	DO k_n=1,n_atts
4343	i_rc = NF90_INQ_ATTNAME(f_e,i_n,k_n,c_name)
4344	i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_n,c_name, &
4345	& xtype=t_ea,len=l_ea)
4346	IF ( (t_ea == NF90_INT4).OR.(t_ea == NF90_INT2) &
4347	& .OR.(t_ea == NF90_INT1) ) THEN
4348	IF (l_ea > 1) THEN
4349	ALLOCATE(tma_i(l_ea))
4350	i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_i)
4351	WRITE (*,'(" ",A," :",/,(5(1X,I10),:))') &
4352	& TRIM(c_name),tma_i(1:l_ea)
4353	DEALLOCATE(tma_i)
4354	ELSE
4355	i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_i)
4356	WRITE(,) ' ',TRIM(c_name),' : ',tmp_i
4357	ENDIF
4358	ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
4359	IF (l_ea > 1) THEN
4360	ALLOCATE(tma_r(l_ea))
4361	i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_r)
4362	WRITE (*,'(" ",A," :",/,(5(1X,1PE11.3),:))') &
4363	& TRIM(c_name),tma_r(1:l_ea)
4364	DEALLOCATE(tma_r)
4365	ELSE
4366	i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_r)
4367	WRITE(,) ' ',TRIM(c_name),' : ',tmp_r
4368	ENDIF
4369	ELSE
4370	tmp_c = ''
4371	i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_c)
4372	WRITE(,) ' ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
4373	ENDIF
4374	ENDDO
4375	ENDDO
4376	WRITE (,) "---"
4377	!-
4378	i_rc = NF90_CLOSE(f_e)
4379	!----------------------
4380	END SUBROUTINE fliodmpf
4381	!===
4382	SUBROUTINE flio_dom_set &
4383	& (dtnb,dnb,did,dsg,dsl,dpf,dpl,dhs,dhe,cdnm,id_dom)
4384	!---------------------------------------------------------------------
4385	IMPLICIT NONE
4386	!-
4387	INTEGER,INTENT(IN) :: dtnb,dnb
4388	INTEGER,DIMENSION(:),INTENT(IN) :: did,dsg,dsl,dpf,dpl,dhs,dhe
4389	CHARACTER(LEN=*),INTENT(IN) :: cdnm
4390	INTEGER,INTENT(OUT) :: id_dom
4391	!-
4392	INTEGER :: k_w,i_w,i_s
4393	CHARACTER(LEN=l_dns) :: cd_p,cd_w
4394	!---------------------------------------------------------------------
4395	k_w = flio_dom_rid()
4396	IF (k_w < 0) THEN
4397	CALL ipslerr (3,'flio_dom_set', &
4398	& 'too many domains simultaneously defined', &
4399	& 'please unset useless domains', &
4400	& 'by calling flio_dom_unset')
4401	ENDIF
4402	id_dom = k_w
4403	!-
4404	d_n_t(k_w) = dtnb
4405	d_n_c(k_w) = dnb
4406	!-
4407	i_s = SIZE(did)
4408	IF (i_s > dom_max_dims) THEN
4409	CALL ipslerr (3,'flio_dom_set', &
4410	& 'too many distributed dimensions', &
4411	& 'simultaneously defined',' ')
4412	ENDIF
4413	d_d_n(k_w) = i_s
4414	d_d_i(1:i_s,k_w) = did(1:i_s)
4415	!-
4416	i_w = SIZE(dsg)
4417	IF (i_w /= i_s) THEN
4418	CALL ipslerr (3,'flio_dom_set', &
4419	& 'the size of the DOMAIN_size_global array', &
4420	& 'is not equal to the size', &
4421	& 'of the distributed dimensions array')
4422	ENDIF
4423	d_s_g(1:i_w,k_w) = dsg(1:i_w)
4424	!-
4425	i_w = SIZE(dsl)
4426	IF (i_w /= i_s) THEN
4427	CALL ipslerr (3,'flio_dom_set', &
4428	& 'the size of the DOMAIN_size_local array', &
4429	& 'is not equal to the size', &
4430	& 'of the distributed dimensions array')
4431	ENDIF
4432	d_s_l(1:i_w,k_w) = dsl(1:i_w)
4433	!-
4434	i_w = SIZE(dpf)
4435	IF (i_w /= i_s) THEN
4436	CALL ipslerr (3,'flio_dom_set', &
4437	& 'the size of the DOMAIN_position_first array', &
4438	& 'is not equal to the size', &
4439	& 'of the distributed dimensions array')
4440	ENDIF
4441	d_p_f(1:i_w,k_w) = dpf(1:i_w)
4442	!-
4443	i_w = SIZE(dpl)
4444	IF (i_w /= i_s) THEN
4445	CALL ipslerr (3,'flio_dom_set', &
4446	& 'the size of the DOMAIN_position_last array', &
4447	& 'is not equal to the size', &
4448	& 'of the distributed dimensions array')
4449	ENDIF
4450	d_p_l(1:i_w,k_w) = dpl(1:i_w)
4451	!-
4452	i_w = SIZE(dhs)
4453	IF (i_w /= i_s) THEN
4454	CALL ipslerr (3,'flio_dom_set', &
4455	& 'the size of the DOMAIN_halo_size_start array', &
4456	& 'is not equal to the size', &
4457	& 'of the distributed dimensions array')
4458	ENDIF
4459	d_h_s(1:i_w,k_w) = dhs(1:i_w)
4460	!-
4461	i_w = SIZE(dhe)
4462	IF (i_w /= i_s) THEN
4463	CALL ipslerr (3,'flio_dom_set', &
4464	& 'the size of the DOMAIN_halo_size_end array', &
4465	& 'is not equal to the size', &
4466	& 'of the distributed dimensions array')
4467	ENDIF
4468	d_h_e(1:i_w,k_w) = dhe(1:i_w)
4469	!-
4470	cd_p = "unknown"
4471	cd_w = cdnm; CALL strlowercase (cd_w)
4472	DO i_w=1,n_dns
4473	IF (TRIM(cd_w) == TRIM(c_dns(i_w))) THEN
4474	cd_p = cd_w; EXIT;
4475	ENDIF
4476	ENDDO
4477	IF (TRIM(cd_p) == "unknown") THEN
4478	CALL ipslerr (3,'flio_dom_set', &
4479	& 'DOMAIN_type "'//TRIM(cdnm)//'"', &
4480	& 'is actually not supported', &
4481	& 'please use one of the supported names')
4482	ENDIF
4483	c_d_t(k_w) = cd_p
4484	!--------------------------
4485	END SUBROUTINE flio_dom_set
4486	!===
4487	SUBROUTINE flio_dom_unset (id_dom)
4488	!---------------------------------------------------------------------
4489	IMPLICIT NONE
4490	!-
4491	INTEGER,INTENT(IN),OPTIONAL :: id_dom
4492	!-
4493	INTEGER :: i_w
4494	!---------------------------------------------------------------------
4495	IF (PRESENT(id_dom)) THEN
4496	IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
4497	IF (d_d_n(id_dom) > 0) THEN
4498	d_d_n(id_dom) = -1
4499	ELSE
4500	CALL ipslerr (2,'flio_dom_unset', &
4501	& 'The domain is not set',' ',' ')
4502	ENDIF
4503	ELSE
4504	CALL ipslerr (2,'flio_dom_unset', &
4505	& 'Invalid file identifier',' ',' ')
4506	ENDIF
4507	ELSE
4508	DO i_w=1,dom_max_nb
4509	d_d_n(id_dom) = -1
4510	ENDDO
4511	ENDIF
4512	!----------------------------
4513	END SUBROUTINE flio_dom_unset
4514	!===
4515	SUBROUTINE flio_dom_defset (id_dom)
4516	!---------------------------------------------------------------------
4517	IMPLICIT NONE
4518	!-
4519	INTEGER,INTENT(IN) :: id_dom
4520	!---------------------------------------------------------------------
4521	IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
4522	id_def_dom = id_dom
4523	ELSE
4524	CALL ipslerr (3,'flio_dom_defset', &
4525	& 'Invalid domain identifier',' ',' ')
4526	ENDIF
4527	!-----------------------------
4528	END SUBROUTINE flio_dom_defset
4529	!===
4530	SUBROUTINE flio_dom_defunset ()
4531	!---------------------------------------------------------------------
4532	IMPLICIT NONE
4533	!---------------------------------------------------------------------
4534	id_def_dom = FLIO_DOM_NONE
4535	!-------------------------------
4536	END SUBROUTINE flio_dom_defunset
4537	!===
4538	SUBROUTINE flio_dom_definq (id_dom)
4539	!---------------------------------------------------------------------
4540	IMPLICIT NONE
4541	!-
4542	INTEGER,INTENT(OUT) :: id_dom
4543	!---------------------------------------------------------------------
4544	id_dom = id_def_dom
4545	!-----------------------------
4546	END SUBROUTINE flio_dom_definq
4547	!===
4548	!-
4549	!---------------------------------------------------------------------
4550	!- Semi-public procedures
4551	!---------------------------------------------------------------------
4552	!-
4553	!===
4554	SUBROUTINE flio_dom_file (f_n,id_dom)
4555	!---------------------------------------------------------------------
4556	!- Update the model file name to include the ".nc" suffix and
4557	!- the DOMAIN number on which this copy of IOIPSL runs, if needed.
4558	!- This routine is called by IOIPSL and not by user anyway.
4559	!---------------------------------------------------------------------
4560	IMPLICIT NONE
4561	!-
4562	CHARACTER(LEN=*),INTENT(INOUT) :: f_n
4563	INTEGER,OPTIONAL,INTENT(IN) :: id_dom
4564	!-
4565	INTEGER :: il,iw
4566	CHARACTER(LEN=4) :: str
4567	!---------------------------------------------------------------------
4568	!-
4569	! Add the ".nc" suffix if needed
4570	il = LEN_TRIM(f_n)
4571	IF (f_n(il-2:il) /= '.nc') THEN
4572	f_n = f_n(1:il)//'.nc'
4573	ENDIF
4574	!-
4575	! Add the DOMAIN identifier if needed
4576	IF (PRESENT(id_dom)) THEN
4577	IF (id_dom == FLIO_DOM_DEFAULT) THEN
4578	CALL flio_dom_definq (iw)
4579	ELSE
4580	iw = id_dom
4581	ENDIF
4582	IF (iw /= FLIO_DOM_NONE) THEN
4583	IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
4584	IF (d_d_n(iw) > 0) THEN
4585	WRITE(str,'(I4.4)') d_n_c(iw)
4586	il = INDEX(f_n,'.nc')
4587	f_n = f_n(1:il-1)//'_'//str//'.nc'
4588	ELSE
4589	CALL ipslerr (3,'flio_dom_file', &
4590	& 'The domain has not been defined', &
4591	& 'please call flio_dom_set', &
4592	& 'before calling flio_dom_file')
4593	ENDIF
4594	ELSE
4595	CALL ipslerr (3,'flio_dom_file', &
4596	& 'Invalid domain identifier',' ',' ')
4597	ENDIF
4598	ENDIF
4599	ENDIF
4600	!---------------------------
4601	END SUBROUTINE flio_dom_file
4602	!===
4603	SUBROUTINE flio_dom_att (f_e,id_dom)
4604	!---------------------------------------------------------------------
4605	!- Add the DOMAIN attributes to the NETCDF file.
4606	!- This routine is called by IOIPSL and not by user anyway.
4607	!---------------------------------------------------------------------
4608	IMPLICIT NONE
4609	!-
4610	INTEGER,INTENT(in) :: f_e
4611	INTEGER,OPTIONAL,INTENT(IN) :: id_dom
4612	!-
4613	INTEGER :: iw,i_rc
4614	!---------------------------------------------------------------------
4615	IF (PRESENT(id_dom)) THEN
4616	IF (id_dom == FLIO_DOM_DEFAULT) THEN
4617	CALL flio_dom_definq (iw)
4618	ELSE
4619	iw = id_dom
4620	ENDIF
4621	IF (iw /= FLIO_DOM_NONE) THEN
4622	IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
4623	IF (d_d_n(iw) > 0) THEN
4624	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4625	& 'DOMAIN_number_total',d_n_t(iw))
4626	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4627	& 'DOMAIN_number',d_n_c(iw))
4628	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4629	& 'DOMAIN_dimensions_ids',d_d_i(1:d_d_n(iw),iw))
4630	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4631	& 'DOMAIN_size_global',d_s_g(1:d_d_n(iw),iw))
4632	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4633	& 'DOMAIN_size_local',d_s_l(1:d_d_n(iw),iw))
4634	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4635	& 'DOMAIN_position_first',d_p_f(1:d_d_n(iw),iw))
4636	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4637	& 'DOMAIN_position_last',d_p_l(1:d_d_n(iw),iw))
4638	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4639	& 'DOMAIN_halo_size_start',d_h_s(1:d_d_n(iw),iw))
4640	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4641	& 'DOMAIN_halo_size_end',d_h_e(1:d_d_n(iw),iw))
4642	i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4643	& 'DOMAIN_type',TRIM(c_d_t(iw)))
4644	ELSE
4645	CALL ipslerr (3,'flio_dom_att', &
4646	& 'The domain has not been defined', &
4647	& 'please call flio_dom_set', &
4648	& 'before calling flio_dom_att')
4649	ENDIF
4650	ELSE
4651	CALL ipslerr (3,'flio_dom_att', &
4652	& 'Invalid domain identifier',' ',' ')
4653	ENDIF
4654	ENDIF
4655	ENDIF
4656	!--------------------------
4657	END SUBROUTINE flio_dom_att
4658	!===
4659	!-
4660	!---------------------------------------------------------------------
4661	!- Local procedures
4662	!---------------------------------------------------------------------
4663	!-
4664	!===
4665	INTEGER FUNCTION flio_rid()
4666	!---------------------------------------------------------------------
4667	!- returns a free index in nw_id(:)
4668	!---------------------------------------------------------------------
4669	INTEGER,DIMENSION(1:1) :: nfi
4670	!-
4671	IF (ANY(nw_id < 0)) THEN
4672	nfi = MINLOC(nw_id,MASK=nw_id < 0)
4673	flio_rid = nfi(1)
4674	ELSE
4675	flio_rid = -1
4676	ENDIF
4677	!--------------------
4678	END FUNCTION flio_rid
4679	!===
4680	INTEGER FUNCTION flio_dom_rid()
4681	!---------------------------------------------------------------------
4682	!- returns a free index in d_d_n(:)
4683	!---------------------------------------------------------------------
4684	INTEGER,DIMENSION(1:1) :: nd
4685	!---------------------------------------------------------------------
4686	IF (ANY(d_d_n < 0)) THEN
4687	nd = MINLOC(d_d_n,MASK=d_d_n < 0)
4688	flio_dom_rid = nd(1)
4689	ELSE
4690	flio_dom_rid = -1
4691	ENDIF
4692	!------------------------
4693	END FUNCTION flio_dom_rid
4694	!===
4695	INTEGER FUNCTION flio_qid(iid)
4696	!---------------------------------------------------------------------
4697	!- returns the external index associated with the internal index "iid"
4698	!---------------------------------------------------------------------
4699	IMPLICIT NONE
4700	!-
4701	INTEGER,INTENT(IN) :: iid
4702	!---------------------------------------------------------------------
4703	IF ( (iid >= 1).AND.(iid <= nb_fi_mx) ) THEN
4704	flio_qid = nw_id(iid)
4705	ELSE
4706	flio_qid = -1
4707	ENDIF
4708	!--------------------
4709	END FUNCTION flio_qid
4710	!===
4711	SUBROUTINE flio_qvid (cpg,iid,ixd)
4712	!---------------------------------------------------------------------
4713	!- This subroutine, called by the procedure "cpg",
4714	!- validates and returns the external file index "ixd"
4715	!- associated with the internal file index "iid"
4716	!---------------------------------------------------------------------
4717	IMPLICIT NONE
4718	!-
4719	CHARACTER(LEN=*),INTENT(IN) :: cpg
4720	INTEGER,INTENT(IN) :: iid
4721	INTEGER,INTENT(OUT) :: ixd
4722	!---------------------------------------------------------------------
4723	ixd = flio_qid(iid)
4724	IF (ixd < 0) THEN
4725	CALL ipslerr (3,TRIM(cpg),'Invalid internal file index.',' ',' ')
4726	ENDIF
4727	!-----------------------
4728	END SUBROUTINE flio_qvid
4729	!===
4730	SUBROUTINE flio_hdm (f_i,f_e,lk_hm)
4731	!---------------------------------------------------------------------
4732	!- This subroutine handles the "define/data mode" of NETCDF.
4733	!---------------------------------------------------------------------
4734	IMPLICIT NONE
4735	!-
4736	INTEGER,INTENT(IN) :: f_i,f_e
4737	LOGICAL,INTENT(IN) :: lk_hm
4738	!-
4739	INTEGER :: i_rc
4740	!---------------------------------------------------------------------
4741	i_rc = NF90_NOERR
4742	!-
4743	IF ( (.NOT.lw_hm(f_i)).AND.(lk_hm) ) THEN
4744	i_rc = NF90_REDEF(f_e)
4745	lw_hm(f_i) = .TRUE.
4746	ELSE IF ( (lw_hm(f_i)).AND.(.NOT.lk_hm) ) THEN
4747	i_rc = NF90_ENDDEF(f_e)
4748	lw_hm(f_i) = .FALSE.
4749	ENDIF
4750	!-
4751	IF (i_rc /= NF90_NOERR) THEN
4752	CALL ipslerr (3,'flio_hdm', &
4753	& 'Internal error ','in define/data mode :', &
4754	& TRIM(NF90_STRERROR(i_rc)))
4755	ENDIF
4756	!----------------------
4757	END SUBROUTINE flio_hdm
4758	!===
4759	SUBROUTINE flio_inf (f_e, &
4760	& nb_dims,nb_vars,nb_atts,id_unlm,nn_idm,nn_ldm,nn_aid,cc_ndm)
4761	!---------------------------------------------------------------------
4762	!- This subroutine allows to get some information concerning
4763	!- the model file whose the external identifier is "f_e".
4764	!---------------------------------------------------------------------
4765	IMPLICIT NONE
4766	!-
4767	INTEGER,INTENT(IN) :: f_e
4768	INTEGER,OPTIONAL,INTENT(OUT) :: nb_dims,nb_vars,nb_atts,id_unlm
4769	INTEGER,DIMENSION(:),OPTIONAL,INTENT(OUT) :: nn_idm,nn_ldm,nn_aid
4770	CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: cc_ndm
4771	!-
4772	INTEGER :: nm_dims,nm_vars,nm_atts,nm_unlm,ml
4773	INTEGER :: i_rc,kv
4774	CHARACTER(LEN=NF90_MAX_NAME) :: f_d_n
4775	!-
4776	LOGICAL :: l_dbg
4777	!---------------------------------------------------------------------
4778	CALL ipsldbg (old_status=l_dbg)
4779	!-
4780	IF (l_dbg) THEN
4781	WRITE(,) "->flio_inf"
4782	ENDIF
4783	!-
4784	i_rc = NF90_INQUIRE(f_e,nDimensions=nm_dims,nVariables=nm_vars, &
4785	& nAttributes=nm_atts,unlimitedDimId=nm_unlm)
4786	!-
4787	IF (PRESENT(nb_dims)) nb_dims = nm_dims;
4788	IF (PRESENT(nb_vars)) nb_vars = nm_vars;
4789	IF (PRESENT(nb_atts)) nb_atts = nm_atts;
4790	IF (PRESENT(id_unlm)) id_unlm = nm_unlm;
4791	!-
4792	IF (PRESENT(nn_idm)) nn_idm(:) = -1;
4793	IF (PRESENT(nn_ldm)) nn_ldm(:) = 0;
4794	IF (PRESENT(cc_ndm)) cc_ndm(:) = ' ';
4795	IF (PRESENT(nn_aid)) nn_aid(:) = -1;
4796	!-
4797	DO kv=1,nm_dims
4798	!---
4799	i_rc = NF90_INQUIRE_DIMENSION(f_e,kv,name=f_d_n,len=ml)
4800	CALL strlowercase (f_d_n)
4801	f_d_n = ADJUSTL(f_d_n)
4802	!---
4803	IF (l_dbg) THEN
4804	WRITE(,) " flio_inf ",kv,ml," ",TRIM(f_d_n)
4805	ENDIF
4806	!---
4807	IF (PRESENT(nn_idm)) nn_idm(kv)=kv;
4808	IF (PRESENT(nn_ldm)) nn_ldm(kv)=ml;
4809	IF (PRESENT(cc_ndm)) cc_ndm(kv)=TRIM(f_d_n);
4810	!---
4811	IF ( (INDEX(f_d_n,'x') == 1) &
4812	& .OR.(INDEX(f_d_n,'lon') == 1) ) THEN
4813	IF (PRESENT(nn_aid)) THEN
4814	IF (nn_aid(k_lon) < 0) THEN
4815	nn_aid(k_lon)=kv;
4816	ENDIF
4817	ENDIF
4818	ELSE IF ( (INDEX(f_d_n,'y') == 1) &
4819	& .OR.(INDEX(f_d_n,'lat') == 1) ) THEN
4820	IF (PRESENT(nn_aid)) THEN
4821	IF (nn_aid(k_lat) < 0) THEN
4822	nn_aid(k_lat)=kv;
4823	ENDIF
4824	ENDIF
4825	ELSE IF ( (INDEX(f_d_n,'z') == 1) &
4826	& .OR.(INDEX(f_d_n,'lev') == 1) &
4827	& .OR.(INDEX(f_d_n,'plev') == 1) &
4828	& .OR.(INDEX(f_d_n,'depth') == 1) ) THEN
4829	IF (PRESENT(nn_aid)) THEN
4830	IF (nn_aid(k_lev) < 0) THEN
4831	nn_aid(k_lev)=kv;
4832	ENDIF
4833	ENDIF
4834	ELSE IF ( (TRIM(f_d_n) == 't') &
4835	& .OR.(TRIM(f_d_n) == 'time') &
4836	& .OR.(INDEX(f_d_n,'tstep') == 1) &
4837	& .OR.(INDEX(f_d_n,'time_counter') == 1) ) THEN
4838	!---- For the time we certainly need to allow for other names
4839	IF (PRESENT(nn_aid)) THEN
4840	IF (nn_aid(k_tim) < 0) THEN
4841	nn_aid(k_tim)=kv;
4842	ENDIF
4843	ENDIF
4844	ENDIF
4845	!---
4846	ENDDO
4847	!-
4848	IF (l_dbg) THEN
4849	WRITE(,) "<-flio_inf"
4850	ENDIF
4851	!----------------------
4852	END SUBROUTINE flio_inf
4853	!===
4854	SUBROUTINE flio_qax (f_i,axtype,i_v,nbd)
4855	!---------------------------------------------------------------------
4856	!- This subroutine explores the file in order to find
4857	!- an axis (x/y/z/t) according to a number of rules
4858	!---------------------------------------------------------------------
4859	IMPLICIT NONE
4860	!-
4861	INTEGER :: f_i,i_v,nbd
4862	CHARACTER(LEN=*) :: axtype
4863	!-
4864	INTEGER :: kv,k,n_r,l_d,n_d,i_rc,dimnb
4865	CHARACTER(LEN=1) :: c_ax
4866	CHARACTER(LEN=15),DIMENSION(10) :: c_r
4867	CHARACTER(LEN=40) :: c_t1,c_t2
4868	!---------------------------------------------------------------------
4869	i_v = -1; nbd = -1;
4870	!---
4871	!- Keep the name of the axis
4872	!---
4873	c_ax = TRIM(axtype)
4874	!-
4875	! Validate axis type
4876	!-
4877	IF ( (LEN_TRIM(axtype) == 1) &
4878	& .AND.( (c_ax == 'x').OR.(c_ax == 'y') &
4879	& .OR.(c_ax == 'z').OR.(c_ax == 't')) ) THEN
4880	!---
4881	!-- Define the maximum number of dimensions for the coordinate
4882	!---
4883	SELECT CASE (c_ax)
4884	CASE('x')
4885	l_d = 2
4886	CASE('y')
4887	l_d = 2
4888	CASE('z')
4889	l_d = 1
4890	CASE('t')
4891	l_d = 1
4892	END SELECT
4893	!---
4894	!-- Rule 1 : we look for a correct "axis" attribute
4895	!---
4896	IF (i_v < 0) THEN
4897	L_R1: DO kv=1,nw_nv(f_i)
4898	i_rc = NF90_GET_ATT(nw_id(f_i),kv,'axis',c_t1)
4899	IF (i_rc == NF90_NOERR) THEN
4900	CALL strlowercase (c_t1)
4901	IF (TRIM(c_t1) == c_ax) THEN
4902	i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d)
4903	IF (n_d <= l_d) THEN
4904	i_v = kv; nbd = n_d;
4905	EXIT L_R1
4906	ENDIF
4907	ENDIF
4908	ENDIF
4909	ENDDO L_R1
4910	ENDIF
4911	!---
4912	!-- Rule 2 : we look for a specific name
4913	!---
4914	IF (i_v < 0) THEN
4915	SELECT CASE (c_ax)
4916	CASE('x')
4917	n_r = 3
4918	c_r(1)='nav_lon'; c_r(2)='lon'; c_r(3)='longitude';
4919	CASE('y')
4920	n_r = 3
4921	c_r(1)='nav_lat'; c_r(2)='lat'; c_r(3)='latitude';
4922	CASE('z')
4923	n_r = 8
4924	c_r(1)='depth'; c_r(2)='deptht'; c_r(3)='height';
4925	c_r(4)='level'; c_r(5)='lev'; c_r(6)='plev';
4926	c_r(7)='sigma_level'; c_r(8)='layer';
4927	CASE('t')
4928	n_r = 3
4929	c_r(1)='time'; c_r(2)='tstep'; c_r(3)='timesteps';
4930	END SELECT
4931	!-----
4932	L_R2: DO kv=1,nw_nv(f_i)
4933	i_rc = NF90_INQUIRE_VARIABLE &
4934	& (nw_id(f_i),kv,name=c_t1,ndims=n_d)
4935	IF (i_rc == NF90_NOERR) THEN
4936	CALL strlowercase (c_t1)
4937	IF (n_d <= l_d) THEN
4938	DO k=1,n_r
4939	IF (TRIM(c_t1) == TRIM(c_r(k))) THEN
4940	i_v = kv; nbd = n_d;
4941	EXIT L_R2
4942	ENDIF
4943	ENDDO
4944	ENDIF
4945	ENDIF
4946	ENDDO L_R2
4947	ENDIF
4948	!---
4949	!-- Rule 3 : we look for a correct "units" attribute
4950	!---
4951	IF (i_v < 0) THEN
4952	SELECT CASE (c_ax)
4953	CASE('x')
4954	n_r = 2
4955	c_r(1)='degree_e'; c_r(2)='degrees_e';
4956	CASE('y')
4957	n_r = 2
4958	c_r(1)='degree_n'; c_r(2)='degrees_n';
4959	CASE('z')
4960	n_r = 3
4961	c_r(1)='m'; c_r(2)='km'; c_r(3)='hpa';
4962	CASE('t')
4963	n_r = 6
4964	c_r(1)='week'; c_r(2)='day'; c_r(3)='hour';
4965	c_r(4)='minute'; c_r(5)='second'; c_r(6)='timesteps';
4966	END SELECT
4967	!-----
4968	L_R3: DO kv=1,nw_nv(f_i)
4969	i_rc = NF90_GET_ATT(nw_id(f_i),kv,'units',c_t1)
4970	IF (i_rc == NF90_NOERR) THEN
4971	CALL strlowercase (c_t1)
4972	i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d)
4973	IF (n_d <= l_d) THEN
4974	DO k=1,n_r
4975	IF (INDEX(c_t1,TRIM(c_r(k))) == 1) THEN
4976	i_v = kv; nbd = n_d;
4977	EXIT L_R3
4978	ENDIF
4979	ENDDO
4980	ENDIF
4981	ENDIF
4982	ENDDO L_R3
4983	ENDIF
4984	!---
4985	!-- Rule 4 : we look for a variable with one dimension
4986	!-- and which has the same name as its dimension
4987	!---
4988	IF (i_v < 0) THEN
4989	SELECT CASE (c_ax)
4990	CASE('x')
4991	dimnb = nw_di(nw_ai(k_lon,f_i),f_i)
4992	CASE('y')
4993	dimnb = nw_di(nw_ai(k_lat,f_i),f_i)
4994	CASE('z')
4995	dimnb = nw_di(nw_ai(k_lev,f_i),f_i)
4996	CASE('t')
4997	dimnb = nw_di(nw_ai(k_tim,f_i),f_i)
4998	END SELECT
4999	!-----
5000	i_rc = NF90_INQUIRE_DIMENSION(nw_id(f_i),dimnb,name=c_t1)
5001	IF (i_rc == NF90_NOERR) THEN
5002	CALL strlowercase (c_t1)
5003	L_R4: DO kv=1,nw_nv(f_i)
5004	i_rc = NF90_INQUIRE_VARIABLE &
5005	& (nw_id(f_i),kv,name=c_t2,ndims=n_d)
5006	IF (n_d == 1) THEN
5007	CALL strlowercase (c_t2)
5008	IF (TRIM(c_t1) == TRIM(c_t2)) THEN
5009	i_v = kv; nbd = n_d;
5010	EXIT L_R4
5011	ENDIF
5012	ENDIF
5013	ENDDO L_R4
5014	ENDIF
5015	ENDIF
5016	!---
5017	ENDIF
5018	!----------------------
5019	END SUBROUTINE flio_qax
5020	!-
5021	!===
5022	!-
5023	END MODULE fliocom

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

Download in other formats:

Original Format