PageRenderTime 70ms CodeModel.GetById 32ms RepoModel.GetById 0ms app.codeStats 1ms

/other/netcdf_write_matrix/src/nf_test/test_read.F

https://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 1061 lines | 836 code | 107 blank | 118 comment | 224 complexity | 36e8bf933c8c38b4d31123f042cf73bb MD5 | raw file
Possible License(s): AGPL-1.0
  1. C*********************************************************************
  2. C Copyright 1996, UCAR/Unidata
  3. C See netcdf/COPYRIGHT file for copying and redistribution conditions.
  4. C $Id: test_read.F,v 1.11 2005/11/07 15:13:32 ed Exp $
  5. C*********************************************************************
  6. C Test nf_strerror.
  7. C Try on a bad error status.
  8. C Test for each defined error status.
  9. C
  10. subroutine test_nf_strerror()
  11. implicit none
  12. #include "tests.inc"
  13. integer number_of_messages
  14. parameter (number_of_messages = 27)
  15. integer i
  16. integer status(number_of_messages)
  17. character*80 message
  18. character*80 msg(number_of_messages)
  19. data status(1) / NF_NOERR/
  20. data status(2) / NF_EBADID /
  21. data status(3) / NF_EEXIST /
  22. data status(4) / NF_EINVAL /
  23. data status(5) / NF_EPERM /
  24. data status(6) / NF_ENOTINDEFINE /
  25. data status(7) / NF_EINDEFINE /
  26. data status(8) / NF_EINVALCOORDS /
  27. data status(9) / NF_EMAXDIMS /
  28. data status(10) / NF_ENAMEINUSE /
  29. data status(11) / NF_ENOTATT /
  30. data status(12) / NF_EMAXATTS /
  31. data status(13) / NF_EBADTYPE /
  32. data status(14) / NF_EBADDIM /
  33. data status(15) / NF_EUNLIMPOS /
  34. data status(16) / NF_EMAXVARS /
  35. data status(17) / NF_ENOTVAR /
  36. data status(18) / NF_EGLOBAL /
  37. data status(19) / NF_ENOTNC /
  38. data status(20) / NF_ESTS /
  39. data status(21) / NF_EMAXNAME /
  40. data status(22) / NF_EUNLIMIT /
  41. data status(23) / NF_ENORECVARS /
  42. data status(24) / NF_ECHAR /
  43. data status(25) / NF_EEDGE /
  44. data status(26) / NF_ESTRIDE /
  45. data status(27) / NF_EBADNAME /
  46. data msg(1) / 'No error' /
  47. data msg(2) / 'Not a netCDF id' /
  48. data msg(3) / 'netCDF file exists && NC_NOCLOBBER' /
  49. data msg(4) / 'Invalid argument' /
  50. data msg(5) / 'Write to read only' /
  51. data msg(6) / 'Operation not allowed in data mode' /
  52. data msg(7) / 'Operation not allowed in define mode' /
  53. data msg(8) / 'Index exceeds dimension bound' /
  54. data msg(9) / 'NC_MAX_DIMS exceeded' /
  55. data msg(10) / 'String match to name in use' /
  56. data msg(11) / 'Attribute not found' /
  57. data msg(12) / 'NC_MAX_ATTRS exceeded' /
  58. data msg(13)
  59. + / 'Not a netCDF data type or _FillValue type mismatch' /
  60. data msg(14) / 'Invalid dimension id or name' /
  61. data msg(15) / 'NC_UNLIMITED in the wrong index' /
  62. data msg(16) / 'NC_MAX_VARS exceeded' /
  63. data msg(17) / 'Variable not found' /
  64. data msg(18) / 'Action prohibited on NC_GLOBAL varid' /
  65. data msg(19) / 'Not a netCDF file' /
  66. data msg(20) / 'In Fortran, string too short' /
  67. data msg(21) / 'NC_MAX_NAME exceeded' /
  68. data msg(22) / 'NC_UNLIMITED size already in use' /
  69. data msg(23) / 'nc_rec op when there are no record vars' /
  70. data msg(24) / 'Attempt to convert between text & numbers' /
  71. data msg(25) / 'Start+count exceeds dimension bound' /
  72. data msg(26) / 'Illegal stride' /
  73. data msg(27)
  74. + / 'Attribute or variable name contains illegal characters' /
  75. C /* Try on a bad error status */
  76. message = nf_strerror(-666)!/* should fail */
  77. if (message .ne. 'Unknown Error')
  78. + call errorc('nf_strerror on bad error status returned: ',
  79. + message)
  80. C /* Try on each legitimate error status */
  81. do 1, i=1, number_of_messages
  82. message = nf_strerror(status(i))
  83. if (message .ne. msg(i))
  84. + call error('nf_strerror() should return "' // msg(i) //
  85. + '"')
  86. 1 continue
  87. end
  88. C Test nf_open.
  89. C If in read-only section of tests,
  90. C Try to open a non-existent netCDF file, check error return.
  91. C Open a file that is not a netCDF file, check error return.
  92. C Open a netCDF file with a bad mode argument, check error return.
  93. C Open a netCDF file with NF_NOWRITE mode, try to write, check error.
  94. C Try to open a netcdf twice, check whether returned netcdf ids different.
  95. C If in writable section of tests,
  96. C Open a netCDF file with NF_WRITE mode, write something, close it.
  97. C On exit, any open netCDF files are closed.
  98. subroutine test_nf_open()
  99. implicit none
  100. #include "tests.inc"
  101. integer err
  102. integer ncid
  103. integer ncid2
  104. C /* Try to open a nonexistent file */
  105. err = nf_open('tooth-fairy.nc', NF_NOWRITE, ncid)!/* should fail */
  106. if (err .eq. NF_NOERR)
  107. + call error('nf_open of nonexistent file should have failed')
  108. if (.not. NF_ISSYSERR(err))
  109. + call error(
  110. + 'nf_open of nonexistent file should have returned system error')
  111. C /* Open a file that is not a netCDF file. */
  112. err = nf_open('test_read.o', NF_NOWRITE, ncid)!/* should fail */
  113. if (err .ne. NF_ENOTNC)
  114. + call errore('nf_open of non-netCDF file: ', err)
  115. C /* Open a netCDF file in read-only mode, check that write fails */
  116. err = nf_open(testfile, NF_NOWRITE, ncid)
  117. if (err .ne. 0)
  118. + call errore('nf_open: ', err)
  119. err = nf_redef(ncid) !/* should fail */
  120. if (err .ne. NF_EPERM)
  121. + call error('nf_redef of read-only file should fail')
  122. C /* Opened OK, see if can open again and get a different netCDF ID */
  123. err = nf_open(testfile, NF_NOWRITE, ncid2)
  124. if (err .ne. 0) then
  125. call errore('nf_open: ', err)
  126. else
  127. err = nf_close(ncid2)
  128. end if
  129. if (ncid2 .eq. ncid)
  130. + call error(
  131. + 'netCDF IDs for first and second nf_open calls should differ')
  132. if (.not. readonly) then !/* tests using netCDF scratch file */
  133. err = nf_create(scratch, NF_NOCLOBBER, ncid2)
  134. if (err .ne. 0) then
  135. call errore('nf_create: ', err)
  136. else
  137. err = nf_close(ncid2)
  138. end if
  139. err = nf_open(scratch, NF_WRITE, ncid2)
  140. if (err .ne. 0) then
  141. call errore('nf_open: ', err)
  142. else
  143. err = nf_close(ncid2)
  144. end if
  145. err = nf_delete(scratch)
  146. if (err .ne. 0)
  147. + call errorc('delete of scratch file failed', scratch)
  148. end if
  149. err = nf_close(ncid)
  150. if (err .ne. 0)
  151. + call errore('nf_close: ', err)
  152. end
  153. C
  154. C Test nf_close.
  155. C Try to close a netCDF file twice, check whether second close fails.
  156. C Try on bad handle, check error return.
  157. C Try in define mode and data mode.
  158. C/
  159. subroutine test_nf_close()
  160. implicit none
  161. #include "tests.inc"
  162. integer ncid
  163. integer err
  164. err = nf_open(testfile, NF_NOWRITE, ncid)
  165. if (err .ne. 0)
  166. + call errore('nf_open: ', err)
  167. C /* Close a netCDF file twice, second time should fail */
  168. err = nf_close(ncid)
  169. if (err .ne. 0)
  170. + call errore('nf_close failed: ', err)
  171. err = nf_close(ncid)
  172. if (err .ne. NF_EBADID)
  173. + call error('nf_close of closed file should have failed')
  174. C /* Try with a bad netCDF ID */
  175. err = nf_close(BAD_ID)!/* should fail */
  176. if (err .ne. NF_EBADID)
  177. + call errore(
  178. + 'nf_close with bad netCDF ID returned wrong error: ',
  179. + err)
  180. C /* Close in data mode */
  181. err = nf_open(testfile, NF_NOWRITE, ncid)
  182. if (err .ne. 0)
  183. + call errore('nf_open: ', err)
  184. err = nf_close(ncid)
  185. if (err .ne. 0)
  186. + call errore('nf_close in data mode failed: ', err)
  187. if (.not. readonly) then !/* tests using netCDF scratch file */
  188. err = nf_create(scratch, NF_NOCLOBBER, ncid)
  189. if (err .ne. 0)
  190. + call errore('nf_create: ', err)
  191. err = nf_close(ncid)
  192. if (err .ne. 0)
  193. + call errore('nf_close in define mode: ', err)
  194. err = nf_delete(scratch)
  195. if (err .ne. 0)
  196. + call errorc('delete of scratch file failed: ',
  197. + scratch)
  198. end if
  199. end
  200. C Test nf_inq.
  201. C Try on bad handle, check error return.
  202. C Try in data mode, check returned values.
  203. C Try asking for subsets of info.
  204. C If in writable section of tests,
  205. C Try in define mode, after adding an unlimited dimension, variable.
  206. C On exit, any open netCDF files are closed.
  207. subroutine test_nf_inq()
  208. implicit none
  209. #include "tests.inc"
  210. integer ncid
  211. integer ncid2 !/* for scratch netCDF dataset */
  212. integer ndims !/* number of dimensions */
  213. integer nvars !/* number of variables */
  214. integer ngatts !/* number of global attributes */
  215. integer recdim !/* id of unlimited dimension */
  216. integer err
  217. integer ndims0
  218. integer nvars0
  219. integer ngatts0
  220. integer recdim0
  221. integer did
  222. integer vid
  223. err = nf_open(testfile, NF_NOWRITE, ncid)
  224. if (err .ne. 0)
  225. + call errore('nf_open: ', err)
  226. C /* Try on bad handle */
  227. err = nf_inq(BAD_ID, ndims, nvars, ngatts, recdim)
  228. if (err .ne. NF_EBADID)
  229. + call errore('bad ncid: ', err)
  230. err = nf_inq(ncid, ndims, nvars, ngatts, recdim)
  231. if (err .ne. 0) then
  232. call errore('nf_inq: ', err)
  233. else if (ndims .ne. NDIMS) then
  234. call errori('nf_inq: wrong number of dimensions returned: ',
  235. + ndims)
  236. else if (nvars .ne. NVARS) then
  237. call errori('nf_inq: wrong number of variables returned: ',
  238. + nvars)
  239. else if (ngatts .ne. NGATTS) then
  240. call errori(
  241. + 'nf_inq: wrong number of global atts returned: ',
  242. + ngatts)
  243. else if (recdim .ne. RECDIM) then
  244. call errori('nf_inq: wrong record dimension ID returned: ',
  245. + recdim)
  246. end if
  247. if (.not. readonly) then !/* tests using netCDF scratch file */
  248. err = nf_create(scratch, NF_NOCLOBBER, ncid2)
  249. if (err .ne. 0) then
  250. call errore('nf_create: ', err)
  251. else !/* add dim, var, gatt, check inq */
  252. err = nf_enddef(ncid2) !/* enter data mode */
  253. err = nf_inq(ncid2, ndims0, nvars0, ngatts0, recdim0)
  254. if (err .ne. 0)
  255. + call errore('nf_inq: ', err)
  256. err = nf_redef(ncid2) !/* enter define mode */
  257. C /* Check that inquire still works in define mode */
  258. err = nf_inq(ncid2, ndims, nvars, ngatts, recdim)
  259. if (err .ne. 0) then
  260. call errore('nf_inq in define mode: ', err)
  261. else if (ndims .ne. ndims0) then
  262. call errori('nf_inq in define mode: ndims wrong, ',
  263. + ndims)
  264. else if (nvars .ne. nvars0) then
  265. call errori('nf_inq in define mode: nvars wrong, ',
  266. + nvars)
  267. else if (ngatts .ne. ngatts0) then
  268. call errori(
  269. + 'nf_inq in define mode: ngatts wrong, ', ngatts)
  270. else if (recdim .ne. recdim0) then
  271. call errori('nf_inq in define mode: recdim wrong, ',
  272. + recdim)
  273. end if
  274. C /* Add dim, var, global att */
  275. err = nf_def_dim(ncid2, 'inqd', 1, did)
  276. if (err .ne. 0)
  277. + call errore('nf_def_dim: ', err)
  278. err = nf_def_var(ncid2, 'inqv', NF_FLOAT, 0, 0, vid)
  279. if (err .ne. 0)
  280. + call errore('nf_def_var: ', err)
  281. err = nf_put_att_text(ncid2, NF_GLOBAL, 'inqa',
  282. + len('stuff'), 'stuff')
  283. if (err .ne. 0)
  284. + call errore('nf_put_att_text: ', err)
  285. C /* Make sure nf_inq sees the additions while in define mode */
  286. err = nf_inq(ncid2, ndims, nvars, ngatts, recdim)
  287. if (err .ne. 0) then
  288. call errore('nf_inq in define mode: ', err)
  289. else if (ndims .ne. ndims0 + 1) then
  290. call errori('nf_inq in define mode: ndims wrong, ',
  291. + ndims)
  292. else if (nvars .ne. nvars0 + 1) then
  293. call errori('nf_inq in define mode: nvars wrong, ',
  294. + nvars)
  295. else if (ngatts .ne. ngatts0 + 1) then
  296. call errori('nf_inq in define mode: ngatts wrong, ',
  297. + ngatts)
  298. end if
  299. err = nf_enddef(ncid2)
  300. if (err .ne. 0)
  301. + call errore('nf_enddef: ', err)
  302. C /* Make sure nf_inq stills sees additions in data mode */
  303. err = nf_inq(ncid2, ndims, nvars, ngatts, recdim)
  304. if (err .ne. 0) then
  305. call errore('nf_inq failed in data mode: ',err)
  306. else if (ndims .ne. ndims0 + 1) then
  307. call errori('nf_inq in define mode: ndims wrong, ',
  308. + ndims)
  309. else if (nvars .ne. nvars0 + 1) then
  310. call errori('nf_inq in define mode: nvars wrong, ',
  311. + nvars)
  312. else if (ngatts .ne. ngatts0 + 1) then
  313. call errori('nf_inq in define mode: ngatts wrong, ',
  314. + ngatts)
  315. end if
  316. err = nf_close(ncid2)
  317. err = nf_delete(scratch)
  318. if (err .ne. 0)
  319. + call errorc('delete of scratch file failed:',
  320. + scratch)
  321. end if
  322. end if
  323. err = nf_close(ncid)
  324. if (err .ne. 0)
  325. + call errore('nf_close: ', err)
  326. end
  327. subroutine test_nf_inq_natts()
  328. implicit none
  329. #include "tests.inc"
  330. integer ncid
  331. integer ngatts !/* number of global attributes */
  332. integer err
  333. err = nf_inq_natts(BAD_ID, ngatts)
  334. if (err .ne. NF_EBADID)
  335. + call errore('bad ncid: ', err)
  336. err = nf_open(testfile, NF_NOWRITE, ncid)
  337. if (err .ne. 0)
  338. + call errore('nf_open: ', err)
  339. err = nf_inq_natts(ncid, ngatts)
  340. if (err .ne. 0) then
  341. call errore('nf_inq_natts: ', err)
  342. else if (ngatts .ne. NGATTS) then
  343. call errori(
  344. + 'nf_inq_natts: wrong number of global atts returned, ',
  345. + ngatts)
  346. end if
  347. err = nf_close(ncid)
  348. if (err .ne. 0)
  349. + call errore('nf_close: ', err)
  350. end
  351. subroutine test_nf_inq_ndims()
  352. implicit none
  353. #include "tests.inc"
  354. integer ncid
  355. integer ndims
  356. integer err
  357. err = nf_inq_ndims(BAD_ID, ndims)
  358. if (err .ne. NF_EBADID)
  359. + call errore('bad ncid: ', err)
  360. err = nf_open(testfile, NF_NOWRITE, ncid)
  361. if (err .ne. 0)
  362. + call errore('nf_open: ', err)
  363. err = nf_inq_ndims(ncid, ndims)
  364. if (err .ne. 0) then
  365. call errore('nf_inq_ndims: ', err)
  366. else if (ndims .ne. NDIMS) then
  367. call errori('nf_inq_ndims: wrong number returned, ', ndims)
  368. end if
  369. err = nf_close(ncid)
  370. if (err .ne. 0)
  371. + call errore('nf_close: ', err)
  372. end
  373. subroutine test_nf_inq_nvars()
  374. implicit none
  375. #include "tests.inc"
  376. integer ncid
  377. integer nvars
  378. integer err
  379. err = nf_inq_nvars(BAD_ID, nvars)
  380. if (err .ne. NF_EBADID)
  381. + call errore('bad ncid: ', err)
  382. err = nf_open(testfile, NF_NOWRITE, ncid)
  383. if (err .ne. 0)
  384. + call errore('nf_open: ', err)
  385. err = nf_inq_nvars(ncid, nvars)
  386. if (err .ne. 0) then
  387. call errore('nf_inq_nvars: ', err)
  388. else if (nvars .ne. NVARS) then
  389. call errori('nf_inq_nvars: wrong number returned, ', nvars)
  390. end if
  391. err = nf_close(ncid)
  392. if (err .ne. 0)
  393. + call errore('nf_close: ', err)
  394. end
  395. subroutine test_nf_inq_unlimdim()
  396. implicit none
  397. #include "tests.inc"
  398. integer ncid
  399. integer unlimdim
  400. integer err
  401. err = nf_inq_unlimdim(BAD_ID, unlimdim)
  402. if (err .ne. NF_EBADID)
  403. + call errore('bad ncid: ', err)
  404. err = nf_open(testfile, NF_NOWRITE, ncid)
  405. if (err .ne. 0)
  406. + call errore('nf_open: ', err)
  407. err = nf_inq_unlimdim(ncid, unlimdim)
  408. if (err .ne. 0) then
  409. call errore('nf_inq_unlimdim: ', err)
  410. else if (unlimdim .ne. RECDIM) then
  411. call errori('nf_inq_unlimdim: wrong number returned, ',
  412. + unlimdim)
  413. end if
  414. err = nf_close(ncid)
  415. if (err .ne. 0)
  416. + call errore('nf_close: ', err)
  417. end
  418. subroutine test_nf_inq_format()
  419. implicit none
  420. #include "tests.inc"
  421. integer ncid
  422. integer nformat
  423. integer err
  424. err = nf_inq_format(BAD_ID, nformat)
  425. if (err .ne. NF_EBADID)
  426. + call errore('bad ncid: ', err)
  427. err = nf_open(testfile, NF_NOWRITE, ncid)
  428. if (err .ne. 0)
  429. + call errore('nf_open: ', err)
  430. err = nf_inq_format(ncid, nformat)
  431. if (err .ne. 0) then
  432. call errore('nf_inq_format: ', err)
  433. else if (nformat .ne. nf_format_classic .and.
  434. + nformat .ne. nf_format_64bit .and.
  435. + nformat .ne. nf_format_netcdf4 .and.
  436. + nformat .ne. nf_format_netcdf4_classic) then
  437. call errori('nf_inq_format: wrong format number returned, ',
  438. + nformat)
  439. end if
  440. err = nf_close(ncid)
  441. if (err .ne. 0)
  442. + call errore('nf_close: ', err)
  443. end
  444. subroutine test_nf_inq_dimid()
  445. implicit none
  446. #include "tests.inc"
  447. integer ncid
  448. integer dimid
  449. integer i
  450. integer err
  451. err = nf_open(testfile, NF_NOWRITE, ncid)
  452. if (err .ne. 0)
  453. + call errore('nf_open: ', err)
  454. err = nf_inq_dimid(ncid, 'noSuch', dimid)
  455. if (err .ne. NF_EBADDIM)
  456. + call errore('bad dim name: ', err)
  457. do 1, i = 1, NDIMS
  458. err = nf_inq_dimid(BAD_ID, dim_name(i), dimid)
  459. if (err .ne. NF_EBADID)
  460. + call errore('bad ncid: ', err)
  461. err = nf_inq_dimid(ncid, dim_name(i), dimid)
  462. if (err .ne. 0) then
  463. call errore('nf_inq_dimid: ', err)
  464. else if (dimid .ne. i) then
  465. call errori('expected ', i)
  466. call errori('got ', dimid)
  467. end if
  468. 1 continue
  469. err = nf_close(ncid)
  470. if (err .ne. 0)
  471. + call errore('nf_close: ', err)
  472. end
  473. subroutine test_nf_inq_dim()
  474. implicit none
  475. #include "tests.inc"
  476. integer ncid
  477. integer i
  478. integer err
  479. character*(NF_MAX_NAME) name
  480. integer length
  481. err = nf_open(testfile, NF_NOWRITE, ncid)
  482. if (err .ne. 0)
  483. + call errore('nf_open: ', err)
  484. do 1, i = 1, NDIMS
  485. err = nf_inq_dim(BAD_ID, i, name, length)
  486. if (err .ne. NF_EBADID)
  487. + call errore('bad ncid: ', err)
  488. err = nf_inq_dim(ncid, BAD_DIMID, name, length)
  489. if (err .ne. NF_EBADDIM)
  490. + call errore('bad dimid: ', err)
  491. err = nf_inq_dim(ncid, i, name, length)
  492. if (err .ne. 0) then
  493. call errore('nf_inq_dim: ', err)
  494. else if (dim_name(i) .ne. name) then
  495. call errorc('name unexpected: ', name)
  496. else if (dim_len(i) .ne. length) then
  497. call errori('size unexpected: ', length)
  498. end if
  499. 1 continue
  500. err = nf_close(ncid)
  501. if (err .ne. 0)
  502. + call errore('nf_close: ', err)
  503. end
  504. subroutine test_nf_inq_dimlen()
  505. implicit none
  506. #include "tests.inc"
  507. integer ncid
  508. integer i
  509. integer err
  510. integer length
  511. err = nf_open(testfile, NF_NOWRITE, ncid)
  512. if (err .ne. 0)
  513. + call errore('nf_open: ', err)
  514. do 1, i = 1, NDIMS
  515. err = nf_inq_dimlen(BAD_ID, i, length)
  516. if (err .ne. NF_EBADID)
  517. + call errore('bad ncid: ', err)
  518. err = nf_inq_dimlen(ncid, BAD_DIMID, length)
  519. if (err .ne. NF_EBADDIM)
  520. + call errore('bad dimid: ', err)
  521. err = nf_inq_dimlen(ncid, i, length)
  522. if (err .ne. 0) then
  523. call errore('nf_inq_dimlen: ', err)
  524. else if (dim_len(i) .ne. length) then
  525. call errori('size unexpected: ', length)
  526. end if
  527. 1 continue
  528. err = nf_close(ncid)
  529. if (err .ne. 0)
  530. + call errore('nf_close: ', err)
  531. end
  532. subroutine test_nf_inq_dimname()
  533. implicit none
  534. #include "tests.inc"
  535. integer ncid
  536. integer i
  537. integer err
  538. character*(NF_MAX_NAME) name
  539. err = nf_open(testfile, NF_NOWRITE, ncid)
  540. if (err .ne. 0)
  541. + call errore('nf_open: ', err)
  542. do 1, i = 1, NDIMS
  543. err = nf_inq_dimname(BAD_ID, i, name)
  544. if (err .ne. NF_EBADID)
  545. + call errore('bad ncid: ', err)
  546. err = nf_inq_dimname(ncid, BAD_DIMID, name)
  547. if (err .ne. NF_EBADDIM)
  548. + call errore('bad dimid: ', err)
  549. err = nf_inq_dimname(ncid, i, name)
  550. if (err .ne. 0) then
  551. call errore('nf_inq_dimname: ', err)
  552. else if (dim_name(i) .ne. name) then
  553. call errorc('name unexpected: ', name)
  554. end if
  555. 1 continue
  556. err = nf_close(ncid)
  557. if (err .ne. 0)
  558. + call errore('nf_close: ', err)
  559. end
  560. subroutine test_nf_inq_varid()
  561. implicit none
  562. #include "tests.inc"
  563. integer ncid
  564. integer vid
  565. integer i
  566. integer err
  567. err = nf_open(testfile, NF_NOWRITE, ncid)
  568. if (err .ne. 0)
  569. + call errore('nf_open: ', err)
  570. err = nf_inq_varid(ncid, 'noSuch', vid)
  571. if (err .ne. NF_ENOTVAR)
  572. + call errore('bad ncid: ', err)
  573. do 1, i = 1, NVARS
  574. err = nf_inq_varid(BAD_ID, var_name(i), vid)
  575. if (err .ne. NF_EBADID)
  576. + call errore('bad ncid: ', err)
  577. err = nf_inq_varid(ncid, var_name(i), vid)
  578. if (err .ne. 0) then
  579. call errore('nf_inq_varid: ', err)
  580. else if (vid .ne. i) then
  581. call errori('varid unexpected: ', vid)
  582. endif
  583. 1 continue
  584. err = nf_close(ncid)
  585. if (err .ne. 0)
  586. + call errore('nf_close: ', err)
  587. end
  588. subroutine test_nf_inq_var()
  589. implicit none
  590. #include "tests.inc"
  591. integer ncid
  592. integer i
  593. integer err
  594. character*(NF_MAX_NAME) name
  595. integer datatype
  596. integer ndims
  597. integer dimids(MAX_RANK)
  598. integer na
  599. err = nf_open(testfile, NF_NOWRITE, ncid)
  600. if (err .ne. 0)
  601. + call errore('nf_open: ', err)
  602. do 1, i = 1, NVARS
  603. err = nf_inq_var(BAD_ID, i, name, datatype, ndims, dimids,
  604. + na)
  605. if (err .ne. NF_EBADID)
  606. + call errore('bad ncid: ', err)
  607. err = nf_inq_var(ncid,BAD_VARID,name,datatype,ndims,dimids,
  608. + na)
  609. if (err .ne. NF_ENOTVAR)
  610. + call errore('bad var id: ', err)
  611. err = nf_inq_var(ncid, i, name, datatype, ndims, dimids,
  612. + na)
  613. if (err .ne. 0) then
  614. call errore('nf_inq_var: ', err)
  615. else if (var_name(i) .ne. name) then
  616. call errorc('name unexpected: ', name)
  617. else if (var_type(i) .ne. datatype) then
  618. call errori('type unexpected: ', datatype)
  619. else if (var_rank(i) .ne. ndims) then
  620. call errori('ndims expected: ', ndims)
  621. else if (.not.int_vec_eq(var_dimid(1,i),dimids,ndims)) then
  622. call error('unexpected dimid')
  623. else if (var_natts(i) .ne. na) then
  624. call errori('natts unexpected: ', na)
  625. end if
  626. 1 continue
  627. err = nf_close(ncid)
  628. if (err .ne. 0)
  629. + call errore('nf_close: ', err)
  630. end
  631. subroutine test_nf_inq_vardimid()
  632. implicit none
  633. #include "tests.inc"
  634. integer ncid
  635. integer i
  636. integer err
  637. integer dimids(MAX_RANK)
  638. err = nf_open(testfile, NF_NOWRITE, ncid)
  639. if (err .ne. 0)
  640. + call errore('nf_open: ', err)
  641. do 1, i = 1, NVARS
  642. err = nf_inq_vardimid(BAD_ID, i, dimids)
  643. if (err .ne. NF_EBADID)
  644. + call errore('bad ncid: ', err)
  645. err = nf_inq_vardimid(ncid, BAD_VARID, dimids)
  646. if (err .ne. NF_ENOTVAR)
  647. + call errore('bad var id: ', err)
  648. err = nf_inq_vardimid(ncid, i, dimids)
  649. if (err .ne. 0) then
  650. call errore('nf_inq_vardimid: ', err)
  651. else if (.not.int_vec_eq(var_dimid(1,i), dimids,
  652. + var_rank(i))) then
  653. call error('unexpected dimid')
  654. end if
  655. 1 continue
  656. err = nf_close(ncid)
  657. if (err .ne. 0)
  658. + call errore('nf_close: ', err)
  659. end
  660. subroutine test_nf_inq_varname()
  661. implicit none
  662. #include "tests.inc"
  663. integer ncid
  664. integer i
  665. integer err
  666. character*(NF_MAX_NAME) name
  667. err = nf_open(testfile, NF_NOWRITE, ncid)
  668. if (err .ne. 0)
  669. + call errore('nf_open: ', err)
  670. do 1, i = 1, NVARS
  671. err = nf_inq_varname(BAD_ID, i, name)
  672. if (err .ne. NF_EBADID)
  673. + call errore('bad ncid: ', err)
  674. err = nf_inq_varname(ncid, BAD_VARID, name)
  675. if (err .ne. NF_ENOTVAR)
  676. + call errore('bad var id: ', err)
  677. err = nf_inq_varname(ncid, i, name)
  678. if (err .ne. 0) then
  679. call errore('nf_inq_varname: ', err)
  680. else if (var_name(i) .ne. name) then
  681. call errorc('name unexpected: ', name)
  682. end if
  683. 1 continue
  684. err = nf_close(ncid)
  685. if (err .ne. 0)
  686. + call errore('nf_close: ', err)
  687. end
  688. subroutine test_nf_inq_varnatts()
  689. implicit none
  690. #include "tests.inc"
  691. integer ncid
  692. integer i
  693. integer err
  694. integer na
  695. err = nf_open(testfile, NF_NOWRITE, ncid)
  696. if (err .ne. 0)
  697. + call errore('nf_open: ', err)
  698. do 1, i = 0, NVARS ! start with global attributes
  699. err = nf_inq_varnatts(BAD_ID, i, na)
  700. if (err .ne. NF_EBADID)
  701. + call errore('bad ncid: ', err)
  702. err = nf_inq_varnatts(ncid, BAD_VARID, na)
  703. if (err .ne. NF_ENOTVAR)
  704. + call errore('bad var id: ', err)
  705. err = nf_inq_varnatts(ncid, VARID(i), na)
  706. if (err .ne. 0) then
  707. call errore('nf_inq_varnatts: ', err)
  708. else if (NATTS(i) .ne. na) then ! works for global attributes
  709. call errori('natts unexpected: ', na)
  710. end if
  711. 1 continue
  712. err = nf_close(ncid)
  713. if (err .ne. 0)
  714. + call errore('nf_close: ', err)
  715. end
  716. subroutine test_nf_inq_varndims()
  717. implicit none
  718. #include "tests.inc"
  719. integer ncid
  720. integer i
  721. integer err
  722. integer ndims
  723. err = nf_open(testfile, NF_NOWRITE, ncid)
  724. if (err .ne. 0)
  725. + call errore('nf_open: ', err)
  726. do 1, i = 1, NVARS
  727. err = nf_inq_varndims(BAD_ID, i, ndims)
  728. if (err .ne. NF_EBADID)
  729. + call errore('bad ncid: ', err)
  730. err = nf_inq_varndims(ncid, BAD_VARID, ndims)
  731. if (err .ne. NF_ENOTVAR)
  732. + call errore('bad var id: ', err)
  733. err = nf_inq_varndims(ncid, i, ndims)
  734. if (err .ne. 0) then
  735. call errore('nf_inq_varndims: ', err)
  736. else if (var_rank(i) .ne. ndims) then
  737. call errori('ndims unexpected: ', ndims)
  738. end if
  739. 1 continue
  740. err = nf_close(ncid)
  741. if (err .ne. 0)
  742. + call errore('nf_close: ', err)
  743. end
  744. subroutine test_nf_inq_vartype()
  745. implicit none
  746. #include "tests.inc"
  747. integer ncid
  748. integer i
  749. integer err
  750. integer datatype
  751. err = nf_open(testfile, NF_NOWRITE, ncid)
  752. if (err .ne. 0)
  753. + call errore('nf_open: ', err)
  754. do 1, i = 1, NVARS
  755. err = nf_inq_vartype(BAD_ID, i, datatype)
  756. if (err .ne. NF_EBADID)
  757. + call errore('bad ncid: ', err)
  758. err = nf_inq_vartype(ncid, BAD_VARID, datatype)
  759. if (err .ne. NF_ENOTVAR)
  760. + call errore('bad var id: ', err)
  761. err = nf_inq_vartype(ncid, i, datatype)
  762. if (err .ne. 0) then
  763. call errore('nf_inq_vartype: ', err)
  764. else if (var_type(i) .ne. datatype) then
  765. call errori('type unexpected: ', datatype)
  766. end if
  767. 1 continue
  768. err = nf_close(ncid)
  769. if (err .ne. 0)
  770. + call errore('nf_close: ', err)
  771. end
  772. subroutine test_nf_inq_att()
  773. implicit none
  774. #include "tests.inc"
  775. integer ncid
  776. integer i
  777. integer j
  778. integer err
  779. integer t
  780. integer n
  781. err = nf_open(testfile, NF_NOWRITE, ncid)
  782. if (err .ne. 0)
  783. + call errore('nf_open: ', err)
  784. do 1, i = 0, NVARS
  785. do 2, j = 1, NATTS(i)
  786. err = nf_inq_att(BAD_ID, i, ATT_NAME(j,i), t, n)
  787. if (err .ne. NF_EBADID)
  788. + call errore('bad ncid: ', err)
  789. err = nf_inq_att(ncid, BAD_VARID, ATT_NAME(j,i), t, n)
  790. if (err .ne. NF_ENOTVAR)
  791. + call errore('bad var id: ', err)
  792. err = nf_inq_att(ncid, i, 'noSuch', t, n)
  793. if (err .ne. NF_ENOTATT)
  794. + call errore('Bad attribute name: ', err)
  795. err = nf_inq_att(ncid, i, ATT_NAME(j,i), t, n)
  796. if (err .ne. 0) then
  797. call error(nf_strerror(err))
  798. else
  799. if (t .ne. ATT_TYPE(j,i))
  800. + call error('type not that expected')
  801. if (n .ne. ATT_LEN(j,i))
  802. + call error('length not that expected')
  803. end if
  804. 2 continue
  805. 1 continue
  806. err = nf_close(ncid)
  807. if (err .ne. 0)
  808. + call errore('nf_close: ', err)
  809. end
  810. subroutine test_nf_inq_attlen()
  811. implicit none
  812. #include "tests.inc"
  813. integer ncid
  814. integer i
  815. integer j
  816. integer err
  817. integer len
  818. err = nf_open(testfile, NF_NOWRITE, ncid)
  819. if (err .ne. 0)
  820. + call errore('nf_open: ', err)
  821. do 1, i = 0, NVARS
  822. err = nf_inq_attlen(ncid, i, 'noSuch', len)
  823. if (err .ne. NF_ENOTATT)
  824. + call errore('Bad attribute name: ', err)
  825. do 2, j = 1, NATTS(i)
  826. err = nf_inq_attlen(BAD_ID, i, ATT_NAME(j,i), len)
  827. if (err .ne. NF_EBADID)
  828. + call errore('bad ncid: ', err)
  829. err = nf_inq_attlen(ncid, BAD_VARID, ATT_NAME(j,i), len)
  830. if (err .ne. NF_ENOTVAR)
  831. + call errore('bad varid: ', err)
  832. err = nf_inq_attlen(ncid, i, ATT_NAME(j,i), len)
  833. if (err .ne. 0) then
  834. call error(nf_strerror(err))
  835. else
  836. if (len .ne. ATT_LEN(j,i))
  837. + call error('len not that expected')
  838. end if
  839. 2 continue
  840. 1 continue
  841. err = nf_close(ncid)
  842. if (err .ne. 0)
  843. + call errore('nf_close: ', err)
  844. end
  845. subroutine test_nf_inq_atttype()
  846. implicit none
  847. #include "tests.inc"
  848. integer ncid
  849. integer i
  850. integer j
  851. integer err
  852. integer datatype
  853. err = nf_open(testfile, NF_NOWRITE, ncid)
  854. if (err .ne. 0)
  855. + call errore('nf_open: ', err)
  856. do 1, i = 0, NVARS
  857. err = nf_inq_atttype(ncid, i, 'noSuch', datatype)
  858. if (err .ne. NF_ENOTATT)
  859. + call errore('Bad attribute name: ', err)
  860. do 2, j = 1, NATTS(i)
  861. err = nf_inq_atttype(BAD_ID, i, ATT_NAME(j,i), datatype)
  862. if (err .ne. NF_EBADID)
  863. + call errore('bad ncid: ', err)
  864. err = nf_inq_atttype(ncid, BAD_VARID, ATT_NAME(j,i),
  865. + datatype)
  866. if (err .ne. NF_ENOTVAR)
  867. + call errore('bad varid: ', err)
  868. err = nf_inq_atttype(ncid, i, ATT_NAME(j,i), datatype)
  869. if (err .ne. 0) then
  870. call error(nf_strerror(err))
  871. else
  872. if (datatype .ne. ATT_TYPE(j,i))
  873. + call error('type not that expected')
  874. end if
  875. 2 continue
  876. 1 continue
  877. err = nf_close(ncid)
  878. if (err .ne. 0)
  879. + call errore('nf_close: ', err)
  880. end
  881. subroutine test_nf_inq_attname()
  882. implicit none
  883. #include "tests.inc"
  884. integer ncid
  885. integer i
  886. integer j
  887. integer err
  888. character*(NF_MAX_NAME) name
  889. err = nf_open(testfile, NF_NOWRITE, ncid)
  890. if (err .ne. 0)
  891. + call errore('nf_open: ', err)
  892. do 1, i = 0, NVARS
  893. err = nf_inq_attname(ncid, i, BAD_ATTNUM, name)
  894. if (err .ne. NF_ENOTATT)
  895. + call errore('Bad attribute number: ', err)
  896. err = nf_inq_attname(ncid, i, NATTS(i)+1, name)
  897. if (err .ne. NF_ENOTATT)
  898. + call errore('Bad attribute number: ', err)
  899. do 2, j = 1, NATTS(i)
  900. err = nf_inq_attname(BAD_ID, i, j, name)
  901. if (err .ne. NF_EBADID)
  902. + call errore('bad ncid: ', err)
  903. err = nf_inq_attname(ncid, BAD_VARID, j, name)
  904. if (err .ne. NF_ENOTVAR)
  905. + call errore('bad var id: ', err)
  906. err = nf_inq_attname(ncid, i, j, name)
  907. if (err .ne. 0) then
  908. call error(nf_strerror(err))
  909. else
  910. if (ATT_NAME(j,i) .ne. name)
  911. + call error('name not that expected')
  912. end if
  913. 2 continue
  914. 1 continue
  915. err = nf_close(ncid)
  916. if (err .ne. 0)
  917. + call errore('nf_close: ', err)
  918. end
  919. subroutine test_nf_inq_attid()
  920. implicit none
  921. #include "tests.inc"
  922. integer ncid
  923. integer i
  924. integer j
  925. integer err
  926. integer attnum
  927. err = nf_open(testfile, NF_NOWRITE, ncid)
  928. if (err .ne. 0)
  929. + call errore('nf_open: ', err)
  930. do 1, i = 0, NVARS
  931. err = nf_inq_attid(ncid, i, 'noSuch', attnum)
  932. if (err .ne. NF_ENOTATT)
  933. + call errore('Bad attribute name: ', err)
  934. do 2, j = 1, NATTS(i)
  935. err = nf_inq_attid(BAD_ID, i, ATT_NAME(j,i), attnum)
  936. if (err .ne. NF_EBADID)
  937. + call errore('bad ncid: ', err)
  938. err = nf_inq_attid(ncid, BAD_VARID, ATT_NAME(j,i),
  939. + attnum)
  940. if (err .ne. NF_ENOTVAR)
  941. + call errore('bad varid: ', err)
  942. err = nf_inq_attid(ncid, i, ATT_NAME(j,i), attnum)
  943. if (err .ne. 0) then
  944. call error(nf_strerror(err))
  945. else
  946. if (attnum .ne. j)
  947. + call error('attnum not that expected')
  948. end if
  949. 2 continue
  950. 1 continue
  951. err = nf_close(ncid)
  952. if (err .ne. 0)
  953. + call errore('nf_close: ', err)
  954. end