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

Last change on this file since 760 was 760, checked in by bellier, 15 years ago

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