Added ezfio_array_of_array

This commit is contained in:
Anthony Scemama 2022-01-11 10:30:07 +01:00
parent ed1df9f3c1
commit d5805497fa
1 changed files with 59 additions and 35 deletions

View File

@ -1,26 +1,26 @@
(* (*
EZFIO is an automatic generator of I/O libraries EZFIO is an automatic generator of I/O libraries
Copyright (C) 2009 Anthony SCEMAMA, CNRS Copyright (C) 2009 Anthony SCEMAMA, CNRS
This program is free software; you can redistribute it and/or modify This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or the Free Software Foundation; either version 2 of the License, or
(at your option) any later version. (at your option) any later version.
This program is distributed in the hope that it will be useful, This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details. GNU General Public License for more details.
You should have received a copy of the GNU General Public License along You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc., with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
Anthony Scemama Anthony Scemama
LCPQ - IRSAMC - CNRS LCPQ - IRSAMC - CNRS
Universite Paul Sabatier Universite Paul Sabatier
118, route de Narbonne 118, route de Narbonne
31062 Toulouse Cedex 4 31062 Toulouse Cedex 4
scemama@irsamc.ups-tlse.fr scemama@irsamc.ups-tlse.fr
*) *)
@ -40,7 +40,7 @@ State variables
let read_only = ref false let read_only = ref false
let ezfio_filename = ref "EZFIO_File" let ezfio_filename = ref "EZFIO_File"
(* (*
Helper functions Helper functions
================= =================
*) *)
@ -54,7 +54,7 @@ let exists path =
let filename = Filename.concat path ".version" in let filename = Filename.concat path ".version" in
Sys.file_exists filename Sys.file_exists filename
let has group name = let has group name =
let dirname = Filename.concat !ezfio_filename group in let dirname = Filename.concat !ezfio_filename group in
if (exists dirname) then if (exists dirname) then
@ -82,14 +82,14 @@ let create_group group =
let maxval l = let maxval l =
match l with match l with
| [] -> None | [] -> None
| [a] -> Some a | [a] -> Some a
| hd::tail -> Some (List.fold_left max hd tail) | hd::tail -> Some (List.fold_left max hd tail)
let minval l = let minval l =
match l with match l with
| [] -> None | [] -> None
| [a] -> Some a | [a] -> Some a
@ -105,10 +105,10 @@ let size (_) = 0
let n_count_ch (str,_,v) = let n_count_ch (str,_,v) =
let rec do_work accu = function let rec do_work accu = function
| 0 -> accu | 0 -> accu
| i -> | i ->
let newaccu = let newaccu =
if str.[i-1] == v then accu+1 if str.[i-1] == v then accu+1
else accu else accu
in do_work newaccu (i-1) in do_work newaccu (i-1)
in do_work 0 (String.length str) in do_work 0 (String.length str)
@ -116,15 +116,15 @@ let n_count_ch (str,_,v) =
let n_count (l,_,v) = let n_count (l,_,v) =
let rec do_work accu = function let rec do_work accu = function
| [] -> accu | [] -> accu
| h::tail -> | h::tail ->
let newaccu = let newaccu =
if h == v then accu+1 if h == v then accu+1
else accu else accu
in do_work newaccu tail in do_work newaccu tail
in do_work 0 l in do_work 0 l
(* (*
Scalars Scalars
======= =======
*) *)
@ -156,7 +156,7 @@ let fortran_string_of_bool = function
| false-> "F\n" | false-> "F\n"
let read_int = read_scalar int_of_string let read_int = read_scalar int_of_string
let read_int64 = read_scalar Int64.of_string let read_int64 = read_scalar Int64.of_string
let read_float = read_scalar float_of_string let read_float = read_scalar float_of_string
let read_string= read_scalar (fun (x:string) -> x) let read_string= read_scalar (fun (x:string) -> x)
@ -183,7 +183,7 @@ let write_scalar print_fun group name s =
close_out out_channel close_out out_channel
end end
let write_int = write_scalar print_int let write_int = write_scalar print_int
let write_int64 = write_scalar print_int64 let write_int64 = write_scalar print_int64
let write_float = write_scalar print_float let write_float = write_scalar print_float
@ -199,7 +199,7 @@ Arrays
*) *)
type 'a ezfio_data = type 'a ezfio_data =
| Ezfio_item of 'a array | Ezfio_item of 'a array
| Ezfio_data of ('a ezfio_data) array | Ezfio_data of ('a ezfio_data) array
@ -210,13 +210,37 @@ type 'a ezfio_array =
data : 'a ezfio_data ; data : 'a ezfio_data ;
} }
let ezfio_array_of_array ~rank ~dim ~data =
assert (rank > 0);
let read_1d data nmax =
(Ezfio_item (Array.sub data 0 nmax), Array.sub data nmax ((Array.length data) - nmax))
in
let rec read_nd data = function
| m when m<1 -> raise (Failure "dimension should not be <1")
| 1 -> read_1d data dim.(0)
| m ->
let rec do_work accu data = function
| 0 -> (Array.of_list (List.rev accu), data)
| n ->
let (newlist,rest) = read_nd data (m-1) in
do_work (newlist::accu) rest (n-1)
in
let (data,rest) = do_work [] data dim.(m-1) in
(Ezfio_data data,rest)
in
let (result,_) = read_nd data rank in
{ rank= rank;
dim= dim;
data=result;
}
let ezfio_array_of_list ~rank ~dim ~data = let ezfio_array_of_list ~rank ~dim ~data =
assert (rank > 0); assert (rank > 0);
let read_1d data nmax = let read_1d data nmax =
let rec do_work accu data = function let rec do_work accu data = function
| 0 -> (Array.of_list (List.rev accu), data) | 0 -> (Array.of_list (List.rev accu), data)
| n -> | n ->
begin begin
match data with match data with
| x::rest -> do_work (x::accu) rest (n-1) | x::rest -> do_work (x::accu) rest (n-1)
@ -237,8 +261,8 @@ let ezfio_array_of_list ~rank ~dim ~data =
do_work (newlist::accu) rest (n-1) do_work (newlist::accu) rest (n-1)
in in
let (data,rest) = do_work [] data dim.(m-1) in let (data,rest) = do_work [] data dim.(m-1) in
(Ezfio_data data,rest) (Ezfio_data data,rest)
in in
let (result,_) = read_nd data rank in let (result,_) = read_nd data rank in
{ rank= rank; { rank= rank;
dim= dim; dim= dim;
@ -250,12 +274,12 @@ let ezfio_array_of_list ~rank ~dim ~data =
let ezfio_get_element { rank=r ; dim=d ; data=data } coord = let ezfio_get_element { rank=r ; dim=d ; data=data } coord =
(*assert ((List.length coord) == r);*) (*assert ((List.length coord) == r);*)
let rec do_work buffer = function let rec do_work buffer = function
| [c] -> | [c] ->
begin match buffer with begin match buffer with
| Ezfio_item buffer -> buffer.(c) | Ezfio_item buffer -> buffer.(c)
| Ezfio_data buffer -> raise (Failure "Error in ezfio_get_element") | Ezfio_data buffer -> raise (Failure "Error in ezfio_get_element")
end end
| c::tail -> | c::tail ->
begin match buffer with begin match buffer with
| Ezfio_item buffer -> raise (Failure "Error in ezfio_get_element") | Ezfio_item buffer -> raise (Failure "Error in ezfio_get_element")
| Ezfio_data buffer -> do_work buffer.(c) tail | Ezfio_data buffer -> do_work buffer.(c) tail
@ -299,7 +323,7 @@ Read
let read_rank in_channel = let read_rank in_channel =
let trimmed_line = String.trim (input_line in_channel) in let trimmed_line = String.trim (input_line in_channel) in
int_of_string trimmed_line int_of_string trimmed_line
let read_dimensions in_channel = let read_dimensions in_channel =
@ -317,7 +341,7 @@ let read_array type_conversion group name : 'a ezfio_array =
let in_filename = (Filename.concat !ezfio_filename @@ Filename.concat group name) ^ ".gz" in let in_filename = (Filename.concat !ezfio_filename @@ Filename.concat group name) ^ ".gz" in
let in_channel = Unix.open_process_in ("zcat "^in_filename) in let in_channel = Unix.open_process_in ("zcat "^in_filename) in
(* Read rank *) (* Read rank *)
let rank = read_rank in_channel let rank = read_rank in_channel
(* Read dimensions *) (* Read dimensions *)
and dimensions = read_dimensions in_channel and dimensions = read_dimensions in_channel
in in
@ -334,7 +358,7 @@ let read_array type_conversion group name : 'a ezfio_array =
let rec read_nd = function let rec read_nd = function
| m when m<1 -> raise (Failure "dimension should not be <1") | m when m<1 -> raise (Failure "dimension should not be <1")
| 1 -> read_1d dimensions.(0) | 1 -> read_1d dimensions.(0)
| m -> | m ->
let rec do_work accu = function let rec do_work accu = function
| 0 -> Array.of_list (List.rev accu) | 0 -> Array.of_list (List.rev accu)
| n -> | n ->
@ -342,19 +366,19 @@ let read_array type_conversion group name : 'a ezfio_array =
do_work (newlist::accu) (n-1) do_work (newlist::accu) (n-1)
in in
Ezfio_data (do_work [] dimensions.(m-1)) Ezfio_data (do_work [] dimensions.(m-1))
in in
let result = { let result = {
rank = rank ; rank = rank ;
dim = dimensions ; dim = dimensions ;
data = read_nd rank ; data = read_nd rank ;
} }
in in
match Unix.close_process_in in_channel with match Unix.close_process_in in_channel with
| Unix.WEXITED _ -> result | Unix.WEXITED _ -> result
| _ -> failwith ("Failed in reading compressed file "^in_filename) | _ -> failwith ("Failed in reading compressed file "^in_filename)
end end
let read_int_array = read_array int_of_string let read_int_array = read_array int_of_string
let read_int64_array = read_array Int64.of_string let read_int64_array = read_array Int64.of_string
let read_float_array = read_array float_of_string let read_float_array = read_array float_of_string
@ -375,7 +399,7 @@ let write_array print_fun group name a =
let out_channel = Unix.open_process_out command in let out_channel = Unix.open_process_out command in
let { rank=rank ; dim=dimensions ; data=data } = a in let { rank=rank ; dim=dimensions ; data=data } = a in
let data = flattened_ezfio a in let data = flattened_ezfio a in
begin begin
(* Write rank *) (* Write rank *)
Printf.fprintf out_channel "%3d\n" rank; Printf.fprintf out_channel "%3d\n" rank;
(* Write dimensions *) (* Write dimensions *)
@ -384,7 +408,7 @@ let write_array print_fun group name a =
Array.iter (print_fun out_channel) data; Array.iter (print_fun out_channel) data;
match Unix.close_process_out out_channel with match Unix.close_process_out out_channel with
| Unix.WEXITED _ -> () | Unix.WEXITED _ -> ()
| _ -> failwith ("Failed writing compressed file "^out_filename) | _ -> failwith ("Failed writing compressed file "^out_filename)
end end