Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Earth Sciences
easyNCDF
Commits
3f53aa44
Commit
3f53aa44
authored
Mar 30, 2017
by
Nicolau Manubens
Browse files
Merge branch 'master' of
http://earth.bsc.es/gitlab/es/easyNCDF
parents
32e2ddb4
6297b73e
Changes
2
Hide whitespace changes
Inline
Side-by-side
R/ArrayToNc.R
View file @
3f53aa44
ArrayToN
c
<-
function
(
arrays
,
file_path
)
{
ArrayToN
etCDF
<-
function
(
arrays
,
file_path
)
{
# Check parameter arrays.
if
(
is.array
(
arrays
))
{
arrays
<-
list
(
arrays
)
...
...
@@ -98,7 +98,7 @@ ArrayToNc <- function(arrays, file_path) {
if
(
!
(
'vals'
%in%
names
(
dim_info
)))
{
dim_info
[[
'vals'
]]
<-
1
:
dim_info
[[
'len'
]]
}
else
{
if
(
!
is.numeric
(
dim_info
[[
'vals'
]]))
{
if
(
!
(
is.numeric
(
dim_info
[[
'vals'
]]))
)
{
stop
(
"The provided 'vals' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a numeric vector."
)
}
if
(
dim_info
[[
'units'
]]
==
''
)
{
...
...
@@ -301,7 +301,7 @@ ArrayToNc <- function(arrays, file_path) {
}
ncatt_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
'coordinates'
,
paste
(
coords
,
collapse
=
' '
))
}
attrs_to_skip
<-
which
(
names
(
var_info
)
%in%
c
(
'addOffset'
,
'scaleFact'
,
'coordinates'
))
attrs_to_skip
<-
which
(
names
(
var_info
)
%in%
c
(
'addOffset'
,
'scaleFact'
,
'coordinates'
,
'dim'
))
attrs_to_add
<-
names
(
var_info
)
if
(
length
(
attrs_to_skip
)
>
0
)
{
attrs_to_add
<-
attrs_to_add
[
-
attrs_to_skip
]
...
...
@@ -318,5 +318,3 @@ ArrayToNc <- function(arrays, file_path) {
nc_close
(
ncdf_object
)
invisible
(
NULL
)
}
a2nc
<-
ArrayToNc
R/ArrayToNetCDF.R
deleted
100644 → 0
View file @
32e2ddb4
ArrayToNetCDF
<-
function
(
arrays
,
file_path
)
{
# Check parameter arrays.
if
(
is.array
(
arrays
))
{
arrays
<-
list
(
arrays
)
}
if
(
any
(
!
sapply
(
arrays
,
function
(
x
)
is.array
(
x
)
&&
(
is.numeric
(
x
)
||
is.logical
(
x
)))))
{
stop
(
"The parameter 'arrays' must be one or a list of numeric or logical arrays."
)
}
# Check parameter file_path.
if
(
!
is.character
(
file_path
))
{
stop
(
"Parameter 'file_path' must be a character string."
)
}
defined_dims
<-
list
()
defined_vars
<-
list
()
global_attrs
<-
list
()
var_dim
<-
NULL
for
(
i
in
1
:
length
(
arrays
))
{
array_attrs
<-
attributes
(
arrays
[[
i
]])
if
(
'variables'
%in%
names
(
array_attrs
))
{
vars_info
<-
array_attrs
[[
'variables'
]]
array_attrs
<-
array_attrs
[
-
which
(
names
(
array_attrs
)
==
'variables'
)]
}
else
{
vars_info
<-
NULL
}
global_attrs
[
names
(
array_attrs
)]
<-
array_attrs
var_dim
<-
which
(
names
(
dim
(
arrays
[[
i
]]))
%in%
c
(
'var'
,
'variable'
))
if
(
length
(
var_dim
)
>
0
)
{
var_dim
<-
var_dim
[
1
]
num_vars
<-
dim
(
arrays
[[
i
]])[
var_dim
]
}
else
{
var_dim
<-
NULL
num_vars
<-
1
}
# Defining ncdf4 variable objects
for
(
j
in
1
:
num_vars
)
{
var_info
<-
vars_info
[[
j
]]
if
(
length
(
var_info
)
==
0
)
{
var_info
<-
list
()
}
dim_names
<-
names
(
dim
(
arrays
[[
i
]]))
if
(
!
is.null
(
dim_names
))
{
if
(
any
(
is.na
(
dim_names
)
|
(
sapply
(
dim_names
,
nchar
)
==
0
)))
{
stop
(
"The provided arrays must have all named dimensions or "
,
"all unnamed dimensions."
)
}
}
provided_dims
<-
sapply
(
var_info
$
dim
,
'[['
,
'name'
)
var_built_dims
<-
NULL
for
(
k
in
1
:
length
(
dim
(
arrays
[[
i
]])))
{
if
(
!
identical
(
k
,
var_dim
))
{
final_dim_position
<-
k
-
ifelse
(
!
is.null
(
var_dim
)
&&
k
>
var_dim
,
1
,
0
)
dim_name
<-
dim_names
[
k
]
if
(
!
is.null
(
dim_name
)
&&
(
dim_name
%in%
provided_dims
))
{
dim_info
<-
var_info
$
dim
[[
which
(
provided_dims
==
dim_name
)]]
}
else
{
dim_info
<-
list
()
}
if
(
!
(
'name'
%in%
names
(
dim_info
)))
{
if
(
!
is.null
(
dim_name
))
{
dim_info
[[
'name'
]]
<-
dim_name
}
else
{
dim_info
[[
'name'
]]
<-
paste0
(
'dim'
,
final_dim_position
)
}
}
else
{
if
(
!
is.character
(
dim_info
[[
'name'
]]))
{
stop
(
"The provided 'name' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a character string."
)
}
dim_info
[[
'name'
]]
<-
dim_info
[[
'name'
]][
1
]
}
if
(
!
(
'len'
%in%
names
(
dim_info
)))
{
dim_info
[[
'len'
]]
<-
unname
(
dim
(
arrays
[[
i
]])[
k
])
}
else
{
if
(
!
is.numeric
(
dim_info
[[
'len'
]]))
{
stop
(
"The provided 'len' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a numeric value."
)
}
dim_info
[[
'len'
]]
<-
as.integer
(
round
(
dim_info
[[
'len'
]][
1
]))
if
(
dim_info
[[
'len'
]]
!=
dim
(
arrays
[[
i
]])[
k
])
{
stop
(
"The provided 'len' for the "
,
k
,
"th dimension in the "
,
i
,
"th array does not match the actual length of the provided array."
)
}
}
if
(
!
(
'unlim'
%in%
names
(
dim_info
)))
{
dim_info
[[
'unlim'
]]
<-
ifelse
(
dim_info
[[
'name'
]]
==
'time'
,
TRUE
,
FALSE
)
}
else
{
if
(
!
is.logical
(
dim_info
[[
'unlim'
]]))
{
stop
(
"The provided 'unlim' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a logical value."
)
}
dim_info
[[
'unlim'
]]
<-
dim_info
[[
'unlim'
]][
1
]
}
if
(
!
(
'units'
%in%
names
(
dim_info
)))
{
dim_info
[[
'units'
]]
<-
''
}
else
{
if
(
!
is.character
(
dim_info
[[
'units'
]]))
{
stop
(
"The provided 'units' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a character string."
)
}
dim_info
[[
'units'
]]
<-
dim_info
[[
'units'
]][
1
]
}
if
(
!
(
'vals'
%in%
names
(
dim_info
)))
{
dim_info
[[
'vals'
]]
<-
1
:
dim_info
[[
'len'
]]
}
else
{
if
(
!
(
is.numeric
(
dim_info
[[
'vals'
]])))
{
stop
(
"The provided 'vals' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a numeric vector."
)
}
if
(
dim_info
[[
'units'
]]
==
''
)
{
dim_info
[[
'vals'
]]
<-
as.integer
(
dim_info
[[
'vals'
]])
}
if
(
length
(
dim_info
[[
'vals'
]])
!=
dim_info
[[
'len'
]])
{
stop
(
"The length of the provided 'vals' for the "
,
k
,
"th dimension in the "
,
i
,
"th array does not match the length of the provided array."
)
}
}
if
(
!
(
'create_dimvar'
%in%
names
(
dim_info
)))
{
if
(
dim_info
[[
'units'
]]
==
''
)
{
dim_info
[[
'create_dimvar'
]]
<-
FALSE
}
else
{
dim_info
[[
'create_dimvar'
]]
<-
TRUE
}
}
else
{
if
(
!
is.logical
(
dim_info
[[
'create_dimvar'
]]))
{
stop
(
"The provided 'create_dimvar' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a logical value."
)
}
dim_info
[[
'create_dimvar'
]]
<-
dim_info
[[
'create_dimvar'
]][
1
]
if
(
dim_info
[[
'units'
]]
!=
''
&&
!
dim_info
[[
'create_dimvar'
]])
{
stop
(
"Provided 'units' for the "
,
k
,
"th dimension in the "
,
i
,
"th array but 'create_dimvar' set to FALSE."
)
}
}
if
(
!
(
'calendar'
%in%
names
(
dim_info
)))
{
dim_info
[[
'calendar'
]]
<-
NA
}
else
{
if
(
!
is.character
(
dim_info
[[
'calendar'
]]))
{
stop
(
"The provided 'calendar' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a character string."
)
}
dim_info
[[
'calendar'
]]
<-
dim_info
[[
'calendar'
]][
1
]
}
if
(
!
(
'longname'
%in%
names
(
dim_info
)))
{
dim_info
[[
'longname'
]]
<-
dim_info
[[
'name'
]]
}
else
{
if
(
!
is.character
(
dim_info
[[
'longname'
]]))
{
stop
(
"The provided 'longname' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a character string."
)
}
dim_info
[[
'longname'
]]
<-
dim_info
[[
'longname'
]][
1
]
}
if
(
dim_info
[[
'name'
]]
%in%
names
(
defined_dims
))
{
items_to_check
<-
c
(
'name'
,
'len'
,
'unlim'
,
'units'
,
'vals'
,
'create_dimvar'
,
'longname'
)
if
(
!
identical
(
dim_info
[
items_to_check
],
defined_dims
[[
dim_info
[[
'name'
]]]][
items_to_check
])
||
!
(
identical
(
dim_info
[[
'calendar'
]],
defined_dims
[[
dim_info
[[
'name'
]]]][[
'calendar'
]])
||
(
is.na
(
dim_info
[[
'calendar'
]])
&&
is.null
(
defined_dims
[[
dim_info
[[
'name'
]]]][[
'calendar'
]]))))
{
stop
(
"The dimension '"
,
dim_info
[[
'name'
]],
"' is "
,
"defined or used more than once in the provided "
,
"data but the dimension specifications do not "
,
"match."
)
}
}
else
{
new_dim
<-
list
(
ncdim_def
(
dim_info
[[
'name'
]],
dim_info
[[
'units'
]],
dim_info
[[
'vals'
]],
dim_info
[[
'unlim'
]],
dim_info
[[
'create_dimvar'
]],
dim_info
[[
'calendar'
]],
dim_info
[[
'longname'
]]))
names
(
new_dim
)
<-
dim_info
[[
'name'
]]
defined_dims
<-
c
(
defined_dims
,
new_dim
)
}
var_built_dims
<-
c
(
var_built_dims
,
dim_info
[[
'name'
]])
}
}
if
(
!
(
'name'
%in%
names
(
var_info
)))
{
var_name_from_md
<-
names
(
vars_info
)[
j
]
var_name_from_ar
<-
names
(
arrays
)[
i
]
if
(
is.character
(
var_name_from_md
)
&&
!
is.na
(
var_name_from_md
)
&&
(
nchar
(
var_name_from_md
)
>
0
))
{
var_name
<-
var_name_from_md
}
else
if
(
is.character
(
var_name_from_ar
)
&&
!
is.na
(
var_name_from_ar
)
&&
(
nchar
(
var_name_from_ar
)
>
0
)){
var_name
<-
var_name_from_ar
}
else
{
var_name
<-
paste0
(
'var'
,
i
,
'_'
,
j
)
}
var_info
[[
'name'
]]
<-
var_name
}
else
{
if
(
!
is.character
(
var_info
[[
'name'
]]))
{
stop
(
"The provided 'name' for the "
,
j
,
"th variable in the "
,
i
,
"th array must be a character string."
)
}
var_info
[[
'name'
]]
<-
var_info
[[
'name'
]][
1
]
}
if
(
!
(
'units'
%in%
names
(
var_info
)))
{
var_info
[[
'units'
]]
<-
''
}
else
{
if
(
!
is.character
(
var_info
[[
'units'
]]))
{
stop
(
"The provided 'units' for the "
,
j
,
"th variable in the "
,
i
,
"th array must be a character string."
)
}
var_info
[[
'units'
]]
<-
var_info
[[
'units'
]][
1
]
}
if
(
!
(
'missval'
%in%
names
(
var_info
)))
{
var_info
[[
'missval'
]]
<-
NULL
}
else
{
if
(
!
is.numeric
(
var_info
[[
'missval'
]]))
{
stop
(
"The provided 'missval' for the "
,
j
,
"th variable in the "
,
i
,
"th array must be a numeric value."
)
}
var_info
[[
'missval'
]]
<-
var_info
[[
'missval'
]][
1
]
}
if
(
!
(
'longname'
%in%
names
(
var_info
)))
{
var_info
[[
'longname'
]]
<-
var_info
[[
'name'
]]
}
else
{
if
(
!
is.character
(
var_info
[[
'longname'
]]))
{
stop
(
"The provided 'longname' for the "
,
j
,
"th variable in the "
,
i
,
"th array must be a character string."
)
}
var_info
[[
'longname'
]]
<-
var_info
[[
'longname'
]][
1
]
}
if
(
!
(
'prec'
%in%
names
(
var_info
)))
{
var_info
[[
'prec'
]]
<-
'float'
}
else
{
if
(
!
is.character
(
var_info
[[
'prec'
]]))
{
stop
(
"The provided 'prec' for the "
,
j
,
"th variable in the "
,
i
,
"th array must be a character string."
)
}
var_info
[[
'prec'
]]
<-
var_info
[[
'prec'
]][
1
]
}
new_var
<-
list
(
ncvar_def
(
var_info
[[
'name'
]],
var_info
[[
'units'
]],
defined_dims
[
var_built_dims
],
var_info
[[
'missval'
]],
var_info
[[
'longname'
]],
var_info
[[
'prec'
]]))
names
(
new_var
)
<-
var_info
[[
'name'
]]
defined_vars
<-
c
(
defined_vars
,
new_var
)
}
}
ncdf_object
<-
nc_create
(
file_path
,
defined_vars
)
var_counter
<-
1
# Putting the data and extra attributes.
for
(
i
in
1
:
length
(
arrays
))
{
array_attrs
<-
attributes
(
arrays
[[
i
]])
if
(
'variables'
%in%
names
(
array_attrs
))
{
vars_info
<-
array_attrs
[[
'variables'
]]
}
else
{
vars_info
<-
NULL
}
var_dim
<-
which
(
names
(
dim
(
arrays
[[
i
]]))
%in%
c
(
'var'
,
'variable'
))
if
(
length
(
var_dim
)
>
0
)
{
var_dim
<-
var_dim
[
1
]
num_vars
<-
dim
(
arrays
[[
i
]])[
var_dim
]
}
else
{
var_dim
<-
NULL
num_vars
<-
1
}
for
(
j
in
1
:
num_vars
)
{
var_info
<-
vars_info
[[
j
]]
if
(
length
(
var_info
)
==
0
)
{
var_info
<-
list
()
}
if
(
!
(
'scaleFact'
%in%
names
(
var_info
)))
{
scale_factor
<-
1
}
else
{
if
(
!
is.numeric
(
var_info
[[
'scaleFact'
]]))
{
stop
(
"The provided 'scaleFact' for the "
,
j
,
"th variable in the "
,
i
,
"th array must be a numeric value."
)
}
scale_factor
<-
var_info
[[
'scaleFact'
]][
1
]
}
if
(
!
(
'addOffset'
%in%
names
(
var_info
)))
{
add_offset
<-
0
}
else
{
if
(
!
is.numeric
(
var_info
[[
'addOffset'
]]))
{
stop
(
"The provided 'addOffset' for the "
,
j
,
"th variable in the "
,
i
,
"th array must be a numeric value."
)
}
add_offset
<-
var_info
[[
'addOffset'
]][
1
]
}
if
(
is.null
(
var_dim
))
{
if
(
scale_factor
!=
1
||
add_offset
!=
0
)
{
ncvar_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
(
arrays
[[
i
]]
-
add_offset
)
/
scale_factor
,
count
=
dim
(
arrays
[[
i
]]))
}
else
{
ncvar_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
arrays
[[
i
]],
count
=
dim
(
arrays
[[
i
]]))
}
}
else
{
if
(
scale_factor
!=
1
||
add_offset
!=
0
)
{
ncvar_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
(
Subset
(
arrays
[[
i
]],
var_dim
,
j
,
drop
=
'selected'
)
-
add_offset
)
/
scale_factor
,
count
=
dim
(
arrays
[[
i
]])[
-
var_dim
])
}
else
{
ncvar_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
Subset
(
arrays
[[
i
]],
var_dim
,
j
,
drop
=
'selected'
),
count
=
dim
(
arrays
[[
i
]])[
-
var_dim
])
}
}
if
(
scale_factor
!=
1
||
add_offset
!=
0
)
{
ncatt_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
'scale_factor'
,
scale_factor
)
ncatt_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
'add_offset'
,
add_offset
)
}
if
(
'coordinates'
%in%
names
(
var_info
))
{
if
(
!
is.character
(
var_info
[[
'coordinates'
]]))
{
stop
(
"The attribute 'coordinates' must be a character string."
)
}
coords
<-
strsplit
(
var_info
[[
'coordinates'
]],
' '
)[[
1
]]
if
(
!
(
all
(
coords
%in%
sapply
(
defined_vars
,
'[['
,
'name'
)
|
coords
%in%
sapply
(
defined_dims
[
which
(
sapply
(
defined_dims
,
'[['
,
'create_dimvar'
))],
'[['
,
'name'
))))
{
coords
<-
coords
[
which
(
coords
%in%
sapply
(
defined_vars
,
'[['
,
'name'
)
|
coords
%in%
sapply
(
defined_dims
[
which
(
sapply
(
defined_dims
,
'[['
,
'create_dimvar'
))],
'[['
,
'name'
))]
.warning
(
"Some of the dimensions appearing in 'coordinates' have been removed because they point to undefined variables."
)
}
ncatt_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
'coordinates'
,
paste
(
coords
,
collapse
=
' '
))
}
attrs_to_skip
<-
which
(
names
(
var_info
)
%in%
c
(
'addOffset'
,
'scaleFact'
,
'coordinates'
,
'dim'
))
attrs_to_add
<-
names
(
var_info
)
if
(
length
(
attrs_to_skip
)
>
0
)
{
attrs_to_add
<-
attrs_to_add
[
-
attrs_to_skip
]
}
for
(
attribute_name
in
attrs_to_add
)
{
if
(
is.numeric
(
var_info
[[
attribute_name
]])
||
is.character
(
var_info
[[
attribute_name
]]))
{
ncatt_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
attribute_name
,
var_info
[[
attribute_name
]])
}
}
var_counter
<-
var_counter
+
1
}
}
nc_close
(
ncdf_object
)
invisible
(
NULL
)
}
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment