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

Last change on this file since 358 was 329, checked in by bellier, 16 years ago
  • modified an error message
  • added an option in fliocrfd to create a file in mode "64 bits"

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