Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

fliocom.f90 @ 4605

Last change on this file since 4605 was 3326, checked in by omamce, 7 years ago
O.M. : Utility to generate interpolatio weights for OASIS-MCT
File size: 163.5 KB

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

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

Context Navigation

source: TOOLS/MOZAIC/src/IOIPSL/fliocom.f90 @ 4605

Download in other formats: