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

Last change on this file since 246 was 246, checked in by bellier, 16 years ago

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