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

Last change on this file since 3474 was 3207, checked in by jgipsl, 7 years ago

Updated max number of dimension needed for rebuild of some versions of ORCHIDEE.

  • Property svn:keywords set to Id
File size: 166.5 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, ipslout
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=25, 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=64
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(ipslout,*) "->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(ipslout,*) '  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(ipslout,*) '<-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(ipslout,*) "->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(ipslout,*) '  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(ipslout,*) '  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(ipslout,*) '  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(ipslout,*) '  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(ipslout,*) '  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(ipslout,*) '  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(ipslout,*) '  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(ipslout,*) '  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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) '->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(ipslout,*) '  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(ipslout,'("   flioopfd - dimensions :",/,(5(1X,I10),:))') &
2353 &    nw_dl(:,f_i)
2354    WRITE(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,'("   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(ipslout,*) '  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(ipslout,*) '  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(ipslout,*) '  fliogstc - time_type : '
3018      WRITE(ipslout,*) it_t
3019      WRITE(ipslout,*) '  fliogstc - year month day second t_init : '
3020      WRITE(ipslout,*) 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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) &
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(ipslout,*) "<-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(ipslout,*) &
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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) "->fliocpya - file",f_i_i,"-",TRIM(v_n_i),"-",TRIM(a_n)
4172    WRITE(ipslout,*) "  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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) '  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(ipslout,*) "<-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(ipslout,*) "->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(ipslout,*) '  flioclo - closing file number ',i_f
4353      ENDIF
4354      i_rc = NF90_CLOSE(f_e)
4355!- error case added : explicit the message and stop with a fatal error
4356      IF (i_rc /= NF90_NOERR) THEN
4357        CALL ipslerr (3,'flioclo', &
4358 &       'Could not close file','Try again and contact your local administrator ', &
4359 &       TRIM(NF90_STRERROR(i_rc))//' (Netcdf)')
4360      ENDIF
4361      nw_id(i_f) = -1
4362    ELSE IF (PRESENT(f_i)) THEN
4363      CALL ipslerr (2,'flioclo', &
4364 &     'Unable to close the file :','probably','not opened')
4365    ENDIF
4366  ENDDO
4367!-
4368  IF (l_dbg) THEN
4369    WRITE(ipslout,*) "<-flioclo"
4370  ENDIF
4371!---------------------
4372END SUBROUTINE flioclo
4373!===
4374SUBROUTINE fliodmpf (f_n)
4375!---------------------------------------------------------------------
4376  IMPLICIT NONE
4377!-
4378  CHARACTER(LEN=*),INTENT(IN) :: f_n
4379!-
4380  INTEGER :: f_e,n_dims,n_vars,n_atts,i_unlm
4381  INTEGER :: i_rc,i_n,k_n,t_ea,l_ea
4382  INTEGER :: tmp_i
4383  REAL    :: tmp_r
4384  INTEGER,DIMENSION(:),ALLOCATABLE :: tma_i
4385  REAL,DIMENSION(:),ALLOCATABLE    :: tma_r
4386  CHARACTER(LEN=256) :: tmp_c
4387  INTEGER,DIMENSION(nb_fd_mx) :: n_idim,n_ldim
4388  INTEGER,DIMENSION(nb_ax_mx) :: n_ai
4389  CHARACTER(LEN=NF90_MAX_NAME),DIMENSION(nb_fd_mx) :: c_ndim
4390  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid
4391  CHARACTER(LEN=NF90_MAX_NAME) :: c_name
4392!---------------------------------------------------------------------
4393  i_rc = NF90_OPEN(TRIM(f_n),NF90_NOWRITE,f_e)
4394  IF (i_rc /= NF90_NOERR) THEN
4395    CALL ipslerr (3,'fliodmpf', &
4396 &   'Could not open file :',TRIM(f_n), &
4397 &   TRIM(NF90_STRERROR(i_rc))//' (Netcdf)')
4398  ENDIF
4399!-
4400  WRITE (ipslout,*) "---"
4401  WRITE (ipslout,*) "--- File '",TRIM(f_n),"'"
4402  WRITE (ipslout,*) "---"
4403!-
4404  CALL flio_inf &
4405 &  (f_e,nb_dims=n_dims,nb_vars=n_vars, &
4406 &       nb_atts=n_atts,id_unlm=i_unlm, &
4407 &       nn_idm=n_idim,nn_ldm=n_ldim,cc_ndm=c_ndim,nn_aid=n_ai)
4408!-
4409  WRITE (ipslout,*) 'External model identifier   : ',f_e
4410  WRITE (ipslout,*) 'Number of dimensions        : ',n_dims
4411  WRITE (ipslout,*) 'Number of variables         : ',n_vars
4412  WRITE (ipslout,*) 'ID unlimited                : ',i_unlm
4413!-
4414  WRITE (ipslout,*) "---"
4415  WRITE (ipslout,*) 'Presumed axis dimensions identifiers :'
4416  IF (n_ai(k_lon) > 0) THEN
4417    WRITE (ipslout,*) 'x axis : ',n_ai(k_lon)
4418  ELSE
4419    WRITE (ipslout,*) 'x axis : NONE'
4420  ENDIF
4421  IF (n_ai(k_lat) > 0) THEN
4422    WRITE (ipslout,*) 'y axis : ',n_ai(k_lat)
4423  ELSE
4424    WRITE (ipslout,*) 'y axis : NONE'
4425  ENDIF
4426  IF (n_ai(k_lev) > 0) THEN
4427    WRITE (ipslout,*) 'z axis : ',n_ai(k_lev)
4428  ELSE
4429    WRITE (ipslout,*) 'z axis : NONE'
4430  ENDIF
4431  IF (n_ai(k_tim) > 0) THEN
4432    WRITE (ipslout,*) 't axis : ',n_ai(k_tim)
4433  ELSE
4434    WRITE (ipslout,*) 't axis : NONE'
4435  ENDIF
4436!-
4437  WRITE (ipslout,*) "---"
4438  WRITE (ipslout,*) 'Number of global attributes : ',n_atts
4439  DO k_n=1,n_atts
4440    i_rc = NF90_INQ_ATTNAME(f_e,NF90_GLOBAL,k_n,c_name)
4441    i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,NF90_GLOBAL,c_name, &
4442 &                                xtype=t_ea,len=l_ea)
4443    IF      (    (t_ea == NF90_INT4).OR.(t_ea == NF90_INT2) &
4444             .OR.(t_ea == NF90_INT1) ) THEN
4445      IF (l_ea > 1) THEN
4446        ALLOCATE(tma_i(l_ea))
4447        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_i)
4448        WRITE (ipslout,'("    ",A," :",/,(5(1X,I10),:))') &
4449 &        TRIM(c_name),tma_i(1:l_ea)
4450        DEALLOCATE(tma_i)
4451      ELSE
4452        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_i)
4453        WRITE(ipslout,*) '   ',TRIM(c_name),' : ',tmp_i
4454      ENDIF
4455    ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
4456      IF (l_ea > 1) THEN
4457        ALLOCATE(tma_r(l_ea))
4458        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_r)
4459        WRITE (ipslout,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
4460 &        TRIM(c_name),tma_r(1:l_ea)
4461        DEALLOCATE(tma_r)
4462      ELSE
4463        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_r)
4464        WRITE(ipslout,*) '   ',TRIM(c_name),' : ',tmp_r
4465      ENDIF
4466    ELSE
4467      tmp_c = ''
4468      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_c)
4469      WRITE(ipslout,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
4470    ENDIF
4471  ENDDO
4472!-
4473  DO i_n=1,nb_fd_mx
4474    IF (n_idim(i_n) > 0) THEN
4475      WRITE (ipslout,*) "---"
4476      WRITE (ipslout,*) 'Dimension id   : ',n_idim(i_n)
4477      WRITE (ipslout,*) 'Dimension name : ',TRIM(c_ndim(i_n))
4478      WRITE (ipslout,*) 'Dimension size : ',n_ldim(i_n)
4479    ENDIF
4480  ENDDO
4481!-
4482  DO i_n=1,n_vars
4483    i_rc = NF90_INQUIRE_VARIABLE(f_e,i_n, &
4484 &           name=c_name,ndims=n_dims,dimids=idimid,nAtts=n_atts)
4485    WRITE (ipslout,*) "---"
4486    WRITE (ipslout,*) "Variable name        : ",TRIM(c_name)
4487    WRITE (ipslout,*) "Variable identifier  : ",i_n
4488    WRITE (ipslout,*) "Number of dimensions : ",n_dims
4489    IF (n_dims > 0) THEN
4490      WRITE (ipslout,*) "Dimensions ID's      : ",idimid(1:n_dims)
4491    ENDIF
4492    WRITE (ipslout,*) "Number of attributes : ",n_atts
4493    DO k_n=1,n_atts
4494      i_rc = NF90_INQ_ATTNAME(f_e,i_n,k_n,c_name)
4495      i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_n,c_name, &
4496 &                                  xtype=t_ea,len=l_ea)
4497      IF      (    (t_ea == NF90_INT4).OR.(t_ea == NF90_INT2) &
4498 &             .OR.(t_ea == NF90_INT1) ) THEN
4499        IF (l_ea > 1) THEN
4500          ALLOCATE(tma_i(l_ea))
4501          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_i)
4502          WRITE (ipslout,'("    ",A," :",/,(5(1X,I10),:))') &
4503 &              TRIM(c_name),tma_i(1:l_ea)
4504          DEALLOCATE(tma_i)
4505        ELSE
4506          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_i)
4507          WRITE(ipslout,*) '   ',TRIM(c_name),' : ',tmp_i
4508        ENDIF
4509      ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
4510        IF (l_ea > 1) THEN
4511          ALLOCATE(tma_r(l_ea))
4512          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_r)
4513          WRITE (ipslout,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
4514 &          TRIM(c_name),tma_r(1:l_ea)
4515          DEALLOCATE(tma_r)
4516        ELSE
4517          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_r)
4518          WRITE(ipslout,*) '   ',TRIM(c_name),' : ',tmp_r
4519        ENDIF
4520      ELSE
4521        tmp_c = ''
4522        i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_c)
4523        WRITE(ipslout,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
4524      ENDIF
4525    ENDDO
4526  ENDDO
4527  WRITE (ipslout,*) "---"
4528!-
4529  i_rc = NF90_CLOSE(f_e)
4530!----------------------
4531END SUBROUTINE fliodmpf
4532!===
4533SUBROUTINE flio_dom_set &
4534 & (dtnb,dnb,did,dsg,dsl,dpf,dpl,dhs,dhe,cdnm,id_dom)
4535!---------------------------------------------------------------------
4536  IMPLICIT NONE
4537!-
4538  INTEGER,INTENT(IN) :: dtnb,dnb
4539  INTEGER,DIMENSION(:),INTENT(IN) :: did,dsg,dsl,dpf,dpl,dhs,dhe
4540  CHARACTER(LEN=*),INTENT(IN) :: cdnm
4541  INTEGER,INTENT(OUT) :: id_dom
4542!-
4543  INTEGER :: k_w,i_w,i_s
4544  CHARACTER(LEN=l_dns) :: cd_p,cd_w
4545!---------------------------------------------------------------------
4546  k_w = flio_dom_rid()
4547  IF (k_w < 0) THEN
4548    CALL ipslerr (3,'flio_dom_set', &
4549 &   'too many domains simultaneously defined', &
4550 &   'please unset useless domains', &
4551 &   'by calling flio_dom_unset')
4552  ENDIF
4553  id_dom = k_w
4554!-
4555  d_n_t(k_w) = dtnb
4556  d_n_c(k_w) = dnb
4557!-
4558  i_s = SIZE(did)
4559  IF (i_s > dom_max_dims) THEN
4560    CALL ipslerr (3,'flio_dom_set', &
4561 &   'too many distributed dimensions', &
4562 &   'simultaneously defined',' ')
4563  ENDIF
4564  d_d_n(k_w) = i_s
4565  d_d_i(1:i_s,k_w) = did(1:i_s)
4566!-
4567  i_w = SIZE(dsg)
4568  IF (i_w /= i_s) THEN
4569    CALL ipslerr (3,'flio_dom_set', &
4570 &   'the size of the DOMAIN_size_global array', &
4571 &   'is not equal to the size', &
4572 &   'of the distributed dimensions array')
4573  ENDIF
4574  d_s_g(1:i_w,k_w) = dsg(1:i_w)
4575!-
4576  i_w = SIZE(dsl)
4577  IF (i_w /= i_s) THEN
4578    CALL ipslerr (3,'flio_dom_set', &
4579 &   'the size of the DOMAIN_size_local array', &
4580 &   'is not equal to the size', &
4581 &   'of the distributed dimensions array')
4582  ENDIF
4583  d_s_l(1:i_w,k_w) = dsl(1:i_w)
4584!-
4585  i_w = SIZE(dpf)
4586  IF (i_w /= i_s) THEN
4587    CALL ipslerr (3,'flio_dom_set', &
4588 &   'the size of the DOMAIN_position_first array', &
4589 &   'is not equal to the size', &
4590 &   'of the distributed dimensions array')
4591  ENDIF
4592  d_p_f(1:i_w,k_w) = dpf(1:i_w)
4593!-
4594  i_w = SIZE(dpl)
4595  IF (i_w /= i_s) THEN
4596    CALL ipslerr (3,'flio_dom_set', &
4597 &   'the size of the DOMAIN_position_last array', &
4598 &   'is not equal to the size', &
4599 &   'of the distributed dimensions array')
4600  ENDIF
4601  d_p_l(1:i_w,k_w) = dpl(1:i_w)
4602!-
4603  i_w = SIZE(dhs)
4604  IF (i_w /= i_s) THEN
4605    CALL ipslerr (3,'flio_dom_set', &
4606 &   'the size of the DOMAIN_halo_size_start array', &
4607 &   'is not equal to the size', &
4608 &   'of the distributed dimensions array')
4609  ENDIF
4610  d_h_s(1:i_w,k_w) = dhs(1:i_w)
4611!-
4612  i_w = SIZE(dhe)
4613  IF (i_w /= i_s) THEN
4614    CALL ipslerr (3,'flio_dom_set', &
4615 &   'the size of the DOMAIN_halo_size_end array', &
4616 &   'is not equal to the size', &
4617 &   'of the distributed dimensions array')
4618  ENDIF
4619  d_h_e(1:i_w,k_w) = dhe(1:i_w)
4620!-
4621  cd_p = "unknown"
4622  cd_w = cdnm; CALL strlowercase (cd_w)
4623  DO i_w=1,n_dns
4624    IF (TRIM(cd_w) == TRIM(c_dns(i_w))) THEN
4625      cd_p = cd_w; EXIT;
4626    ENDIF
4627  ENDDO
4628  IF (TRIM(cd_p) == "unknown") THEN
4629    CALL ipslerr (3,'flio_dom_set', &
4630 &   'DOMAIN_type "'//TRIM(cdnm)//'"', &
4631 &   'is actually not supported', &
4632 &   'please use one of the supported names')
4633  ENDIF
4634  c_d_t(k_w) = cd_p
4635!--------------------------
4636END SUBROUTINE flio_dom_set
4637!===
4638SUBROUTINE flio_dom_unset (id_dom)
4639!---------------------------------------------------------------------
4640  IMPLICIT NONE
4641!-
4642  INTEGER,INTENT(IN),OPTIONAL :: id_dom
4643!-
4644  INTEGER :: i_w
4645!---------------------------------------------------------------------
4646  IF (PRESENT(id_dom)) THEN
4647    IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
4648      IF (d_d_n(id_dom) > 0) THEN
4649        d_d_n(id_dom) = -1
4650      ELSE
4651        CALL ipslerr (2,'flio_dom_unset', &
4652 &       'The domain is not set',' ',' ')
4653      ENDIF
4654    ELSE
4655      CALL ipslerr (2,'flio_dom_unset', &
4656 &     'Invalid file identifier',' ',' ')
4657    ENDIF
4658  ELSE
4659    DO i_w=1,dom_max_nb
4660      d_d_n(id_dom) = -1
4661    ENDDO
4662  ENDIF
4663!----------------------------
4664END SUBROUTINE flio_dom_unset
4665!===
4666SUBROUTINE flio_dom_defset (id_dom)
4667!---------------------------------------------------------------------
4668  IMPLICIT NONE
4669!-
4670  INTEGER,INTENT(IN) :: id_dom
4671!---------------------------------------------------------------------
4672  IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
4673    id_def_dom = id_dom
4674  ELSE
4675    CALL ipslerr (3,'flio_dom_defset', &
4676 &   'Invalid domain identifier',' ',' ')
4677  ENDIF
4678!-----------------------------
4679END SUBROUTINE flio_dom_defset
4680!===
4681SUBROUTINE flio_dom_defunset ()
4682!---------------------------------------------------------------------
4683  IMPLICIT NONE
4684!---------------------------------------------------------------------
4685  id_def_dom = FLIO_DOM_NONE
4686!-------------------------------
4687END SUBROUTINE flio_dom_defunset
4688!===
4689SUBROUTINE flio_dom_definq (id_dom)
4690!---------------------------------------------------------------------
4691  IMPLICIT NONE
4692!-
4693  INTEGER,INTENT(OUT) :: id_dom
4694!---------------------------------------------------------------------
4695  id_dom = id_def_dom
4696!-----------------------------
4697END SUBROUTINE flio_dom_definq
4698!===
4699!-
4700!---------------------------------------------------------------------
4701!- Semi-public procedures
4702!---------------------------------------------------------------------
4703!-
4704!===
4705SUBROUTINE flio_dom_file (f_n,id_dom)
4706!---------------------------------------------------------------------
4707!- Update the model file name to include the ".nc" suffix and
4708!- the DOMAIN number on which this copy of IOIPSL runs, if needed.
4709!- This routine is called by IOIPSL and not by user anyway.
4710!---------------------------------------------------------------------
4711  IMPLICIT NONE
4712!-
4713  CHARACTER(LEN=*),INTENT(INOUT) :: f_n
4714  INTEGER,OPTIONAL,INTENT(IN) :: id_dom
4715!-
4716  INTEGER :: il,iw
4717  CHARACTER(LEN=4) :: str
4718!---------------------------------------------------------------------
4719!-
4720! Add the ".nc" suffix if needed
4721  il = LEN_TRIM(f_n)
4722  IF (f_n(il-2:il) /= '.nc') THEN
4723    f_n = f_n(1:il)//'.nc'
4724  ENDIF
4725!-
4726! Add the DOMAIN identifier if needed
4727  IF (PRESENT(id_dom)) THEN
4728    IF (id_dom == FLIO_DOM_DEFAULT) THEN
4729      CALL flio_dom_definq (iw)
4730    ELSE
4731      iw = id_dom
4732    ENDIF
4733    IF (iw /= FLIO_DOM_NONE) THEN
4734      IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
4735        IF (d_d_n(iw) > 0) THEN
4736          WRITE(str,'(I4.4)') d_n_c(iw)
4737          il = INDEX(f_n,'.nc')
4738          f_n = f_n(1:il-1)//'_'//str//'.nc'
4739        ELSE
4740          CALL ipslerr (3,'flio_dom_file', &
4741 &         'The domain has not been defined', &
4742 &         'please call flio_dom_set', &
4743 &         'before calling flio_dom_file')
4744        ENDIF
4745      ELSE
4746        CALL ipslerr (3,'flio_dom_file', &
4747 &       'Invalid domain identifier',' ',' ')
4748      ENDIF
4749    ENDIF
4750  ENDIF
4751!---------------------------
4752END SUBROUTINE flio_dom_file
4753!===
4754SUBROUTINE flio_dom_att (f_e,id_dom)
4755!---------------------------------------------------------------------
4756!- Add the DOMAIN attributes to the NETCDF file.
4757!- This routine is called by IOIPSL and not by user anyway.
4758!---------------------------------------------------------------------
4759  IMPLICIT NONE
4760!-
4761  INTEGER,INTENT(in) :: f_e
4762  INTEGER,OPTIONAL,INTENT(IN) :: id_dom
4763!-
4764  INTEGER :: iw,i_rc,i_n
4765  CHARACTER(LEN=15) :: c_ddim
4766  INTEGER :: n_idim
4767  CHARACTER(LEN=NF90_MAX_NAME) :: c_ndim
4768!---------------------------------------------------------------------
4769  IF (PRESENT(id_dom)) THEN
4770    IF (id_dom == FLIO_DOM_DEFAULT) THEN
4771      CALL flio_dom_definq (iw)
4772    ELSE
4773      iw = id_dom
4774    ENDIF
4775    IF (iw /= FLIO_DOM_NONE) THEN
4776      IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
4777        IF (d_d_n(iw) > 0) THEN
4778          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4779 &          'DOMAIN_number_total',d_n_t(iw))
4780          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4781 &          'DOMAIN_number',d_n_c(iw))
4782          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4783 &          'DOMAIN_dimensions_ids',d_d_i(1:d_d_n(iw),iw))
4784          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4785 &          'DOMAIN_size_global',d_s_g(1:d_d_n(iw),iw))
4786          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4787 &          'DOMAIN_size_local',d_s_l(1:d_d_n(iw),iw))
4788          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4789 &          'DOMAIN_position_first',d_p_f(1:d_d_n(iw),iw))
4790          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4791 &          'DOMAIN_position_last',d_p_l(1:d_d_n(iw),iw))
4792          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4793 &          'DOMAIN_halo_size_start',d_h_s(1:d_d_n(iw),iw))
4794          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4795 &          'DOMAIN_halo_size_end',d_h_e(1:d_d_n(iw),iw))
4796          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
4797 &          'DOMAIN_type',TRIM(c_d_t(iw)))
4798          i_rc = NF90_INQUIRE (f_e,nDimensions=n_idim)
4799          DO i_n=1,n_idim
4800            i_rc = NF90_INQUIRE_DIMENSION (f_e,i_n,name=c_ndim)
4801            WRITE (UNIT=c_ddim,FMT='("DOMAIN_DIM_N",I3.3)') i_n
4802            i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL,c_ddim,TRIM(c_ndim))
4803          ENDDO
4804        ELSE
4805          CALL ipslerr (3,'flio_dom_att', &
4806 &         'The domain has not been defined', &
4807 &         'please call flio_dom_set', &
4808 &         'before calling flio_dom_att')
4809        ENDIF
4810      ELSE
4811        CALL ipslerr (3,'flio_dom_att', &
4812 &       'Invalid domain identifier',' ',' ')
4813      ENDIF
4814    ENDIF
4815  ENDIF
4816!--------------------------
4817END SUBROUTINE flio_dom_att
4818!===
4819!-
4820!---------------------------------------------------------------------
4821!- Local procedures
4822!---------------------------------------------------------------------
4823!-
4824!===
4825INTEGER FUNCTION flio_rid()
4826!---------------------------------------------------------------------
4827!- returns a free index in nw_id(:)
4828!---------------------------------------------------------------------
4829  INTEGER,DIMENSION(1:1) :: nfi
4830!-
4831  IF (ANY(nw_id < 0)) THEN
4832    nfi = MINLOC(nw_id,MASK=nw_id < 0)
4833    flio_rid = nfi(1)
4834  ELSE
4835    flio_rid = -1
4836  ENDIF
4837!--------------------
4838END FUNCTION flio_rid
4839!===
4840INTEGER FUNCTION flio_dom_rid()
4841!---------------------------------------------------------------------
4842!- returns a free index in d_d_n(:)
4843!---------------------------------------------------------------------
4844  INTEGER,DIMENSION(1:1) :: nd
4845!---------------------------------------------------------------------
4846  IF (ANY(d_d_n < 0)) THEN
4847    nd = MINLOC(d_d_n,MASK=d_d_n < 0)
4848    flio_dom_rid = nd(1)
4849  ELSE
4850    flio_dom_rid = -1
4851  ENDIF
4852!------------------------
4853END FUNCTION flio_dom_rid
4854!===
4855INTEGER FUNCTION flio_qid(iid)
4856!---------------------------------------------------------------------
4857!- returns the external index associated with the internal index "iid"
4858!---------------------------------------------------------------------
4859  IMPLICIT NONE
4860!-
4861  INTEGER,INTENT(IN) :: iid
4862!---------------------------------------------------------------------
4863  IF ( (iid >= 1).AND.(iid <= nb_fi_mx) ) THEN
4864    flio_qid = nw_id(iid)
4865  ELSE
4866    flio_qid = -1
4867  ENDIF
4868!--------------------
4869END FUNCTION flio_qid
4870!===
4871SUBROUTINE flio_qvid (cpg,iid,ixd)
4872!---------------------------------------------------------------------
4873!- This subroutine, called by the procedure "cpg",
4874!- validates and returns the external file index "ixd"
4875!- associated with the internal file index "iid"
4876!---------------------------------------------------------------------
4877  IMPLICIT NONE
4878!-
4879  CHARACTER(LEN=*),INTENT(IN) :: cpg
4880  INTEGER,INTENT(IN)  :: iid
4881  INTEGER,INTENT(OUT) :: ixd
4882!-
4883  CHARACTER(LEN=20) :: c_t
4884!---------------------------------------------------------------------
4885  ixd = flio_qid(iid)
4886  IF (ixd < 0) THEN
4887    WRITE (UNIT=c_t,FMT='(I15)') iid
4888    CALL ipslerr (3,TRIM(cpg), &
4889 &    'Invalid internal file index :',TRIM(ADJUSTL(c_t)),' ')
4890  ENDIF
4891!-----------------------
4892END SUBROUTINE flio_qvid
4893!===
4894SUBROUTINE flio_hdm (f_i,f_e,lk_hm)
4895!---------------------------------------------------------------------
4896!- This subroutine handles the "define/data mode" of NETCDF.
4897!---------------------------------------------------------------------
4898  IMPLICIT NONE
4899!-
4900  INTEGER,INTENT(IN) :: f_i,f_e
4901  LOGICAL,INTENT(IN) :: lk_hm
4902!-
4903  INTEGER :: i_rc
4904!---------------------------------------------------------------------
4905  i_rc = NF90_NOERR
4906!-
4907  IF      ( (.NOT.lw_hm(f_i)).AND.(lk_hm) ) THEN
4908    i_rc = NF90_REDEF(f_e)
4909    lw_hm(f_i) = .TRUE.
4910  ELSE IF ( (lw_hm(f_i)).AND.(.NOT.lk_hm) ) THEN
4911    i_rc = NF90_ENDDEF(f_e)
4912    lw_hm(f_i) = .FALSE.
4913  ENDIF
4914!-
4915  IF (i_rc /= NF90_NOERR) THEN
4916    CALL ipslerr (3,'flio_hdm', &
4917 &    'Internal error ','in define/data mode :', &
4918 &    TRIM(NF90_STRERROR(i_rc)))
4919  ENDIF
4920!----------------------
4921END SUBROUTINE flio_hdm
4922!===
4923SUBROUTINE flio_inf (f_e, &
4924 & nb_dims,nb_vars,nb_atts,id_unlm,nn_idm,nn_ldm,nn_aid,cc_ndm)
4925!---------------------------------------------------------------------
4926!- This subroutine allows to get some information concerning
4927!- the model file whose the external identifier is "f_e".
4928!---------------------------------------------------------------------
4929  IMPLICIT NONE
4930!-
4931  INTEGER,INTENT(IN) :: f_e
4932  INTEGER,OPTIONAL,INTENT(OUT) :: nb_dims,nb_vars,nb_atts,id_unlm
4933  INTEGER,DIMENSION(:),OPTIONAL,INTENT(OUT) :: nn_idm,nn_ldm,nn_aid
4934  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: cc_ndm
4935!-
4936  INTEGER :: nm_dims,nm_vars,nm_atts,nm_unlm,ml
4937  INTEGER :: i_rc,kv
4938  CHARACTER(LEN=NF90_MAX_NAME) :: f_d_n
4939!-
4940  LOGICAL :: l_dbg
4941!---------------------------------------------------------------------
4942  CALL ipsldbg (old_status=l_dbg)
4943!-
4944  IF (l_dbg) THEN
4945    WRITE(ipslout,*) "->flio_inf"
4946  ENDIF
4947!-
4948  i_rc = NF90_INQUIRE(f_e,nDimensions=nm_dims,nVariables=nm_vars, &
4949 &                    nAttributes=nm_atts,unlimitedDimId=nm_unlm)
4950!-
4951  IF (PRESENT(nb_dims))  nb_dims = nm_dims;
4952  IF (PRESENT(nb_vars))  nb_vars = nm_vars;
4953  IF (PRESENT(nb_atts))  nb_atts = nm_atts;
4954  IF (PRESENT(id_unlm))  id_unlm = nm_unlm;
4955!-
4956  IF (PRESENT(nn_idm))  nn_idm(:) =  -1;
4957  IF (PRESENT(nn_ldm))  nn_ldm(:) =   0;
4958  IF (PRESENT(cc_ndm))  cc_ndm(:) = ' ';
4959  IF (PRESENT(nn_aid))  nn_aid(:) =  -1;
4960!-
4961  DO kv=1,nm_dims
4962!---
4963    i_rc = NF90_INQUIRE_DIMENSION(f_e,kv,name=f_d_n,len=ml)
4964    CALL strlowercase (f_d_n)
4965    f_d_n = ADJUSTL(f_d_n)
4966!---
4967    IF (l_dbg) THEN
4968      WRITE(ipslout,*) "  flio_inf ",kv,ml," ",TRIM(f_d_n)
4969    ENDIF
4970!---
4971    IF (PRESENT(nn_idm))  nn_idm(kv)=kv;
4972    IF (PRESENT(nn_ldm))  nn_ldm(kv)=ml;
4973    IF (PRESENT(cc_ndm))  cc_ndm(kv)=TRIM(f_d_n);
4974!---
4975    IF      (    (INDEX(f_d_n,'x') == 1)   &
4976 &           .OR.(INDEX(f_d_n,'lon') == 1) ) THEN
4977      IF (PRESENT(nn_aid)) THEN
4978        IF (nn_aid(k_lon) < 0) THEN
4979          nn_aid(k_lon)=kv;
4980        ENDIF
4981      ENDIF
4982    ELSE IF (    (INDEX(f_d_n,'y') == 1)   &
4983 &           .OR.(INDEX(f_d_n,'lat') == 1) ) THEN
4984      IF (PRESENT(nn_aid)) THEN
4985        IF (nn_aid(k_lat) < 0) THEN
4986          nn_aid(k_lat)=kv;
4987        ENDIF
4988      ENDIF
4989    ELSE IF (    (INDEX(f_d_n,'z') == 1)     &
4990 &           .OR.(INDEX(f_d_n,'lev') == 1)   &
4991 &           .OR.(INDEX(f_d_n,'plev') == 1)  &
4992 &           .OR.(INDEX(f_d_n,'depth') == 1) ) THEN
4993      IF (PRESENT(nn_aid)) THEN
4994        IF (nn_aid(k_lev) < 0) THEN
4995          nn_aid(k_lev)=kv;
4996        ENDIF
4997      ENDIF
4998    ELSE IF (    (TRIM(f_d_n) == 't')         &
4999 &           .OR.(TRIM(f_d_n) == 'time')      &
5000 &           .OR.(INDEX(f_d_n,'tstep') == 1)  &
5001 &           .OR.(INDEX(f_d_n,'time_counter') == 1) ) THEN
5002!---- For the time we certainly need to allow for other names
5003      IF (PRESENT(nn_aid)) THEN
5004        IF (nn_aid(k_tim) < 0) THEN
5005          nn_aid(k_tim)=kv;
5006        ENDIF
5007      ENDIF
5008    ENDIF
5009!---
5010  ENDDO
5011!-
5012  IF (l_dbg) THEN
5013    WRITE(ipslout,*) "<-flio_inf"
5014  ENDIF
5015!----------------------
5016END SUBROUTINE flio_inf
5017!===
5018SUBROUTINE flio_qax (f_i,axtype,i_v,nbd)
5019!---------------------------------------------------------------------
5020!- This subroutine explores the file in order to find
5021!- an axis (x/y/z/t) according to a number of rules
5022!---------------------------------------------------------------------
5023  IMPLICIT NONE
5024!-
5025  INTEGER :: f_i,i_v,nbd
5026  CHARACTER(LEN=*) :: axtype
5027!-
5028  INTEGER :: kv,k,n_r,l_d,n_d,i_rc,dimnb
5029  CHARACTER(LEN=1)  :: c_ax
5030  CHARACTER(LEN=18) :: c_sn
5031  CHARACTER(LEN=15),DIMENSION(10) :: c_r
5032  CHARACTER(LEN=40) :: c_t1,c_t2
5033!---------------------------------------------------------------------
5034  i_v = -1; nbd = -1;
5035!---
5036!- Keep the name of the axis
5037!---
5038  c_ax = TRIM(axtype)
5039!-
5040! Validate axis type
5041!-
5042  IF (    (LEN_TRIM(axtype) == 1) &
5043 &    .AND.(    (c_ax == 'x').OR.(c_ax == 'y') &
5044 &          .OR.(c_ax == 'z').OR.(c_ax == 't')) ) THEN
5045!---
5046!-- Define the maximum number of dimensions for the coordinate
5047!---
5048      SELECT CASE (c_ax)
5049      CASE('x')
5050        l_d = 2
5051        c_sn = 'longitude'
5052      CASE('y')
5053        l_d = 2
5054        c_sn = 'latitude'
5055      CASE('z')
5056        l_d = 1
5057        c_sn = 'model_level_number'
5058      CASE('t')
5059        l_d = 1
5060        c_sn = 'time'
5061      END SELECT
5062!---
5063!-- Rule 1 : we look for a variable with one dimension
5064!--          and which has the same name as its dimension (NUG)
5065!---
5066    IF (i_v < 0) THEN
5067      SELECT CASE (c_ax)
5068      CASE('x')
5069        k = nw_ai(k_lon,f_i)
5070      CASE('y')
5071        k = nw_ai(k_lat,f_i)
5072      CASE('z')
5073        k = nw_ai(k_lev,f_i)
5074      CASE('t')
5075        k = nw_ai(k_tim,f_i)
5076      END SELECT
5077      IF ( (k >= 1).AND.(k <= nb_ax_mx) ) THEN
5078        dimnb = nw_di(k,f_i)
5079      ELSE
5080        dimnb = -1
5081      ENDIF
5082!-----
5083      i_rc = NF90_INQUIRE_DIMENSION(nw_id(f_i),dimnb,name=c_t1)
5084      IF (i_rc == NF90_NOERR) THEN
5085        CALL strlowercase (c_t1)
5086        L_R1: DO kv=1,nw_nv(f_i)
5087          i_rc = NF90_INQUIRE_VARIABLE &
5088 &                 (nw_id(f_i),kv,name=c_t2,ndims=n_d)
5089          IF (n_d == 1) THEN
5090            CALL strlowercase (c_t2)
5091            IF (TRIM(c_t1) == TRIM(c_t2)) THEN
5092              i_v = kv; nbd = n_d;
5093              EXIT L_R1
5094            ENDIF
5095          ENDIF
5096        ENDDO L_R1
5097      ENDIF
5098    ENDIF
5099!---
5100!-- Rule 2 : we look for a correct "axis" attribute (CF)
5101!---
5102    IF (i_v < 0) THEN
5103      L_R2: DO kv=1,nw_nv(f_i)
5104        i_rc = NF90_GET_ATT(nw_id(f_i),kv,'axis',c_t1)
5105        IF (i_rc == NF90_NOERR) THEN
5106          CALL strlowercase (c_t1)
5107          IF (TRIM(c_t1) == c_ax) THEN
5108            i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d)
5109            IF (n_d <= l_d) THEN
5110              i_v = kv; nbd = n_d;
5111              EXIT L_R2
5112            ENDIF
5113          ENDIF
5114        ENDIF
5115      ENDDO L_R2
5116    ENDIF
5117!---
5118!-- Rule 3 : we look for a correct "standard_name" attribute (CF)
5119!---
5120    IF (i_v < 0) THEN
5121      L_R3: DO kv=1,nw_nv(f_i)
5122        i_rc = NF90_GET_ATT(nw_id(f_i),kv,'standard_name',c_t1)
5123        IF (i_rc == NF90_NOERR) THEN
5124          CALL strlowercase (c_t1)
5125          IF (TRIM(c_t1) == TRIM(c_sn)) THEN
5126            i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d)
5127            IF (n_d <= l_d) THEN
5128              i_v = kv; nbd = n_d;
5129              EXIT L_R3
5130            ENDIF
5131          ENDIF
5132        ENDIF
5133      ENDDO L_R3
5134    ENDIF
5135!---
5136!-- Rule 4 : we look for a specific name (IOIPSL)
5137!---
5138    IF (i_v < 0) THEN
5139      SELECT CASE (c_ax)
5140      CASE('x')
5141        n_r = 3
5142        c_r(1)='nav_lon'; c_r(2)='lon'; c_r(3)='longitude';
5143      CASE('y')
5144        n_r = 3
5145        c_r(1)='nav_lat'; c_r(2)='lat'; c_r(3)='latitude';
5146      CASE('z')
5147        n_r = 8
5148        c_r(1)='depth'; c_r(2)='deptht'; c_r(3)='height';
5149        c_r(4)='level'; c_r(5)='lev'; c_r(6)='plev';
5150        c_r(7)='sigma_level'; c_r(8)='layer';
5151      CASE('t')
5152        n_r = 3
5153        c_r(1)='time'; c_r(2)='tstep'; c_r(3)='timesteps';
5154      END SELECT
5155!-----
5156      L_R4: DO kv=1,nw_nv(f_i)
5157        i_rc = NF90_INQUIRE_VARIABLE &
5158 &               (nw_id(f_i),kv,name=c_t1,ndims=n_d)
5159        IF (i_rc == NF90_NOERR) THEN
5160          CALL strlowercase (c_t1)
5161          IF (n_d <= l_d) THEN
5162            DO k=1,n_r
5163              IF (TRIM(c_t1) == TRIM(c_r(k))) THEN
5164                i_v = kv; nbd = n_d;
5165                EXIT L_R4
5166              ENDIF
5167            ENDDO
5168          ENDIF
5169        ENDIF
5170      ENDDO L_R4
5171    ENDIF
5172!---
5173  ENDIF
5174!----------------------
5175END SUBROUTINE flio_qax
5176!-
5177!===
5178!-
5179END MODULE fliocom
Note: See TracBrowser for help on using the repository browser.