New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
fliocom.f90 in branches/UKMO/r8727_WAVE-2_Clementi_add_coupling/NEMOGCM/EXTERNAL/IOIPSL/src – NEMO

source: branches/UKMO/r8727_WAVE-2_Clementi_add_coupling/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90 @ 8749

Last change on this file since 8749 was 8749, checked in by jcastill, 6 years ago

Remove svn keywords

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