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

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