source: IOIPSL/trunk/src/fliocom.f90 @ 881

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