mirror of
https://github.com/Unidata/netcdf-c.git
synced 2024-12-09 08:11:38 +08:00
1074 lines
40 KiB
Plaintext
1074 lines
40 KiB
Plaintext
divert(-1)
|
|
|
|
dnl This is m4 source.
|
|
dnl Process using m4 to produce FORTRAN language file.
|
|
|
|
changequote([,])
|
|
|
|
undefine([index])dnl
|
|
|
|
dnl Macros
|
|
|
|
dnl Upcase(str)
|
|
dnl
|
|
define([Upcase],[dnl
|
|
translit($1, abcdefghijklmnopqrstuvwxyz, ABCDEFGHIJKLMNOPQRSTUVWXYZ)])
|
|
|
|
dnl NFT_ITYPE(type)
|
|
dnl
|
|
define([NFT_ITYPE], [NFT_[]Upcase($1)])
|
|
|
|
dnl ARITH(itype, value)
|
|
dnl
|
|
define([ARITH], [ifelse($1, text, ichar($2), $2)])
|
|
|
|
dnl DATATYPE(funf_suffix)
|
|
dnl
|
|
define([DATATYPE], [dnl
|
|
ifelse($1, text, character,
|
|
ifelse($1, int1, NF_INT1_T,
|
|
ifelse($1, int2, NF_INT2_T,
|
|
ifelse($1, int, integer,
|
|
ifelse($1, real, real,
|
|
ifelse($1, double, doubleprecision)[]dnl
|
|
)[]dnl
|
|
)[]dnl
|
|
)[]dnl
|
|
)[]dnl
|
|
)[]dnl
|
|
])
|
|
|
|
dnl TEST_NF_GET_VAR1(TYPE)
|
|
dnl
|
|
define([TEST_NF_GET_VAR1],[dnl
|
|
subroutine test_nf_get_var1_$1()
|
|
implicit none
|
|
#include "tests.inc"
|
|
integer ncid
|
|
integer i
|
|
integer j
|
|
integer err
|
|
integer nok
|
|
integer index(MAX_RANK)
|
|
doubleprecision expect
|
|
logical canConvert
|
|
DATATYPE($1) value
|
|
doubleprecision val
|
|
|
|
nok = 0
|
|
|
|
err = nf_open(testfile, NF_NOWRITE, ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_open: ', err)
|
|
do 1, i = 1, NVARS
|
|
canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
|
|
+ (NFT_ITYPE($1) .eq. NFT_TEXT)
|
|
do 2, j = 1, var_rank(i)
|
|
index(j) = 1
|
|
2 continue
|
|
err = nf_get_var1_$1(BAD_ID, i, index, value)
|
|
if (err .ne. NF_EBADID)
|
|
+ call errore('bad ncid: ', err)
|
|
err = nf_get_var1_$1(ncid, BAD_VARID,
|
|
+ index, value)
|
|
if (err .ne. NF_ENOTVAR)
|
|
+ call errore('bad var id: ', err)
|
|
do 3, j = 1, var_rank(i)
|
|
index(j) = var_shape(j,i) + 1
|
|
err = nf_get_var1_$1(ncid, i, index, value)
|
|
if (.not. canConvert) then
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('conversion: ', err)
|
|
else
|
|
if (err .ne. NF_EINVALCOORDS)
|
|
+ call errore('bad index: ', err)
|
|
endif
|
|
index(j) = 1
|
|
3 continue
|
|
do 4, j = 1, var_nels(i)
|
|
err = index2indexes(j, var_rank(i), var_shape(1,i),
|
|
+ index)
|
|
if (err .ne. 0)
|
|
+ call error('error in index2indexes 1')
|
|
expect = hash4( var_type(i), var_rank(i), index,
|
|
+ NFT_ITYPE($1) )
|
|
err = nf_get_var1_$1(ncid, i, index,
|
|
+ value)
|
|
if (canConvert) then
|
|
if (inRange3(expect,var_type(i),
|
|
+ NFT_ITYPE($1))) then
|
|
if (in_internal_range(NFT_ITYPE($1),
|
|
+ expect)) then
|
|
if (err .ne. 0) then
|
|
call errore('nf_get_var: ', err)
|
|
else
|
|
val = ARITH($1, value)
|
|
if (.not. equal(val, expect,
|
|
+ var_type(i),
|
|
+ NFT_ITYPE($1))) then
|
|
call errord('unexpected: ', val)
|
|
else
|
|
nok = nok + 1
|
|
end if
|
|
end if
|
|
else
|
|
if (err .ne. NF_ERANGE)
|
|
+ call errore('Range error: ', err)
|
|
end if
|
|
else
|
|
if (err .ne. 0 .and. err .ne. NF_ERANGE)
|
|
+ call errore('OK or Range error: ', err)
|
|
end if
|
|
else
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('wrong type: ', err)
|
|
end if
|
|
4 continue
|
|
1 continue
|
|
err = nf_close(ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_close: ', err)
|
|
call print_nok(nok)
|
|
end
|
|
])
|
|
|
|
dnl TEST_NF_GET_VAR(TYPE)
|
|
dnl
|
|
define([TEST_NF_GET_VAR],[dnl
|
|
subroutine test_nf_get_var_$1()
|
|
implicit none
|
|
#include "tests.inc"
|
|
integer ncid
|
|
integer i
|
|
integer j
|
|
integer err
|
|
logical allInExtRange
|
|
logical allInIntRange
|
|
integer nels
|
|
integer nok
|
|
integer index(MAX_RANK)
|
|
doubleprecision expect(MAX_NELS)
|
|
logical canConvert
|
|
DATATYPE($1) value(MAX_NELS)
|
|
doubleprecision val
|
|
|
|
nok = 0
|
|
|
|
err = nf_open(testfile, NF_NOWRITE, ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_open: ', err)
|
|
do 1, i = 1, NVARS
|
|
canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
|
|
+ (NFT_ITYPE($1) .eq. NFT_TEXT)
|
|
err = nf_get_var_$1(BAD_ID, i, value)
|
|
if (err .ne. NF_EBADID)
|
|
+ call errore('bad ncid: ', err)
|
|
err = nf_get_var_$1(ncid, BAD_VARID, value)
|
|
if (err .ne. NF_ENOTVAR)
|
|
+ call errore('bad var id: ', err)
|
|
nels = 1
|
|
do 3, j = 1, var_rank(i)
|
|
nels = nels * var_shape(j,i)
|
|
3 continue
|
|
allInExtRange = .true.
|
|
allInIntRange = .true.
|
|
do 4, j = 1, var_nels(i)
|
|
err = index2indexes(j, var_rank(i), var_shape(1,i),
|
|
+ index)
|
|
if (err .ne. 0)
|
|
+ call error('error in index2indexes 1')
|
|
expect(j) = hash4( var_type(i), var_rank(i), index,
|
|
+ NFT_ITYPE($1) )
|
|
if (inRange3(expect(j),var_type(i), NFT_ITYPE($1))) then
|
|
allInIntRange = allInIntRange .and.
|
|
+ in_internal_range(NFT_ITYPE($1), expect(j))
|
|
else
|
|
allInExtRange = .false.
|
|
end if
|
|
4 continue
|
|
err = nf_get_var_$1(ncid, i, value)
|
|
if (canConvert) then
|
|
if (allInExtRange) then
|
|
if (allInIntRange) then
|
|
if (err .ne. 0)
|
|
+ call errore('nf_get_var: ', err)
|
|
else
|
|
if (err .ne. NF_ERANGE)
|
|
+ call errore('Range error: ', err)
|
|
endif
|
|
else
|
|
if (err .ne. 0 .and. err .ne. NF_ERANGE)
|
|
+ call errore('Range error: ', err)
|
|
endif
|
|
do 5, j = 1, var_nels(i)
|
|
if (inRange3(expect(j),var_type(i),
|
|
+ NFT_ITYPE($1)) .and.
|
|
+ in_internal_range(NFT_ITYPE($1),
|
|
+ expect(j))) then
|
|
val = ARITH($1, value(j))
|
|
if (.not. equal(val, expect(j),
|
|
+ var_type(i),
|
|
+ NFT_ITYPE($1))) then
|
|
call errord('unexpected: ', val)
|
|
else
|
|
nok = nok + 1
|
|
end if
|
|
endif
|
|
5 continue
|
|
else
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('wrong type: ', err)
|
|
end if
|
|
1 continue
|
|
err = nf_close(ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_close: ', err)
|
|
call print_nok(nok)
|
|
end
|
|
])
|
|
|
|
|
|
dnl TEST_NF_GET_VARA(TYPE)
|
|
dnl
|
|
define([TEST_NF_GET_VARA],[dnl
|
|
subroutine test_nf_get_vara_$1()
|
|
implicit none
|
|
#include "tests.inc"
|
|
integer ncid
|
|
integer d
|
|
integer i
|
|
integer j
|
|
integer k
|
|
integer err
|
|
logical allInExtRange
|
|
logical allInIntRange
|
|
integer nels
|
|
integer nslabs
|
|
integer nok
|
|
integer start(MAX_RANK)
|
|
integer edge(MAX_RANK)
|
|
integer index(MAX_RANK)
|
|
integer mid(MAX_RANK)
|
|
logical canConvert
|
|
DATATYPE($1) value(MAX_NELS)
|
|
doubleprecision expect(MAX_NELS)
|
|
doubleprecision val
|
|
integer udshift
|
|
|
|
nok = 0
|
|
|
|
err = nf_open(testfile, NF_NOWRITE, ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_open: ', err)
|
|
do 1, i = 1, NVARS
|
|
canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
|
|
+ (NFT_ITYPE($1) .eq. NFT_TEXT)
|
|
if (.not.(var_rank(i) .le. MAX_RANK)) stop 2
|
|
if (.not.(var_nels(i) .le. MAX_NELS)) stop 2
|
|
do 2, j = 1, var_rank(i)
|
|
start(j) = 1
|
|
edge(j) = 1
|
|
2 continue
|
|
err = nf_get_vara_$1(BAD_ID, i, start,
|
|
+ edge, value)
|
|
if (err .ne. NF_EBADID)
|
|
+ call errore('bad ncid: ', err)
|
|
err = nf_get_vara_$1(ncid, BAD_VARID, start,
|
|
+ edge, value)
|
|
if (err .ne. NF_ENOTVAR)
|
|
+ call errore('bad var id: ', err)
|
|
do 3, j = 1, var_rank(i)
|
|
start(j) = var_shape(j,i) + 1
|
|
err = nf_get_vara_$1(ncid, i, start,
|
|
+ edge, value)
|
|
if (canConvert .and. err .ne. NF_EINVALCOORDS)
|
|
+ call errore('bad index: ', err)
|
|
start(j) = 1
|
|
edge(j) = var_shape(j,i) + 1
|
|
err = nf_get_vara_$1(ncid, i, start,
|
|
+ edge, value)
|
|
if (canConvert .and. err .ne. NF_EEDGE)
|
|
+ call errore('bad edge: ', err)
|
|
edge(j) = 1
|
|
3 continue
|
|
|
|
C /* Check non-scalars for correct error returned even when */
|
|
C /* there is nothing to get (edge(j).eq.0) */
|
|
if (var_rank(i) .gt. 0) then
|
|
do 10, j = 1, var_rank(i)
|
|
edge(j) = 0
|
|
10 continue
|
|
err = nf_get_vara_$1(BAD_ID, i, start,
|
|
+ edge, value)
|
|
if (err .ne. NF_EBADID)
|
|
+ call errore('bad ncid: ', err)
|
|
err = nf_get_vara_$1(ncid, BAD_VARID,
|
|
+ start, edge, value)
|
|
if (err .ne. NF_ENOTVAR)
|
|
+ call errore('bad var id: ', err)
|
|
do 11, j = 1, var_rank(i)
|
|
if (var_dimid(j,i) .gt. 1) then !/* skip record dim */
|
|
start(j) = var_shape(j,i) + 1
|
|
err = nf_get_vara_$1(ncid, i,
|
|
+ start, edge, value)
|
|
if (canConvert .and. err .ne. NF_EINVALCOORDS)
|
|
+ call errore('bad start: ', err)
|
|
start(j) = 1
|
|
endif
|
|
11 continue
|
|
err = nf_get_vara_$1(ncid, i, start,
|
|
+ edge, value)
|
|
if (canConvert) then
|
|
if (err .ne. 0)
|
|
+ call error(nf_strerror(err))
|
|
else
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('wrong type: ', err)
|
|
endif
|
|
do 12, j = 1, var_rank(i)
|
|
edge(j) = 1
|
|
12 continue
|
|
endif
|
|
|
|
C Choose a random point dividing each dim into 2 parts
|
|
C get 2^rank (nslabs) slabs so defined
|
|
nslabs = 1
|
|
do 4, j = 1, var_rank(i)
|
|
mid(j) = roll( var_shape(j,i) )
|
|
nslabs = nslabs * 2
|
|
4 continue
|
|
C bits of k determine whether to get lower or upper part of dim
|
|
do 5, k = 1, nslabs
|
|
nels = 1
|
|
do 6, j = 1, var_rank(i)
|
|
if (mod(udshift((k-1), -(j-1)), 2) .eq. 1) then
|
|
start(j) = 1
|
|
edge(j) = mid(j)
|
|
else
|
|
start(j) = 1 + mid(j)
|
|
edge(j) = var_shape(j,i) - mid(j)
|
|
end if
|
|
nels = nels * edge(j)
|
|
6 continue
|
|
allInIntRange = .true.
|
|
allInExtRange = .true.
|
|
do 7, j = 1, nels
|
|
err = index2indexes(j, var_rank(i), edge, index)
|
|
if (err .ne. 0)
|
|
+ call error('error in index2indexes 1')
|
|
do 8, d = 1, var_rank(i)
|
|
index(d) = index(d) + start(d) - 1
|
|
8 continue
|
|
expect(j) = hash4(var_type(i), var_rank(i), index,
|
|
+ NFT_ITYPE($1))
|
|
if (inRange3(expect(j),var_type(i),
|
|
+ NFT_ITYPE($1))) then
|
|
allInIntRange =
|
|
+ allInIntRange .and.
|
|
+ in_internal_range(NFT_ITYPE($1), expect(j))
|
|
else
|
|
allInExtRange = .false.
|
|
end if
|
|
7 continue
|
|
err = nf_get_vara_$1(ncid, i, start,
|
|
+ edge, value)
|
|
if (canConvert) then
|
|
if (allInExtRange) then
|
|
if (allInIntRange) then
|
|
if (err .ne. 0)
|
|
+ call errore('nf_get_vara_$1:', err)
|
|
else
|
|
if (err .ne. NF_ERANGE)
|
|
+ call errore('Range error: ', err)
|
|
end if
|
|
else
|
|
if (err .ne. 0 .and. err .ne. NF_ERANGE)
|
|
+ call errore('OK or Range error: ', err)
|
|
end if
|
|
do 9, j = 1, nels
|
|
if (inRange3(expect(j),var_type(i),
|
|
+ NFT_ITYPE($1)) .and.
|
|
+ in_internal_range(NFT_ITYPE($1), expect(j)))
|
|
+ then
|
|
val = ARITH($1, value(j))
|
|
if (.not.equal(val,expect(j),
|
|
+ var_type(i),NFT_ITYPE($1)))
|
|
+ then
|
|
call error(
|
|
+ 'value read not that expected')
|
|
if (verbose) then
|
|
call error(' ')
|
|
call errori('varid: ', i)
|
|
call errorc('var_name: ',
|
|
+ var_name(i))
|
|
call errori('element number: %d ',
|
|
+ j)
|
|
call errord('expect: ', expect(j))
|
|
call errord('got: ', val)
|
|
end if
|
|
else
|
|
nok = nok + 1
|
|
end if
|
|
end if
|
|
9 continue
|
|
else
|
|
if (nels .gt. 0 .and. err .ne. NF_ECHAR)
|
|
+ call errore('wrong type: ', err)
|
|
end if
|
|
5 continue
|
|
1 continue
|
|
err = nf_close(ncid)
|
|
if (err .ne. 0)
|
|
+ call errorc('nf_close: ', nf_strerror(err))
|
|
call print_nok(nok)
|
|
end
|
|
])dnl
|
|
|
|
|
|
dnl TEST_NF_GET_VARS(TYPE)
|
|
dnl
|
|
define([TEST_NF_GET_VARS],dnl
|
|
[dnl
|
|
subroutine test_nf_get_vars_$1()
|
|
implicit none
|
|
#include "tests.inc"
|
|
integer ncid
|
|
integer d
|
|
integer i
|
|
integer j
|
|
integer k
|
|
integer m
|
|
integer err
|
|
logical allInExtRange
|
|
logical allInIntRange
|
|
integer nels
|
|
integer nslabs
|
|
integer nstarts
|
|
integer nok
|
|
integer start(MAX_RANK)
|
|
integer edge(MAX_RANK)
|
|
integer index(MAX_RANK)
|
|
integer index2(MAX_RANK)
|
|
integer mid(MAX_RANK)
|
|
integer count(MAX_RANK)
|
|
integer sstride(MAX_RANK)
|
|
integer stride(MAX_RANK)
|
|
logical canConvert
|
|
DATATYPE($1) value(MAX_NELS)
|
|
doubleprecision expect(MAX_NELS)
|
|
doubleprecision val
|
|
integer udshift
|
|
|
|
nok = 0
|
|
|
|
err = nf_open(testfile, NF_NOWRITE, ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_open: ', err)
|
|
do 1, i = 1, NVARS
|
|
canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
|
|
+ (NFT_ITYPE($1) .eq. NFT_TEXT)
|
|
if (.not.(var_rank(i) .le. MAX_RANK)) stop 2
|
|
if (.not.(var_nels(i) .le. MAX_NELS)) stop 2
|
|
do 2, j = 1, var_rank(i)
|
|
start(j) = 1
|
|
edge(j) = 1
|
|
stride(j) = 1
|
|
2 continue
|
|
err = nf_get_vars_$1(BAD_ID, i, start,
|
|
+ edge, stride, value)
|
|
if (err .ne. NF_EBADID)
|
|
+ call errore('bad ncid: ', err)
|
|
err = nf_get_vars_$1(ncid, BAD_VARID,
|
|
+ start, edge, stride,
|
|
+ value)
|
|
if (err .ne. NF_ENOTVAR)
|
|
+ call errore('bad var id: ', err)
|
|
do 3, j = 1, var_rank(i)
|
|
start(j) = var_shape(j,i) + 1
|
|
err = nf_get_vars_$1(ncid, i, start,
|
|
+ edge, stride,
|
|
+ value)
|
|
if (.not. canConvert) then
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('conversion: ', err)
|
|
else
|
|
if (err .ne. NF_EINVALCOORDS)
|
|
+ call errore('bad index: ', err)
|
|
endif
|
|
start(j) = 1
|
|
edge(j) = var_shape(j,i) + 1
|
|
err = nf_get_vars_$1(ncid, i, start,
|
|
+ edge, stride,
|
|
+ value)
|
|
if (.not. canConvert) then
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('conversion: ', err)
|
|
else
|
|
if (err .ne. NF_EEDGE)
|
|
+ call errore('bad edge: ', err)
|
|
endif
|
|
edge(j) = 1
|
|
stride(j) = 0
|
|
err = nf_get_vars_$1(ncid, i, start,
|
|
+ edge, stride,
|
|
+ value)
|
|
if (.not. canConvert) then
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('conversion: ', err)
|
|
else
|
|
if (err .ne. NF_ESTRIDE)
|
|
+ call errore('bad stride: ', err)
|
|
endif
|
|
stride(j) = 1
|
|
3 continue
|
|
C Choose a random point dividing each dim into 2 parts
|
|
C get 2^rank (nslabs) slabs so defined
|
|
nslabs = 1
|
|
do 4, j = 1, var_rank(i)
|
|
mid(j) = roll( var_shape(j,i) )
|
|
nslabs = nslabs * 2
|
|
4 continue
|
|
C bits of k determine whether to get lower or upper part of dim
|
|
C choose random stride from 1 to edge
|
|
do 5, k = 1, nslabs
|
|
nstarts = 1
|
|
do 6, j = 1, var_rank(i)
|
|
if (mod(udshift(k-1, j-1), 2) .eq. 1) then
|
|
start(j) = 1
|
|
edge(j) = mid(j)
|
|
else
|
|
start(j) = 1 + mid(j)
|
|
edge(j) = var_shape(j,i) - mid(j)
|
|
end if
|
|
if (edge(j) .gt. 0) then
|
|
sstride(j) = 1 + roll(edge(j))
|
|
else
|
|
sstride(j) = 1
|
|
end if
|
|
nstarts = nstarts * stride(j)
|
|
6 continue
|
|
do 7, m = 1, nstarts
|
|
err = index2indexes(m, var_rank(i), sstride,
|
|
+ index)
|
|
if (err .ne. 0)
|
|
+ call error('error in index2indexes')
|
|
nels = 1
|
|
do 8, j = 1, var_rank(i)
|
|
count(j) = 1 + (edge(j) - index(j)) /
|
|
+ stride(j)
|
|
nels = nels * count(j)
|
|
index(j) = index(j) + start(j) - 1
|
|
8 continue
|
|
C Random choice of forward or backward
|
|
C /* TODO
|
|
C if ( roll(2) ) then
|
|
C for (j = 0 j < var_rank(i) j++) {
|
|
C index(j) += (count(j) - 1) * stride(j)
|
|
C stride(j) = -stride(j)
|
|
C }
|
|
C end if
|
|
C */
|
|
allInIntRange = .true.
|
|
allInExtRange = .true.
|
|
do 9, j = 1, nels
|
|
err = index2indexes(j, var_rank(i), count,
|
|
+ index2)
|
|
if (err .ne. 0)
|
|
+ call error('error in index2indexes() 1')
|
|
do 10, d = 1, var_rank(i)
|
|
index2(d) = index(d) + (index2(d)-1) *
|
|
+ stride(d)
|
|
10 continue
|
|
expect(j) = hash4(var_type(i), var_rank(i),
|
|
+ index2, NFT_ITYPE($1))
|
|
if (inRange3(expect(j),var_type(i),
|
|
+ NFT_ITYPE($1))) then
|
|
allInIntRange =
|
|
+ allInIntRange .and.
|
|
+ in_internal_range(NFT_ITYPE($1),
|
|
+ expect(j))
|
|
else
|
|
allInExtRange = .false.
|
|
end if
|
|
9 continue
|
|
err = nf_get_vars_$1(ncid, i, index,
|
|
+ count, stride,
|
|
+ value)
|
|
if (canConvert) then
|
|
if (allInExtRange) then
|
|
if (allInIntRange) then
|
|
if (err .ne. 0)
|
|
+ call error(nf_strerror(err))
|
|
else
|
|
if (err .ne. NF_ERANGE)
|
|
+ call errore('Range error: ', err)
|
|
end if
|
|
else
|
|
if (err .ne. 0 .and. err .ne. NF_ERANGE)
|
|
+ call errore('OK or Range error: ', err)
|
|
end if
|
|
do 11, j = 1, nels
|
|
if (inRange3(expect(j),var_type(i),
|
|
+ NFT_ITYPE($1)) .and.
|
|
+ in_internal_range(NFT_ITYPE($1),
|
|
+ expect(j))) then
|
|
val = ARITH($1, value(j))
|
|
if (.not.equal(val, expect(j),
|
|
+ var_type(i), NFT_ITYPE($1))) then
|
|
call error(
|
|
+ 'value read not that expected')
|
|
if (verbose) then
|
|
call error(' ')
|
|
call errori('varid: ', i)
|
|
call errorc('var_name: ',
|
|
+ var_name(i))
|
|
call errori('element number: ',
|
|
+ j)
|
|
call errord('expect: ',
|
|
+ expect(j))
|
|
call errord('got: ', val)
|
|
end if
|
|
else
|
|
nok = nok + 1
|
|
end if
|
|
end if
|
|
11 continue
|
|
else
|
|
if (nels .gt. 0 .and. err .ne. NF_ECHAR)
|
|
+ call errore('wrong type: ', err)
|
|
end if
|
|
7 continue
|
|
5 continue
|
|
|
|
1 continue
|
|
err = nf_close(ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_close: ', err)
|
|
call print_nok(nok)
|
|
end
|
|
])dnl
|
|
|
|
|
|
dnl TEST_NF_GET_VARM(TYPE)
|
|
dnl
|
|
define([TEST_NF_GET_VARM],dnl
|
|
[dnl
|
|
subroutine test_nf_get_varm_$1()
|
|
implicit none
|
|
#include "tests.inc"
|
|
integer ncid
|
|
integer d
|
|
integer i
|
|
integer j
|
|
integer k
|
|
integer m
|
|
integer err
|
|
logical allInExtRange
|
|
logical allInIntRange
|
|
integer nels
|
|
integer nslabs
|
|
integer nstarts
|
|
integer nok
|
|
integer start(MAX_RANK)
|
|
integer edge(MAX_RANK)
|
|
integer index(MAX_RANK)
|
|
integer index2(MAX_RANK)
|
|
integer mid(MAX_RANK)
|
|
integer count(MAX_RANK)
|
|
integer sstride(MAX_RANK)
|
|
integer stride(MAX_RANK)
|
|
integer imap(MAX_RANK)
|
|
logical canConvert
|
|
DATATYPE($1) value(MAX_NELS)
|
|
doubleprecision expect(MAX_NELS)
|
|
doubleprecision val
|
|
integer udshift
|
|
|
|
nok = 0
|
|
|
|
err = nf_open(testfile, NF_NOWRITE, ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_open: ', err)
|
|
do 1, i = 1, NVARS
|
|
canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
|
|
+ (NFT_ITYPE($1) .eq. NFT_TEXT)
|
|
if (.not.(var_rank(i) .le. MAX_RANK)) stop 2
|
|
if (.not.(var_nels(i) .le. MAX_NELS)) stop 2
|
|
do 2, j = 1, var_rank(i)
|
|
start(j) = 1
|
|
edge(j) = 1
|
|
stride(j) = 1
|
|
imap(j) = 1
|
|
2 continue
|
|
err = nf_get_varm_$1(BAD_ID, i, start, edge,
|
|
+ stride, imap,
|
|
+ value)
|
|
if (err .ne. NF_EBADID)
|
|
+ call errore('bad ncid: ', err)
|
|
err = nf_get_varm_$1(ncid, BAD_VARID, start,
|
|
+ edge, stride,
|
|
+ imap, value)
|
|
if (err .ne. NF_ENOTVAR)
|
|
+ call errore('bad var id: ', err)
|
|
do 3, j = 1, var_rank(i)
|
|
start(j) = var_shape(j,i) + 1
|
|
err = nf_get_varm_$1(ncid, i, start,
|
|
+ edge, stride,
|
|
+ imap, value)
|
|
if (.not. canConvert) then
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('conversion: ', err)
|
|
else
|
|
if (err .ne. NF_EINVALCOORDS)
|
|
+ call errore('bad index: ', err)
|
|
endif
|
|
start(j) = 1
|
|
edge(j) = var_shape(j,i) + 1
|
|
err = nf_get_varm_$1(ncid, i, start,
|
|
+ edge, stride,
|
|
+ imap, value)
|
|
if (.not. canConvert) then
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('conversion: ', err)
|
|
else
|
|
if (err .ne. NF_EEDGE)
|
|
+ call errore('bad edge: ', err)
|
|
endif
|
|
edge(j) = 1
|
|
stride(j) = 0
|
|
err = nf_get_varm_$1(ncid, i, start,
|
|
+ edge, stride,
|
|
+ imap, value)
|
|
if (.not. canConvert) then
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('conversion: ', err)
|
|
else
|
|
if (err .ne. NF_ESTRIDE)
|
|
+ call errore('bad stride: ', err)
|
|
endif
|
|
stride(j) = 1
|
|
3 continue
|
|
C Choose a random point dividing each dim into 2 parts
|
|
C get 2^rank (nslabs) slabs so defined
|
|
nslabs = 1
|
|
do 4, j = 1, var_rank(i)
|
|
mid(j) = roll( var_shape(j,i) )
|
|
nslabs = nslabs * 2
|
|
4 continue
|
|
C /* bits of k determine whether to get lower or upper part
|
|
C * of dim
|
|
C * choose random stride from 1 to edge */
|
|
do 5, k = 1, nslabs
|
|
nstarts = 1
|
|
do 6, j = 1, var_rank(i)
|
|
if (mod(udshift((k-1), -(j-1)), 2) .ne. 0) then
|
|
start(j) = 1
|
|
edge(j) = mid(j)
|
|
else
|
|
start(j) = 1 + mid(j)
|
|
edge(j) = var_shape(j,i) - mid(j)
|
|
end if
|
|
if (edge(j) .gt. 0) then
|
|
stride(j) = 1+roll(edge(j))
|
|
else
|
|
stride(j) = 1
|
|
end if
|
|
sstride(j) = stride(j)
|
|
nstarts = nstarts * stride(j)
|
|
6 continue
|
|
do 7, m = 1, nstarts
|
|
err = index2indexes(m, var_rank(i), sstride, index)
|
|
if (err .ne. 0)
|
|
+ call error('error in index2indexes')
|
|
nels = 1
|
|
do 8, j = 1, var_rank(i)
|
|
count(j) = 1 + (edge(j) - index(j)) /
|
|
+ stride(j)
|
|
nels = nels * count(j)
|
|
index(j) = index(j) + start(j) - 1
|
|
8 continue
|
|
C Random choice of forward or backward
|
|
C /* TODO
|
|
C if ( roll(2) ) then
|
|
C for (j = 0 j < var_rank(i) j++) {
|
|
C index(j) += (count(j) - 1) * stride(j)
|
|
C stride(j) = -stride(j)
|
|
C }
|
|
C end if
|
|
C */
|
|
if (var_rank(i) .gt. 0) then
|
|
imap(1) = 1
|
|
do 9, j = 2, var_rank(i)
|
|
imap(j) = imap(j-1) * count(j-1)
|
|
9 continue
|
|
end if
|
|
allInIntRange = .true.
|
|
allInExtRange = .true.
|
|
do 10, j = 1, nels
|
|
err = index2indexes(j, var_rank(i), count,
|
|
+ index2)
|
|
if (err .ne. 0)
|
|
+ call error('error in index2indexes 1')
|
|
do 11, d = 1, var_rank(i)
|
|
index2(d) = index(d) + (index2(d)-1) *
|
|
+ stride(d)
|
|
11 continue
|
|
expect(j) = hash4(var_type(i), var_rank(i),
|
|
+ index2, NFT_ITYPE($1))
|
|
if (inRange3(expect(j),var_type(i),
|
|
+ NFT_ITYPE($1))) then
|
|
allInIntRange =
|
|
+ allInIntRange .and.
|
|
+ in_internal_range(NFT_ITYPE($1),
|
|
+ expect(j))
|
|
else
|
|
allInExtRange = .false.
|
|
end if
|
|
10 continue
|
|
err = nf_get_varm_$1(ncid,i,index,count,
|
|
+ stride,imap,
|
|
+ value)
|
|
if (canConvert) then
|
|
if (allInExtRange) then
|
|
if (allInIntRange) then
|
|
if (err .ne. 0)
|
|
+ call error(nf_strerror(err))
|
|
else
|
|
if (err .ne. NF_ERANGE)
|
|
+ call errore('Range error: ', err)
|
|
end if
|
|
else
|
|
if (err .ne. 0 .and. err .ne. NF_ERANGE)
|
|
+ call errore('OK or Range error: ', err)
|
|
end if
|
|
do 12, j = 1, nels
|
|
if (inRange3(expect(j),var_type(i),
|
|
+ NFT_ITYPE($1)) .and.
|
|
+ in_internal_range(NFT_ITYPE($1),
|
|
+ expect(j))) then
|
|
val = ARITH($1, value(j))
|
|
if (.not.equal(val, expect(j),
|
|
+ var_type(i),
|
|
+ NFT_ITYPE($1))) then
|
|
call error(
|
|
+ 'value read not that expected')
|
|
if (verbose) then
|
|
call error(' ')
|
|
call errori('varid: ', i)
|
|
call errorc('var_name: ',
|
|
+ var_name(i))
|
|
call errori('element number: ',
|
|
+ j)
|
|
call errord('expect: ',
|
|
+ expect(j))
|
|
call errord('got: ', val)
|
|
end if
|
|
else
|
|
nok = nok + 1
|
|
end if
|
|
end if
|
|
12 continue
|
|
else
|
|
if (nels .gt. 0 .and. err .ne. NF_ECHAR)
|
|
+ call errore('wrong type: ', err)
|
|
end if
|
|
7 continue
|
|
5 continue
|
|
1 continue
|
|
err = nf_close(ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_close: ', err)
|
|
call print_nok(nok)
|
|
end
|
|
])dnl
|
|
|
|
|
|
dnl TEST_NF_GET_ATT(TYPE)
|
|
dnl
|
|
define([TEST_NF_GET_ATT],dnl
|
|
[dnl
|
|
subroutine test_nf_get_att_$1()
|
|
implicit none
|
|
#include "tests.inc"
|
|
integer ncid
|
|
integer i
|
|
integer j
|
|
integer k
|
|
integer err
|
|
integer ndx(1)
|
|
logical allInExtRange
|
|
logical allInIntRange
|
|
logical canConvert
|
|
DATATYPE($1) value(MAX_NELS)
|
|
doubleprecision expect(MAX_NELS)
|
|
integer nok
|
|
doubleprecision val
|
|
|
|
nok = 0
|
|
|
|
err = nf_open(testfile, NF_NOWRITE, ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_open: ', err)
|
|
|
|
do 1, i = 0, NVARS
|
|
do 2, j = 1, NATTS(i)
|
|
canConvert = (ATT_TYPE(j,i) .eq. NF_CHAR) .eqv.
|
|
+ (NFT_ITYPE($1) .eq. NFT_TEXT)
|
|
err = nf_get_att_$1(BAD_ID, i,
|
|
+ ATT_NAME(j,i),
|
|
+ value)
|
|
if (err .ne. NF_EBADID)
|
|
+ call errore('bad ncid: ', err)
|
|
err = nf_get_att_$1(ncid, BAD_VARID,
|
|
+ ATT_NAME(j,i),
|
|
+ value)
|
|
if (err .ne. NF_ENOTVAR)
|
|
+ call errore('bad var id: ', err)
|
|
err = nf_get_att_$1(ncid, i, 'noSuch', value)
|
|
if (err .ne. NF_ENOTATT)
|
|
+ call errore('Bad attribute name: ', err)
|
|
allInIntRange = .true.
|
|
allInExtRange = .true.
|
|
do 3, k = 1, ATT_LEN(j,i)
|
|
ndx(1) = k
|
|
expect(k) = hash4(ATT_TYPE(j,i), -1, ndx,
|
|
+ NFT_ITYPE($1))
|
|
if (inRange3(expect(k),ATT_TYPE(j,i),
|
|
+ NFT_ITYPE($1))) then
|
|
allInIntRange =
|
|
+ allInIntRange .and.
|
|
+ in_internal_range(NFT_ITYPE($1), expect(k))
|
|
else
|
|
allInExtRange = .false.
|
|
end if
|
|
3 continue
|
|
err = nf_get_att_$1(ncid, i, ATT_NAME(j,i), value)
|
|
if (canConvert .or. ATT_LEN(j,i) .eq. 0) then
|
|
if (allInExtRange) then
|
|
if (allInIntRange) then
|
|
if (err .ne. 0)
|
|
+ call errore('nf_get_att_$1: ', err)
|
|
else
|
|
if (err .ne. NF_ERANGE)
|
|
+ call errore('Range error: ', err)
|
|
end if
|
|
else
|
|
if (err .ne. 0 .and. err .ne. NF_ERANGE)
|
|
+ call errore('OK or Range error: ',
|
|
+ err)
|
|
end if
|
|
do 4, k = 1, ATT_LEN(j,i)
|
|
if (inRange3(expect(k),ATT_TYPE(j,i),
|
|
+ NFT_ITYPE($1)) .and.
|
|
+ in_internal_range(NFT_ITYPE($1),
|
|
+ expect(k))) then
|
|
val = ARITH($1, value(k))
|
|
if (.not.equal(val, expect(k),
|
|
+ ATT_TYPE(j,i),
|
|
+ NFT_ITYPE($1)))then
|
|
call error(
|
|
+ 'value read not that expected')
|
|
if (verbose) then
|
|
call error(' ')
|
|
call errori('varid: ', i)
|
|
call errorc('att_name: ',
|
|
+ ATT_NAME(j,i))
|
|
call errori('element number: ', k)
|
|
call errord('expect: ', expect(k))
|
|
call errord('got: ', val)
|
|
end if
|
|
else
|
|
nok = nok + 1
|
|
end if
|
|
end if
|
|
4 continue
|
|
else
|
|
if (err .ne. NF_ECHAR)
|
|
+ call errore('wrong type: ', err)
|
|
end if
|
|
2 continue
|
|
1 continue
|
|
|
|
err = nf_close(ncid)
|
|
if (err .ne. 0)
|
|
+ call errore('nf_close: ', err)
|
|
call print_nok(nok)
|
|
end
|
|
])dnl
|
|
|
|
divert(0)dnl
|
|
dnl If you see this line, you can ignore the next one.
|
|
C Do not edit this file. It is produced from the corresponding .m4 source */
|
|
|
|
C*********************************************************************
|
|
C Copyright 1996, UCAR/Unidata
|
|
C See netcdf/COPYRIGHT file for copying and redistribution conditions.
|
|
C $Id: test_get.m4,v 1.11 2008/04/30 16:50:46 ed Exp $
|
|
C*********************************************************************
|
|
|
|
TEST_NF_GET_VAR1(text)
|
|
#ifdef NF_INT1_T
|
|
TEST_NF_GET_VAR1(int1)
|
|
#endif
|
|
#ifdef NF_INT2_T
|
|
TEST_NF_GET_VAR1(int2)
|
|
#endif
|
|
TEST_NF_GET_VAR1(int)
|
|
TEST_NF_GET_VAR1(real)
|
|
TEST_NF_GET_VAR1(double)
|
|
|
|
TEST_NF_GET_VAR(text)
|
|
#ifdef NF_INT1_T
|
|
TEST_NF_GET_VAR(int1)
|
|
#endif
|
|
#ifdef NF_INT2_T
|
|
TEST_NF_GET_VAR(int2)
|
|
#endif
|
|
TEST_NF_GET_VAR(int)
|
|
TEST_NF_GET_VAR(real)
|
|
TEST_NF_GET_VAR(double)
|
|
|
|
TEST_NF_GET_VARA(text)
|
|
#ifdef NF_INT1_T
|
|
TEST_NF_GET_VARA(int1)
|
|
#endif
|
|
#ifdef NF_INT2_T
|
|
TEST_NF_GET_VARA(int2)
|
|
#endif
|
|
TEST_NF_GET_VARA(int)
|
|
TEST_NF_GET_VARA(real)
|
|
TEST_NF_GET_VARA(double)
|
|
|
|
TEST_NF_GET_VARS(text)
|
|
#ifdef NF_INT1_T
|
|
TEST_NF_GET_VARS(int1)
|
|
#endif
|
|
#ifdef NF_INT2_T
|
|
TEST_NF_GET_VARS(int2)
|
|
#endif
|
|
TEST_NF_GET_VARS(int)
|
|
TEST_NF_GET_VARS(real)
|
|
TEST_NF_GET_VARS(double)
|
|
|
|
TEST_NF_GET_VARM(text)
|
|
#ifdef NF_INT1_T
|
|
TEST_NF_GET_VARM(int1)
|
|
#endif
|
|
#ifdef NF_INT2_T
|
|
TEST_NF_GET_VARM(int2)
|
|
#endif
|
|
TEST_NF_GET_VARM(int)
|
|
TEST_NF_GET_VARM(real)
|
|
TEST_NF_GET_VARM(double)
|
|
|
|
TEST_NF_GET_ATT(text)
|
|
#ifdef NF_INT1_T
|
|
TEST_NF_GET_ATT(int1)
|
|
#endif
|
|
#ifdef NF_INT2_T
|
|
TEST_NF_GET_ATT(int2)
|
|
#endif
|
|
TEST_NF_GET_ATT(int)
|
|
TEST_NF_GET_ATT(real)
|
|
TEST_NF_GET_ATT(double)
|