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

Last change on this file since 30 was 10, checked in by bellier, 17 years ago

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