Contents of /MITgcm/utils/scripts/joinmds

#!/usr/local/bin/perl -w

# MITgcmUV DataSet joining utility.
# Tested with perl 4.0 and newer.
# Tested on Linux 2.0.27/I486, Irix 6.2/{IP22,IP25}
# Zhangfan XING, xing@pacific.jpl.nasa.gov
# Adapted to work with MDS I/O format by adcroft@mit.edu, 5/7/1999
#
# LOGS:
# 980707, version 0.0.1, basically works
# 980721, version 0.2.0, proper handling of data file's header and terminator
#         for diff bytesex.
# 990507, HACK'd by AJA. Needs to be properly merged with the original joinds

#------
# usage
#------
sub usage {
	print STDERR
		"\nUsage:$0 [-Ddir0 -Ddir1 ...] " .
		"prefix suffix [(little-endian|big-endian)]\n"; 
	print STDERR "\nMITgcmUV DataSet joining utility, version 0.3.0\n";
	print STDERR
	"Check http://escher.jpl.nasa.gov:2000/tools/ for newer version.\n";
	print STDERR "Report problem to xing\@pacific.jpl.nasa.gov\n\n";
	exit 1;
}

#------------------------------
# product of a list of integers
#------------------------------
sub listprod {
	local ($product) = 1;
	local ($x);
	foreach $x (@_) {
		$product *= $x;
	}
	$product;
}

#----------------
# @list1 + @list2
#----------------
sub lists_add {
	local (*l1,*l2) = @_;
	($#l1 == $#l2) || return undef;

	local (@l);
	for (local($i)=0;$i<=$#l1;$i++) {
		$l[$i]=$l1[$i]+$l2[$i];
	}
	@l;
}

#-------------
# pos to index
# 0-based.
#-------------
sub pos2index {

	local ($pos,@dim) = @_;
	local ($rightmost) = pop(@dim);

	local (@index,$d);
	foreach $d (@dim) {
		push(@index,$pos%$d);
		$pos = int($pos/$d);
	}

	# self-guarding
	unless ($rightmost > $pos) {
		return undef;
	}

	push(@index,$pos);
	@index;
}

#-------------
# index to pos
# 0-based.
#-------------
sub index2pos {
	local (*index,*dim) = @_;

	return undef unless ($#index == $#dim);

	local ($pos) = $index[$#index];
	for (local($i)=$#dim;$i>0;$i--) {
		$pos = $pos * $dim[$i-1] + $index[$i-1];
	}
	$pos;
}

#-------------------------
# check machine's bytesex.
# returns "little-endian" or "big-endian"
# or dies if unable to figure out
#-------------------------
sub mach_bytesex {

	local ($foo)  = pack("s2",1,2);
	if ($foo eq "\1\0\2\0") {
		return "little-endian";
	} elsif ($foo eq "\0\1\0\2") {
		return "big-endian";
	} else {
		die "Your machine has a strange bytesex.\n".
		"Email your platform info to xing\@pacific.jpl.nasa.gov\n";
	}
}

#--------------------------------------------------
# check bytesex of a fortran unformatted data file
# current machine's bytesex is used as a reference.
# returns: one of "little-endian", "big-endian", "undecidable" and "unknown"
#--------------------------------------------------
sub file_bytesex {

	# only if this platform's bytesex is either big- or little-endian
	# otherwise dies. Hope this won't happen.
	local($mach_bytesex) = &mach_bytesex();

	local ($file) = shift;
	local (*FILE);

	open(FILE,$file) || die "$file: $!\n";

	local(@fstat) = stat(FILE);
	local ($size) = $fstat[7] - 8;	# total data size in bytes

	local($hdr,$tmr) = ("","");
	read(FILE,$hdr,4);
	seek(FILE,-4,2);
	read(FILE,$tmr,4);
	close(FILE);

	# this part checks for self-consistency of Fortran unformatted file
	($hdr eq $tmr) || die "$file: not a Fortran unformatted data file.\n";

	local ($ori) = unpack("I",$hdr);
	local ($rev) = unpack("I",join("",reverse(split(//,$hdr))));

	($ori != $size && $rev != $size) &&
		return "unknown";

	($ori == $size && $rev == $size) &&
		return "undecidable";

	local ($opposite) = ($mach_bytesex eq "little-endian") ?
				"big-endian" : "little-endian";

	return ($ori == $size) ? $mach_bytesex : $opposite;

}

#--------------------------------
# check meta info for one dataset
#--------------------------------

sub check_meta {

	local ($ds,$dir) = @_;
	local ($fmeta) = "$dir/$ds.meta";

	#~~~~~~~~~~~~~~~~
	# check meta info
	#~~~~~~~~~~~~~~~~

	undef $/;		# read to the end of file
	open(MFILE,"<$fmeta") || die "$fmeta: $!\n";
	$_=<MFILE>;
	close(MFILE);
	$/ = "\n";		# never mess up
	
	s/\([^)]*\)//g;         #rm (.*)
	s/\/\/[^\n]*\n//g;      #rm comment lines
	s/\/\*.*\*\///g;        #rm inline comments
	s/\s+//g;               #rm white spaces
	/nDims=\[(.+)\];dimList=\[(.+)\];format=\['(.+)'\];nrecords=\[(.+)\];timeStepNumber=\[(.+)\];/
		|| die "$fmeta: meta file format error\n";
	local ($nDims_,$dimList_,$format_,$nrecords_,$timeStepNumber_) = ($1,$2,$3,$4,$5);

	# check Identifier
	(defined $timeStepNumber) || ($timeStepNumber = $timeStepNumber_);
	($timeStepNumber eq $timeStepNumber_) ||
		die "$fmeta: timeStepNumber $timeStepNumber_ inconsistent with other dataset\n";

	# check Number of dimensions
	(defined $nDims) || ($nDims = $nDims_);
	($nDims eq $nDims_) ||
		die "$fmeta: nDims $nDims_ inconsistent with other dataset\n";

	# check Field format
	(defined $format) || ($format = $format_);
	($format eq $format_) ||
		die "$fmeta: format $format_ inconsistent with other dataset\n";

	# check dimList
	# calc dimesions and leading index of this subset
	local (@dimList_) = split(/,/,$dimList_);

 	($nDims_*3 == $#dimList_+1) ||
		die "$fmeta: nDims and dimList conflicting\n";
	
	local (@Dim,@dim,@Index0) = ();
	for (local($i)=0;$i<$nDims_;$i++) {
		push(@Dim,$dimList_[$i*3]);
		push(@dim,$dimList_[$i*3+2]-$dimList_[$i*3+1]+1);
		push(@Index0,$dimList_[$i*3+1]-1);
	}
	local ($Dim_) = join(",",@Dim);
	local ($dim_) = join(",",@dim);

	(defined $Dim) || ($Dim = $Dim_);
	($Dim eq $Dim_) ||
		die "$fmeta: dimList Global inconsistent with other dataset\n";

	(defined $dim) || ($dim = $dim_);
	($dim eq $dim_) ||
		die "$fmeta: dimList Local inconsistent with other dataset\n";

	$ds_Index0{$ds} = join(",", @Index0);

#	print STDOUT "Okay $fmeta\n";
}

#-------------------------------
# check completeness of datasets
# need to be more sophisticated
#-------------------------------
sub check_entirety {

	local (*Dim,*dim,*ds_Index0) = @_;

	local ($N) = &listprod(@Dim);
	local ($n) = &listprod(@dim);
	($N) || return 0;		# against null dimension
	($n) || return 0;		# against null dimension
	($N%$n) && return 0;		# $N/$n must be a whole number

	local (@ds) = keys %ds_Index0;
	($#ds+1 == $N/$n) || return 0;	# Num of datasets must match subdomain

	1;
}

#------------------
# merge one dataset
# assume @Dim, @dim and $bytes existing
# assume $Byte_Reorder existing
#------------------
sub merge_data {

	local ($ds,$dir,*Index0) = @_;
	local ($fdata) = "$dir/$ds.data";

	# data size of one subset in bytes as told by meta info
	local ($size) = &listprod(@dim) * $bytes;

	open(DFILE, "<$fdata") || die "$fdata: $!\n";

	local ($raw) = "";
#aja	sysread(DFILE,$raw,4);
	# Swap header if bytesex is diff from machine's
	local ($hdr);
	if ($Byte_Reorder) {
		$hdr = unpack("I",join("",reverse(split(//,$raw))));
	} else {
		$hdr = unpack("I",$raw);
	}

#aja	($size == $hdr) ||
#aja		die "$fdata: $hdr bytes inconsistent with meta info\n";

	print STDOUT "$ds.data: $size bytes, okay, ";

#	seek(DFILE,4,0);	# rewind back to the beginning of data

	local ($data) = "";		# old perl (< 4.0) needs this to 
	sysread(DFILE,$data,$size);	# avoid warning by sysread() 
	local ($len_chunk) = $dim[0] * $bytes;
	local ($num_chunk) = $size/$len_chunk;

	local ($pos,@index,$Pos,@Index);
	for (local($i)=0;$i<$num_chunk;$i++) {
		$pos = $i * $dim[0];
		@index = &pos2index($pos,@dim);
		@Index = &lists_add(*index,*Index0);
		$Pos = &index2pos(*Index,*Dim);
#aja		seek(FILE,$Pos*$bytes+4,0);
		seek(FILE,$Pos*$bytes,0);
		syswrite(FILE,$data,$len_chunk,$pos*$bytes);
	}

	close(DFILE);

	print STDOUT "merged from $dir\n";
}

#============
# main script
#============

#------------
# parse @ARGV
#............

($#ARGV >= 1) || &usage();

undef @dirs;
while (1) {
	$x = shift(@ARGV);
	unless ($x =~ /^-D(.+)$/) {
		unshift(@ARGV,$x);
		last;
	}
	push(@dirs,$1);
}
(@dirs) || push(@dirs,".");
# @dirs is not empty after this line.
#print STDOUT join(" ",@dirs), "\n";

($#ARGV >= 1) || &usage();

# data set prefix and suffix
$pref = shift(@ARGV);
$suff = shift(@ARGV);

($#ARGV >= 1) && &usage();
undef $forced_bytesex;
if (@ARGV) {
	$forced_bytesex = shift(@ARGV);
	$forced_bytesex =~ /^(little|big)-endian$/ || &usage();
}
#print STDOUT $forced_bytesex, "\n";

#--------------------------
# obtain a list of datasets
#..........................

# %ds_dir is a hash to store the directory that a dataset is in.
# After this step, it is assured that, for a dataset $ds,
# both $ds.meta and $ds.data exist in a unique dir $ds_dir{$ds}.

%ds_dir = ();
foreach $dir (@dirs) {
	opendir(DIR, $dir) || die "$dir: $!\n";
	@fmeta = grep(/^$pref\.$suff\.\d+\.\d+\.meta$/, readdir(DIR));
	closedir(DIR);
	foreach $fmeta (@fmeta) {
		$ds = $fmeta; $ds =~ s/\.meta$//g;
		(defined $ds_dir{$ds}) &&
			die "$fmeta appears in two dirs: $ds_dir{$ds} & $dir\n";
		(-f "$dir/$ds.data") || die "In $dir, $ds.data missing\n";
		$ds_dir{$ds} = $dir;
	}
}

@ds = sort(keys %ds_dir);	 # list of datasets
(@ds) || die "No dataset found.\n";
print STDOUT "There are ", $#ds+1, " datasets.\n";

#---------------------------------
# check meta info for all datasets
#.................................

undef $timeStepNumber;
undef $nDims;
undef $format;

undef $Dim;
undef $dim;
undef %ds_Index0;

#..............................................
# check each meta file and set some global vars

foreach $ds (@ds) {
	&check_meta($ds,$ds_dir{$ds});
}
print STDOUT "All existing meta files are self- and mutually consistent.\n";

#print join(" ",$timeStepNumber,$nDims,$format,$Dim,$dim), "\n";
#foreach $ds (@ds) {
#	$dir = $ds_dir{$ds};
#	$Index0 = $ds_Index0{$ds};
#	print "$ds\n";
#	print "$Index0\n";
#}

@Dim = split(/,/,$Dim);
@dim = split(/,/,$dim);

#................................
# check meta info in its entirety

&check_entirety(*Dim,*dim,*ds_Index0) ||
	die "Datasets are not complete!\n";

print STDOUT "Datasets are complete.\n";

#...........
# set $bytes

if ($format eq "float32") {
	$bytes = 4;
} elsif ($format eq "float64") {
	$bytes = 8
} else {
	die "format '$format' unknown\n";
}

#---------------------------
# check and merge data files
#...........................

#........................
# check machine's bytesex
# it dies if neither little- nor big-endian.

$Mach_Bytesex = &mach_bytesex();
print STDOUT "Current machine's endianness: $Mach_Bytesex\n";

#...................
# check file bytesex and resolve related issues
#aja undef $File_Bytesex;
#aja foreach $ds (@ds) {
#aja 	$fdata = "$ds.data";
#aja 	$file_bytesex = &file_bytesex($ds_dir{$ds}."/$fdata");
#aja 	($file_bytesex eq "unknown") &&
#aja 		die "$fdata: endianness is neither little- nor big-endian.\n";
#aja 	print STDOUT "$fdata: $file_bytesex\n";
#aja 	unless ($File_Bytesex) {
#aja 		$File_Bytesex = $file_bytesex;
#aja 	} else {
#aja 		($File_Bytesex eq $file_bytesex) ||
#aja 		die "Data files are mutually inconsistent in endianness\n";
#aja 	}
#aja }
$File_Bytesex = 'big-endian';

#------------------
# set $Byte_Reorder, which controls swapping of bytes in
# header and terminator of Fortran unformatted data files.
#aja $Byte_Reorder = 0;
$Byte_Reorder = 0;

# if machine and data file have the same bytesex, no need for swapping
#aja ($File_Bytesex eq $Mach_Bytesex) && ($Byte_Reorder = 0);

# if we can't determine bytesex of data file, need forced one from @ARGV.
if ($File_Bytesex eq "undecidable") {
	# if no forced bytesex available, dies.
	($forced_bytesex) ||
		die "Endianness of data files is undecidable, " .
		"you have to give one at command line.\n";
	($forced_bytesex eq $Mach_Bytesex) && ($Byte_Reorder = 0);
	print STDOUT "Endianness of data files is undecidable.\n";
	print STDOUT "Data file header/tail will be treated as ";
	print STDOUT "$forced_bytesex as you have instructed.\n";
# otherwise
} else {
# give a warining, if swapping is needed.
($Byte_Reorder) &&
	print STDOUT
	"Please note: data files have different bytesex than machine!\n";
}

#................
# merge data sets

$Size = &listprod(@Dim) * $bytes;

$fout = "$pref.$suff.data";

open(FILE, ">$fout") || die "$fout: $!\n";

# prepare header and teminator. Do byte reordering if necessary
$HdrTmr = pack("I",$Size);
($Byte_Reorder) && ($HdrTmr = join("",reverse(split(//,$HdrTmr))));

# write 4 byte header
#aja syswrite(FILE,$HdrTmr,4);

# merge each dataset
foreach $ds (@ds) {
	$dir = $ds_dir{$ds};
	@Index0 = split(/,/,$ds_Index0{$ds});
	&merge_data($ds,$dir,*Index0);
}

# write 4 byte terminator
#aja seek(FILE,$Size+4,0);
#aja syswrite(FILE,$HdrTmr,4);

close(FILE);

print STDOUT "Global data (" .
	join("x",@Dim) .
	") is in ./$fout (endianness is $File_Bytesex).\n";

exit 0;
1	#!/usr/local/bin/perl -w
2
3	# MITgcmUV DataSet joining utility.
4	# Tested with perl 4.0 and newer.
5	# Tested on Linux 2.0.27/I486, Irix 6.2/{IP22,IP25}
6	# Zhangfan XING, xing@pacific.jpl.nasa.gov
7	# Adapted to work with MDS I/O format by adcroft@mit.edu, 5/7/1999
8	#
9	# LOGS:
10	# 980707, version 0.0.1, basically works
11	# 980721, version 0.2.0, proper handling of data file's header and terminator
12	# for diff bytesex.
13	# 990507, HACK'd by AJA. Needs to be properly merged with the original joinds
14
15	#------
16	# usage
17	#------
18	sub usage {
19	print STDERR
20	"\nUsage:$0 [-Ddir0 -Ddir1 ...] " .
21	"prefix suffix [(little-endian\|big-endian)]\n";
22	print STDERR "\nMITgcmUV DataSet joining utility, version 0.3.0\n";
23	print STDERR
24	"Check http://escher.jpl.nasa.gov:2000/tools/ for newer version.\n";
25	print STDERR "Report problem to xing\@pacific.jpl.nasa.gov\n\n";
26	exit 1;
27	}
28
29	#------------------------------
30	# product of a list of integers
31	#------------------------------
32	sub listprod {
33	local ($product) = 1;
34	local ($x);
35	foreach $x (@_) {
36	$product *= $x;
37	}
38	$product;
39	}
40
41	#----------------
42	# @list1 + @list2
43	#----------------
44	sub lists_add {
45	local (l1,l2) = @_;
46	($#l1 == $#l2) \|\| return undef;
47
48	local (@l);
49	for (local($i)=0;$i<=$#l1;$i++) {
50	$l[$i]=$l1[$i]+$l2[$i];
51	}
52	@l;
53	}
54
55	#-------------
56	# pos to index
57	# 0-based.
58	#-------------
59	sub pos2index {
60
61	local ($pos,@dim) = @_;
62	local ($rightmost) = pop(@dim);
63
64	local (@index,$d);
65	foreach $d (@dim) {
66	push(@index,$pos%$d);
67	$pos = int($pos/$d);
68	}
69
70	# self-guarding
71	unless ($rightmost > $pos) {
72	return undef;
73	}
74
75	push(@index,$pos);
76	@index;
77	}
78
79	#-------------
80	# index to pos
81	# 0-based.
82	#-------------
83	sub index2pos {
84	local (index,dim) = @_;
85
86	return undef unless ($#index == $#dim);
87
88	local ($pos) = $index[$#index];
89	for (local($i)=$#dim;$i>0;$i--) {
90	$pos = $pos * $dim[$i-1] + $index[$i-1];
91	}
92	$pos;
93	}
94
95	#-------------------------
96	# check machine's bytesex.
97	# returns "little-endian" or "big-endian"
98	# or dies if unable to figure out
99	#-------------------------
100	sub mach_bytesex {
101
102	local ($foo) = pack("s2",1,2);
103	if ($foo eq "\1\0\2\0") {
104	return "little-endian";
105	} elsif ($foo eq "\0\1\0\2") {
106	return "big-endian";
107	} else {
108	die "Your machine has a strange bytesex.\n".
109	"Email your platform info to xing\@pacific.jpl.nasa.gov\n";
110	}
111	}
112
113	#--------------------------------------------------
114	# check bytesex of a fortran unformatted data file
115	# current machine's bytesex is used as a reference.
116	# returns: one of "little-endian", "big-endian", "undecidable" and "unknown"
117	#--------------------------------------------------
118	sub file_bytesex {
119
120	# only if this platform's bytesex is either big- or little-endian
121	# otherwise dies. Hope this won't happen.
122	local($mach_bytesex) = &mach_bytesex();
123
124	local ($file) = shift;
125	local (*FILE);
126
127	open(FILE,$file) \|\| die "$file: $!\n";
128
129	local(@fstat) = stat(FILE);
130	local ($size) = $fstat[7] - 8; # total data size in bytes
131
132	local($hdr,$tmr) = ("","");
133	read(FILE,$hdr,4);
134	seek(FILE,-4,2);
135	read(FILE,$tmr,4);
136	close(FILE);
137
138	# this part checks for self-consistency of Fortran unformatted file
139	($hdr eq $tmr) \|\| die "$file: not a Fortran unformatted data file.\n";
140
141	local ($ori) = unpack("I",$hdr);
142	local ($rev) = unpack("I",join("",reverse(split(//,$hdr))));
143
144	($ori != $size && $rev != $size) &&
145	return "unknown";
146
147	($ori == $size && $rev == $size) &&
148	return "undecidable";
149
150	local ($opposite) = ($mach_bytesex eq "little-endian") ?
151	"big-endian" : "little-endian";
152
153	return ($ori == $size) ? $mach_bytesex : $opposite;
154
155	}
156
157	#--------------------------------
158	# check meta info for one dataset
159	#--------------------------------
160
161	sub check_meta {
162
163	local ($ds,$dir) = @_;
164	local ($fmeta) = "$dir/$ds.meta";
165
166	#~~~~~~~~~~~~~~~~
167	# check meta info
168	#~~~~~~~~~~~~~~~~
169
170	undef $/; # read to the end of file
171	open(MFILE,"<$fmeta") \|\| die "$fmeta: $!\n";
172	$_=<MFILE>;
173	close(MFILE);
174	$/ = "\n"; # never mess up
175
176	s/\([^)]\)//g; #rm (.)
177	s/\/\/[^\n]*\n//g; #rm comment lines
178	s/\/\.\*\///g; #rm inline comments
179	s/\s+//g; #rm white spaces
180	/nDims=\[(.+)\];dimList=\[(.+)\];format=\['(.+)'\];nrecords=\[(.+)\];timeStepNumber=\[(.+)\];/
181	\|\| die "$fmeta: meta file format error\n";
182	local ($nDims_,$dimList_,$format_,$nrecords_,$timeStepNumber_) = ($1,$2,$3,$4,$5);
183
184	# check Identifier
185	(defined $timeStepNumber) \|\| ($timeStepNumber = $timeStepNumber_);
186	($timeStepNumber eq $timeStepNumber_) \|\|
187	die "$fmeta: timeStepNumber $timeStepNumber_ inconsistent with other dataset\n";
188
189	# check Number of dimensions
190	(defined $nDims) \|\| ($nDims = $nDims_);
191	($nDims eq $nDims_) \|\|
192	die "$fmeta: nDims $nDims_ inconsistent with other dataset\n";
193
194	# check Field format
195	(defined $format) \|\| ($format = $format_);
196	($format eq $format_) \|\|
197	die "$fmeta: format $format_ inconsistent with other dataset\n";
198
199	# check dimList
200	# calc dimesions and leading index of this subset
201	local (@dimList_) = split(/,/,$dimList_);
202
203	($nDims_*3 == $#dimList_+1) \|\|
204	die "$fmeta: nDims and dimList conflicting\n";
205
206	local (@Dim,@dim,@Index0) = ();
207	for (local($i)=0;$i<$nDims_;$i++) {
208	push(@Dim,$dimList_[$i*3]);
209	push(@dim,$dimList_[$i3+2]-$dimList_[$i3+1]+1);
210	push(@Index0,$dimList_[$i*3+1]-1);
211	}
212	local ($Dim_) = join(",",@Dim);
213	local ($dim_) = join(",",@dim);
214
215	(defined $Dim) \|\| ($Dim = $Dim_);
216	($Dim eq $Dim_) \|\|
217	die "$fmeta: dimList Global inconsistent with other dataset\n";
218
219	(defined $dim) \|\| ($dim = $dim_);
220	($dim eq $dim_) \|\|
221	die "$fmeta: dimList Local inconsistent with other dataset\n";
222
223	$ds_Index0{$ds} = join(",", @Index0);
224
225	# print STDOUT "Okay $fmeta\n";
226	}
227
228	#-------------------------------
229	# check completeness of datasets
230	# need to be more sophisticated
231	#-------------------------------
232	sub check_entirety {
233
234	local (Dim,dim,*ds_Index0) = @_;
235
236	local ($N) = &listprod(@Dim);
237	local ($n) = &listprod(@dim);
238	($N) \|\| return 0; # against null dimension
239	($n) \|\| return 0; # against null dimension
240	($N%$n) && return 0; # $N/$n must be a whole number
241
242	local (@ds) = keys %ds_Index0;
243	($#ds+1 == $N/$n) \|\| return 0; # Num of datasets must match subdomain
244
245	1;
246	}
247
248	#------------------
249	# merge one dataset
250	# assume @Dim, @dim and $bytes existing
251	# assume $Byte_Reorder existing
252	#------------------
253	sub merge_data {
254
255	local ($ds,$dir,*Index0) = @_;
256	local ($fdata) = "$dir/$ds.data";
257
258	# data size of one subset in bytes as told by meta info
259	local ($size) = &listprod(@dim) * $bytes;
260
261	open(DFILE, "<$fdata") \|\| die "$fdata: $!\n";
262
263	local ($raw) = "";
264	#aja sysread(DFILE,$raw,4);
265	# Swap header if bytesex is diff from machine's
266	local ($hdr);
267	if ($Byte_Reorder) {
268	$hdr = unpack("I",join("",reverse(split(//,$raw))));
269	} else {
270	$hdr = unpack("I",$raw);
271	}
272
273	#aja ($size == $hdr) \|\|
274	#aja die "$fdata: $hdr bytes inconsistent with meta info\n";
275
276	print STDOUT "$ds.data: $size bytes, okay, ";
277
278	# seek(DFILE,4,0); # rewind back to the beginning of data
279
280	local ($data) = ""; # old perl (< 4.0) needs this to
281	sysread(DFILE,$data,$size); # avoid warning by sysread()
282	local ($len_chunk) = $dim[0] * $bytes;
283	local ($num_chunk) = $size/$len_chunk;
284
285	local ($pos,@index,$Pos,@Index);
286	for (local($i)=0;$i<$num_chunk;$i++) {
287	$pos = $i * $dim[0];
288	@index = &pos2index($pos,@dim);
289	@Index = &lists_add(index,Index0);
290	$Pos = &index2pos(Index,Dim);
291	#aja seek(FILE,$Pos*$bytes+4,0);
292	seek(FILE,$Pos*$bytes,0);
293	syswrite(FILE,$data,$len_chunk,$pos*$bytes);
294	}
295
296	close(DFILE);
297
298	print STDOUT "merged from $dir\n";
299	}
300
301	#============
302	# main script
303	#============
304
305	#------------
306	# parse @ARGV
307	#............
308
309	($#ARGV >= 1) \|\| &usage();
310
311	undef @dirs;
312	while (1) {
313	$x = shift(@ARGV);
314	unless ($x =~ /^-D(.+)$/) {
315	unshift(@ARGV,$x);
316	last;
317	}
318	push(@dirs,$1);
319	}
320	(@dirs) \|\| push(@dirs,".");
321	# @dirs is not empty after this line.
322	#print STDOUT join(" ",@dirs), "\n";
323
324	($#ARGV >= 1) \|\| &usage();
325
326	# data set prefix and suffix
327	$pref = shift(@ARGV);
328	$suff = shift(@ARGV);
329
330	($#ARGV >= 1) && &usage();
331	undef $forced_bytesex;
332	if (@ARGV) {
333	$forced_bytesex = shift(@ARGV);
334	$forced_bytesex =~ /^(little\|big)-endian$/ \|\| &usage();
335	}
336	#print STDOUT $forced_bytesex, "\n";
337
338	#--------------------------
339	# obtain a list of datasets
340	#..........................
341
342	# %ds_dir is a hash to store the directory that a dataset is in.
343	# After this step, it is assured that, for a dataset $ds,
344	# both $ds.meta and $ds.data exist in a unique dir $ds_dir{$ds}.
345
346	%ds_dir = ();
347	foreach $dir (@dirs) {
348	opendir(DIR, $dir) \|\| die "$dir: $!\n";
349	@fmeta = grep(/^$pref\.$suff\.\d+\.\d+\.meta$/, readdir(DIR));
350	closedir(DIR);
351	foreach $fmeta (@fmeta) {
352	$ds = $fmeta; $ds =~ s/\.meta$//g;
353	(defined $ds_dir{$ds}) &&
354	die "$fmeta appears in two dirs: $ds_dir{$ds} & $dir\n";
355	(-f "$dir/$ds.data") \|\| die "In $dir, $ds.data missing\n";
356	$ds_dir{$ds} = $dir;
357	}
358	}
359
360	@ds = sort(keys %ds_dir); # list of datasets
361	(@ds) \|\| die "No dataset found.\n";
362	print STDOUT "There are ", $#ds+1, " datasets.\n";
363
364	#---------------------------------
365	# check meta info for all datasets
366	#.................................
367
368	undef $timeStepNumber;
369	undef $nDims;
370	undef $format;
371
372	undef $Dim;
373	undef $dim;
374	undef %ds_Index0;
375
376	#..............................................
377	# check each meta file and set some global vars
378
379	foreach $ds (@ds) {
380	&check_meta($ds,$ds_dir{$ds});
381	}
382	print STDOUT "All existing meta files are self- and mutually consistent.\n";
383
384	#print join(" ",$timeStepNumber,$nDims,$format,$Dim,$dim), "\n";
385	#foreach $ds (@ds) {
386	# $dir = $ds_dir{$ds};
387	# $Index0 = $ds_Index0{$ds};
388	# print "$ds\n";
389	# print "$Index0\n";
390	#}
391
392	@Dim = split(/,/,$Dim);
393	@dim = split(/,/,$dim);
394
395	#................................
396	# check meta info in its entirety
397
398	&check_entirety(Dim,dim,*ds_Index0) \|\|
399	die "Datasets are not complete!\n";
400
401	print STDOUT "Datasets are complete.\n";
402
403	#...........
404	# set $bytes
405
406	if ($format eq "float32") {
407	$bytes = 4;
408	} elsif ($format eq "float64") {
409	$bytes = 8
410	} else {
411	die "format '$format' unknown\n";
412	}
413
414	#---------------------------
415	# check and merge data files
416	#...........................
417
418	#........................
419	# check machine's bytesex
420	# it dies if neither little- nor big-endian.
421
422	$Mach_Bytesex = &mach_bytesex();
423	print STDOUT "Current machine's endianness: $Mach_Bytesex\n";
424
425	#...................
426	# check file bytesex and resolve related issues
427	#aja undef $File_Bytesex;
428	#aja foreach $ds (@ds) {
429	#aja $fdata = "$ds.data";
430	#aja $file_bytesex = &file_bytesex($ds_dir{$ds}."/$fdata");
431	#aja ($file_bytesex eq "unknown") &&
432	#aja die "$fdata: endianness is neither little- nor big-endian.\n";
433	#aja print STDOUT "$fdata: $file_bytesex\n";
434	#aja unless ($File_Bytesex) {
435	#aja $File_Bytesex = $file_bytesex;
436	#aja } else {
437	#aja ($File_Bytesex eq $file_bytesex) \|\|
438	#aja die "Data files are mutually inconsistent in endianness\n";
439	#aja }
440	#aja }
441	$File_Bytesex = 'big-endian';
442
443	#------------------
444	# set $Byte_Reorder, which controls swapping of bytes in
445	# header and terminator of Fortran unformatted data files.
446	#aja $Byte_Reorder = 0;
447	$Byte_Reorder = 0;
448
449	# if machine and data file have the same bytesex, no need for swapping
450	#aja ($File_Bytesex eq $Mach_Bytesex) && ($Byte_Reorder = 0);
451
452	# if we can't determine bytesex of data file, need forced one from @ARGV.
453	if ($File_Bytesex eq "undecidable") {
454	# if no forced bytesex available, dies.
455	($forced_bytesex) \|\|
456	die "Endianness of data files is undecidable, " .
457	"you have to give one at command line.\n";
458	($forced_bytesex eq $Mach_Bytesex) && ($Byte_Reorder = 0);
459	print STDOUT "Endianness of data files is undecidable.\n";
460	print STDOUT "Data file header/tail will be treated as ";
461	print STDOUT "$forced_bytesex as you have instructed.\n";
462	# otherwise
463	} else {
464	# give a warining, if swapping is needed.
465	($Byte_Reorder) &&
466	print STDOUT
467	"Please note: data files have different bytesex than machine!\n";
468	}
469
470	#................
471	# merge data sets
472
473	$Size = &listprod(@Dim) * $bytes;
474
475	$fout = "$pref.$suff.data";
476
477	open(FILE, ">$fout") \|\| die "$fout: $!\n";
478
479	# prepare header and teminator. Do byte reordering if necessary
480	$HdrTmr = pack("I",$Size);
481	($Byte_Reorder) && ($HdrTmr = join("",reverse(split(//,$HdrTmr))));
482
483	# write 4 byte header
484	#aja syswrite(FILE,$HdrTmr,4);
485
486	# merge each dataset
487	foreach $ds (@ds) {
488	$dir = $ds_dir{$ds};
489	@Index0 = split(/,/,$ds_Index0{$ds});
490	&merge_data($ds,$dir,*Index0);
491	}
492
493	# write 4 byte terminator
494	#aja seek(FILE,$Size+4,0);
495	#aja syswrite(FILE,$HdrTmr,4);
496
497	close(FILE);
498
499	print STDOUT "Global data (" .
500	join("x",@Dim) .
501	") is in ./$fout (endianness is $File_Bytesex).\n";
502
503	exit 0;