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

Last change on this file since 886 was 886, checked in by bellier, 14 years ago

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