Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

fliocom.f90

Last change on this file was 14623, checked in by ldebreu, 4 years ago
AGFdomcfg: 1) Update DOMAINcfg to be compliant with the removal of halo cells 2) Update most of the LBC ... subroutines to a recent NEMO 4 version #2638
Property svn:executable set to ``*
File size: 165.7 KB

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

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: utils/tools/DOMAINcfg/src/fliocom.f90

Download in other formats: