Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

fliocom.f90 @ 354

Last change on this file since 354 was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 166.3 KB

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

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

Download in other formats:

Original Format