PageRenderTime 299ms CodeModel.GetById 30ms RepoModel.GetById 0ms app.codeStats 0ms

/other/netcdf_write_matrix/src/nf_test/test_write.F

https://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 1434 lines | 1028 code | 131 blank | 275 comment | 266 complexity | b45470d26c6a56cfffb4aff473784e93 MD5 | raw file
Possible License(s): AGPL-1.0

Large files files are truncated, but you can click here to view the full file

    

  1. C********************************************************************
    2. 

  2. C   Copyright 1996, UCAR/Unidata
    3. 

  3. C   See netcdf/COPYRIGHT file for copying and redistribution conditions.
    4. 

  4. C   $Id: test_write.F,v 1.14 2005/05/16 11:42:34 ed Exp $
    5. 

  5. C********************************************************************
    6. 

  6. 

  7. 

  8. C Test nf_create
    9. 

  9. C    For mode in NF_NOCLOBBER, NF_CLOBBER do:
    10. 

  10. C       create netcdf file 'scratch.nc' with no data, close it
    11. 

  11. C       test that it can be opened, do nf_inq to check nvars = 0, etc.
    12. 

  12. C    Try again in NF_NOCLOBBER mode, check error return
    13. 

  13. C On exit, delete this file
    14. 

  14.         subroutine test_nf_create()
    15. 

  15.         implicit        none
    16. 

  16. #include "tests.inc"
    17. 

  17. 

  18.         integer clobber         !/* 0 for NF_NOCLOBBER, 1 for NF_CLOBBER */
    19. 

  19.         integer err
    20. 

  20.         integer ncid
    21. 

  21.         integer ndims           !/* number of dimensions */
    22. 

  22.         integer nvars           !/* number of variables */
    23. 

  23.         integer ngatts          !/* number of global attributes */
    24. 

  24.         integer recdim          !/* id of unlimited dimension */
    25. 

  25.         integer flags
    26. 

  26. 

  27.         flags = NF_NOCLOBBER
    28. 

  28.         do 1, clobber = 0, 1
    29. 

  29.             err = nf_create(scratch, flags, ncid)
    30. 

  30.             if (err .ne. 0) then
    31. 

  31.                 call errore('nf_create: ', err)
    32. 

  32.             end if
    33. 

  33.             err = nf_close(ncid)
    34. 

  34.             if (err .ne. 0) then
    35. 

  35.                 call errore('nf_close: ', err)
    36. 

  36.             end if
    37. 

  37.             err = nf_open(scratch, NF_NOWRITE, ncid)
    38. 

  38.             if (err .ne. 0) then
    39. 

  39.                 call errore('nf_open: ', err)
    40. 

  40.             end if
    41. 

  41.             err = nf_inq(ncid, ndims, nvars, ngatts, recdim)
    42. 

  42.             if (err .ne. 0) then
    43. 

  43.                 call errore('nf_inq: ', err)
    44. 

  44.             else if (ndims .ne. 0) then
    45. 

  45.                 call errori(
    46. 

  46.      +              'nf_inq: wrong number of dimensions returned, ',
    47. 

  47.      +              ndims)
    48. 

  48.             else if (nvars .ne. 0) then
    49. 

  49.                 call errori(
    50. 

  50.      +              'nf_inq: wrong number of variables returned, ',
    51. 

  51.      +              nvars)
    52. 

  52.             else if (ngatts .ne. 0) then
    53. 

  53.                 call errori(
    54. 

  54.      +              'nf_inq: wrong number of global atts returned, ',
    55. 

  55.      +              ngatts)
    56. 

  56.             else if (recdim .ge. 1) then
    57. 

  57.                 call errori(
    58. 

  58.      +              'nf_inq: wrong record dimension ID returned, ',
    59. 

  59.      +              recdim)
    60. 

  60.             end if
    61. 

  61.             err = nf_close(ncid)
    62. 

  62.             if (err .ne. 0) then
    63. 

  63.                 call errore('nf_close: ', err)
    64. 

  64.             end if
    65. 

  65. 

  66.             flags = NF_CLOBBER
    67. 

  67. 1       continue
    68. 

  68. 

  69.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    70. 

  70.         if (err .ne. NF_EEXIST) then
    71. 

  71.             call errore('attempt to overwrite file: ', err)
    72. 

  72.         end if
    73. 

  73.         err = nf_delete(scratch)
    74. 

  74.         if (err .ne. 0) then
    75. 

  75.             call errori('delete of scratch file failed: ', err)
    76. 

  76.         end if
    77. 

  77.         end
    78. 

  78. 

  79. 

  80. C Test nf_redef 
    81. 

  81. C (In fact also tests nf_enddef - called from test_nf_enddef)
    82. 

  82. C    BAD_ID
    83. 

  83. C    attempt redef (error) & enddef on read-only file
    84. 

  84. C    create file, define dims & vars. 
    85. 

  85. C    attempt put var (error)
    86. 

  86. C    attempt redef (error) & enddef.
    87. 

  87. C    put vars
    88. 

  88. C    attempt def new dims (error)
    89. 

  89. C    redef
    90. 

  90. C    def new dims, vars.
    91. 

  91. C    put atts
    92. 

  92. C    enddef
    93. 

  93. C    put vars
    94. 

  94. C    close
    95. 

  95. C    check file: vars & atts
    96. 

  96.         subroutine test_nf_redef()
    97. 

  97.         implicit        none
    98. 

  98. #include "tests.inc"
    99. 

  99.         integer         title_len
    100. 

  100.         parameter       (title_len = 9)
    101. 

  101. 

  102.         integer                 ncid            !/* netcdf id */
    103. 

  103.         integer                 dimid           !/* dimension id */
    104. 

  104.         integer                 vid             !/* variable id */
    105. 

  105.         integer                 err
    106. 

  106.         character*(title_len)   title
    107. 

  107.         doubleprecision         var
    108. 

  108.         character*(NF_MAX_NAME) name
    109. 

  109.         integer                 length
    110. 

  110. 

  111.         title = 'Not funny'
    112. 

  112. 

  113. C           /* BAD_ID tests */
    114. 

  114.         err = nf_redef(BAD_ID)
    115. 

  115.         if (err .ne. NF_EBADID)
    116. 

  116.      +      call errore('bad ncid: ', err)
    117. 

  117.         err = nf_enddef(BAD_ID)
    118. 

  118.         if (err .ne. NF_EBADID)
    119. 

  119.      +      call errore('bad ncid: ', err)
    120. 

  120. 

  121. C           /* read-only tests */
    122. 

  122.         err = nf_open(testfile, NF_NOWRITE, ncid)
    123. 

  123.         if (err .ne. 0)
    124. 

  124.      +      call errore('nf_open: ', err)
    125. 

  125.         err = nf_redef(ncid)
    126. 

  126.         if (err .ne. NF_EPERM)
    127. 

  127.      +      call errore('nf_redef in NF_NOWRITE mode: ', err)
    128. 

  128.         err = nf_enddef(ncid)
    129. 

  129.         if (err .ne. NF_ENOTINDEFINE)
    130. 

  130.      +      call errore('nf_redef in NF_NOWRITE mode: ', err)
    131. 

  131.         err = nf_close(ncid)
    132. 

  132.         if (err .ne. 0) 
    133. 

  133.      +      call errore('nf_close: ', err)
    134. 

  134. 

  135. C           /* tests using scratch file */
    136. 

  136.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    137. 

  137.         if (err .ne. 0) then
    138. 

  138.             call errore('nf_create: ', err)
    139. 

  139.             return
    140. 

  140.         end if
    141. 

  141.         call def_dims(ncid)
    142. 

  142.         call def_vars(ncid)
    143. 

  143.         call put_atts(ncid)
    144. 

  144.         err = nf_inq_varid(ncid, 'd', vid)
    145. 

  145.         if (err .ne. 0) 
    146. 

  146.      +      call errore('nf_inq_varid: ', err)
    147. 

  147.         var = 1.0
    148. 

  148.         err = nf_put_var1_double(ncid, vid, 0, var)
    149. 

  149.         if (err .ne. NF_EINDEFINE)
    150. 

  150.      +      call errore('nf_put_var... in define mode: ', err)
    151. 

  151.         err = nf_redef(ncid)
    152. 

  152.         if (err .ne. NF_EINDEFINE)
    153. 

  153.      +      call errore('nf_redef in define mode: ', err)
    154. 

  154.         err = nf_enddef(ncid)
    155. 

  155.         if (err .ne. 0)
    156. 

  156.      +      call errore('nf_enddef: ', err)
    157. 

  157.         call put_vars(ncid)
    158. 

  158.         err = nf_def_dim(ncid, 'abc', 8, dimid)
    159. 

  159.         if (err .ne. NF_ENOTINDEFINE)
    160. 

  160.      +      call errore('nf_def_dim in define mode: ', err)
    161. 

  161.         err = nf_redef(ncid)
    162. 

  162.         if (err .ne. 0)
    163. 

  163.      +      call errore('nf_redef: ', err)
    164. 

  164.         err = nf_def_dim(ncid, 'abc', 8, dimid)
    165. 

  165.         if (err .ne. 0)
    166. 

  166.      +      call errore('nf_def_dim: ', err)
    167. 

  167.         err = nf_def_var(ncid, 'abc', NF_INT, 0, 0, vid)
    168. 

  168.         if (err .ne. 0)
    169. 

  169.      +      call errore('nf_def_var: ', err)
    170. 

  170.         err = nf_put_att_text(ncid, NF_GLOBAL, 'title', len(title), 
    171. 

  171.      +                        title)
    172. 

  172.         if (err .ne .0)
    173. 

  173.      +      call errore('nf_put_att_text: ', err)
    174. 

  174.         err = nf_enddef(ncid)
    175. 

  175.         if (err .ne. 0)
    176. 

  176.      +      call errore('nf_enddef: ', err)
    177. 

  177.         var = 1.0
    178. 

  178.         err = nf_put_var1_double(ncid, vid, 0, var)
    179. 

  179.         if (err .ne. 0)
    180. 

  180.      +      call errore('nf_put_var1_double: ', err)
    181. 

  181.         err = nf_close(ncid)
    182. 

  182.         if (err .ne. 0) 
    183. 

  183.      +      call errore('nf_close: ', err)
    184. 

  184. 

  185. C           /* check scratch file written as expected */
    186. 

  186.         call check_file(scratch)
    187. 

  187.         err = nf_open(scratch, NF_NOWRITE, ncid)
    188. 

  188.         if (err .ne. 0)
    189. 

  189.      +      call errore('nf_open: ', err)
    190. 

  190.         err = nf_inq_dim(ncid, dimid, name, length)
    191. 

  191.         if (err .ne. 0) 
    192. 

  192.      +      call errore('nf_inq_dim: ', err)
    193. 

  193.         if (name .ne. "abc")
    194. 

  194.      +      call errori('Unexpected dim name in netCDF ', ncid)
    195. 

  195.         if (length .ne. 8) 
    196. 

  196.      +      call errori('Unexpected dim length: ', length)
    197. 

  197.         err = nf_get_var1_double(ncid, vid, 0, var)
    198. 

  198.         if (err .ne. 0)
    199. 

  199.      +      call errore('nf_get_var1_double: ', err)
    200. 

  200.         if (var .ne. 1.0)
    201. 

  201.      +      call errori(
    202. 

  202.      +          'nf_get_var1_double: unexpected value in netCDF ', ncid)
    203. 

  203.         err = nf_close(ncid)
    204. 

  204.         if (err .ne. 0)
    205. 

  205.      +      call errore('nf_close: ', err)
    206. 

  206. 

  207.         err = nf_delete(scratch)
    208. 

  208.         if (err .ne. 0)
    209. 

  209.      +      call errori('delete failed for netCDF: ', err)
    210. 

  210.         end
    211. 

  211. 

  212. C Test nf_enddef 
    213. 

  213. C Simply calls test_nf_redef which tests both nf_redef & nf_enddef
    214. 

  214. 

  215.         subroutine test_nf_enddef()
    216. 

  216.         implicit        none
    217. 

  217. #include "tests.inc"
    218. 

  218. 

  219.         call test_nf_redef
    220. 

  220.         end
    221. 

  221. 

  222. 

  223. C Test nf_sync
    224. 

  224. C    try with bad handle, check error
    225. 

  225. C    try in define mode, check error
    226. 

  226. C    try writing with one handle, reading with another on same netCDF
    227. 

  227.         subroutine test_nf_sync()
    228. 

  228.         implicit        none
    229. 

  229. #include "tests.inc"
    230. 

  230. 

  231.         integer ncidw         !/* netcdf id for writing */
    232. 

  232.         integer ncidr         !/* netcdf id for reading */
    233. 

  233.         integer err
    234. 

  234. 

  235. C           /* BAD_ID test */
    236. 

  236.         err = nf_sync(BAD_ID)
    237. 

  237.         if (err .ne. NF_EBADID)
    238. 

  238.      +      call errore('bad ncid: ', err)
    239. 

  239. 

  240. C           /* create scratch file & try nf_sync in define mode */
    241. 

  241.         err = nf_create(scratch, NF_NOCLOBBER, ncidw)
    242. 

  242.         if (err .ne. 0) then
    243. 

  243.             call errore('nf_create: ', err)
    244. 

  244.             return
    245. 

  245.         end if
    246. 

  246.         err = nf_sync(ncidw)
    247. 

  247.         if (err .ne. NF_EINDEFINE)
    248. 

  248.      +      call errore('nf_sync called in define mode: ', err)
    249. 

  249. 

  250. C           /* write using same handle */
    251. 

  251.         call def_dims(ncidw)
    252. 

  252.         call def_vars(ncidw)
    253. 

  253.         call put_atts(ncidw)
    254. 

  254.         err = nf_enddef(ncidw)
    255. 

  255.         if (err .ne. 0)
    256. 

  256.      +      call errore('nf_enddef: ', err)
    257. 

  257.         call put_vars(ncidw)
    258. 

  258.         err = nf_sync(ncidw)
    259. 

  259.         if (err .ne. 0)
    260. 

  260.      +      call errore('nf_sync of ncidw failed: ', err)
    261. 

  261. 

  262. C           /* open another handle, nf_sync, read (check) */
    263. 

  263.         err = nf_open(scratch, NF_NOWRITE, ncidr)
    264. 

  264.         if (err .ne. 0)
    265. 

  265.      +      call errore('nf_open: ', err)
    266. 

  266.         err = nf_sync(ncidr)
    267. 

  267.         if (err .ne. 0)
    268. 

  268.      +      call errore('nf_sync of ncidr failed: ', err)
    269. 

  269.         call check_dims(ncidr)
    270. 

  270.         call check_atts(ncidr)
    271. 

  271.         call check_vars(ncidr)
    272. 

  272. 

  273. C           /* close both handles */
    274. 

  274.         err = nf_close(ncidr)
    275. 

  275.         if (err .ne. 0)
    276. 

  276.      +      call errore('nf_close: ', err)
    277. 

  277.         err = nf_close(ncidw)
    278. 

  278.         if (err .ne. 0)
    279. 

  279.      +      call errore('nf_close: ', err)
    280. 

  280. 

  281.         err = nf_delete(scratch)
    282. 

  282.         if (err .ne. 0)
    283. 

  283.      +      call errori('delete of scratch file failed: ', err)
    284. 

  284.         end
    285. 

  285. 

  286. 

  287. C Test nf_abort
    288. 

  288. C    try with bad handle, check error
    289. 

  289. C    try in define mode before anything written, check that file was deleted
    290. 

  290. C    try after nf_enddef, nf_redef, define new dims, vars, atts
    291. 

  291. C    try after writing variable
    292. 

  292.         subroutine test_nf_abort()
    293. 

  293.         implicit        none
    294. 

  294. #include "tests.inc"
    295. 

  295. 

  296.         integer ncid          !/* netcdf id */
    297. 

  297.         integer err
    298. 

  298.         integer ndims
    299. 

  299.         integer nvars
    300. 

  300.         integer ngatts
    301. 

  301.         integer recdim
    302. 

  302. 

  303. C           /* BAD_ID test */
    304. 

  304.         err = nf_abort(BAD_ID)
    305. 

  305.         if (err .ne. NF_EBADID)
    306. 

  306.      +      call errore('bad ncid: status = ', err)
    307. 

  307. 

  308. C           /* create scratch file & try nf_abort in define mode */
    309. 

  309.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    310. 

  310.         if (err .ne. 0) then
    311. 

  311.             call errore('nf_create: ', err)
    312. 

  312.             return
    313. 

  313.         end if
    314. 

  314.         call def_dims(ncid)
    315. 

  315.         call def_vars(ncid)
    316. 

  316.         call put_atts(ncid)
    317. 

  317.         err = nf_abort(ncid)
    318. 

  318.         if (err .ne. 0)
    319. 

  319.      +      call errore('nf_abort of ncid failed: ', err)
    320. 

  320.         err = nf_close(ncid)    !/* should already be closed */
    321. 

  321.         if (err .ne. NF_EBADID)
    322. 

  322.      +      call errore('bad ncid: ', err)
    323. 

  323.         err = nf_delete(scratch)        !/* should already be deleted */
    324. 

  324.         if (err .eq. 0)
    325. 

  325.      +      call errori('scratch file should not exist: ', err)
    326. 

  326. 

  327. C            create scratch file
    328. 

  328. C            do nf_enddef & nf_redef
    329. 

  329. C            define new dims, vars, atts
    330. 

  330. C            try nf_abort: should restore previous state (no dims, vars, atts)
    331. 

  331.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    332. 

  332.         if (err .ne. 0) then
    333. 

  333.             call errore('nf_create: ', err)
    334. 

  334.             return
    335. 

  335.         end if
    336. 

  336.         err = nf_enddef(ncid)
    337. 

  337.         if (err .ne. 0)
    338. 

  338.      +      call errore('nf_enddef: ', err)
    339. 

  339.         err = nf_redef(ncid)
    340. 

  340.         if (err .ne. 0)
    341. 

  341.      +      call errore('nf_redef: ', err)
    342. 

  342.         call def_dims(ncid)
    343. 

  343.         call def_vars(ncid)
    344. 

  344.         call put_atts(ncid)
    345. 

  345.         err = nf_abort(ncid)
    346. 

  346.         if (err .ne. 0)
    347. 

  347.      +      call errore('nf_abort of ncid failed: ', err)
    348. 

  348.         err = nf_close(ncid)    !/* should already be closed */
    349. 

  349.         if (err .ne. NF_EBADID)
    350. 

  350.      +      call errore('bad ncid: ', err)
    351. 

  351.         err = nf_open(scratch, NF_NOWRITE, ncid)
    352. 

  352.         if (err .ne. 0)
    353. 

  353.      +      call errore('nf_open: ', err)
    354. 

  354.         err = nf_inq (ncid, ndims, nvars, ngatts, recdim)
    355. 

  355.         if (err .ne. 0)
    356. 

  356.      +      call errore('nf_inq: ', err)
    357. 

  357.         if (ndims .ne. 0)
    358. 

  358.      +      call errori('ndims should be ', 0)
    359. 

  359.         if (nvars .ne. 0)
    360. 

  360.      +      call errori('nvars should be ', 0)
    361. 

  361.         if (ngatts .ne. 0)
    362. 

  362.      +      call errori('ngatts should be ', 0)
    363. 

  363.         err = nf_close (ncid)
    364. 

  364.         if (err .ne. 0)
    365. 

  365.      +      call errore('nf_close: ', err)
    366. 

  366. 

  367. C           /* try nf_abort in data mode - should just close */
    368. 

  368.         err = nf_create(scratch, NF_CLOBBER, ncid)
    369. 

  369.         if (err .ne. 0) then
    370. 

  370.             call errore('nf_create: ', err)
    371. 

  371.             return
    372. 

  372.         end if
    373. 

  373.         call def_dims(ncid)
    374. 

  374.         call def_vars(ncid)
    375. 

  375.         call put_atts(ncid)
    376. 

  376.         err = nf_enddef(ncid)
    377. 

  377.         if (err .ne. 0)
    378. 

  378.      +      call errore('nf_enddef: ', err)
    379. 

  379.         call put_vars(ncid)
    380. 

  380.         err = nf_abort(ncid)
    381. 

  381.         if (err .ne. 0)
    382. 

  382.      +      call errore('nf_abort of ncid failed: ', err)
    383. 

  383.         err = nf_close(ncid)       !/* should already be closed */
    384. 

  384.         if (err .ne. NF_EBADID)
    385. 

  385.      +      call errore('bad ncid: ', err)
    386. 

  386.         call check_file(scratch)
    387. 

  387.         err = nf_delete(scratch)
    388. 

  388.         if (err .ne. 0)
    389. 

  389.      +      call errori('delete of scratch file failed: ', err)
    390. 

  390.         end
    391. 

  391. 

  392. 

  393. C Test nf_def_dim
    394. 

  394. C    try with bad netCDF handle, check error
    395. 

  395. C    try in data mode, check error
    396. 

  396. C    check that returned id is one more than previous id
    397. 

  397. C    try adding same dimension twice, check error
    398. 

  398. C    try with illegal sizes, check error
    399. 

  399. C    make sure unlimited size works, shows up in nf_inq_unlimdim
    400. 

  400. C    try to define a second unlimited dimension, check error
    401. 

  401.         subroutine test_nf_def_dim()
    402. 

  402.         implicit        none
    403. 

  403. #include "tests.inc"
    404. 

  404. 

  405.         integer ncid
    406. 

  406.         integer err             !/* status */
    407. 

  407.         integer i
    408. 

  408.         integer dimid         !/* dimension id */
    409. 

  409.         integer length
    410. 

  410. 

  411. C           /* BAD_ID test */
    412. 

  412.         err = nf_def_dim(BAD_ID, 'abc', 8, dimid)
    413. 

  413.         if (err .ne. NF_EBADID)
    414. 

  414.      +      call errore('bad ncid: ', err)
    415. 

  415. 

  416. C           /* data mode test */
    417. 

  417.         err = nf_create(scratch, NF_CLOBBER, ncid)
    418. 

  418.         if (err .ne. 0) then
    419. 

  419.             call errore('nf_create: ', err)
    420. 

  420.             return
    421. 

  421.         end if
    422. 

  422.         err = nf_enddef(ncid)
    423. 

  423.         if (err .ne. 0)
    424. 

  424.      +      call errore('nf_enddef: ', err)
    425. 

  425.         err = nf_def_dim(ncid, 'abc', 8, dimid)
    426. 

  426.         if (err .ne. NF_ENOTINDEFINE)
    427. 

  427.      +      call errore('bad ncid: ', err)
    428. 

  428. 

  429. C           /* define-mode tests: unlimited dim */
    430. 

  430.         err = nf_redef(ncid)
    431. 

  431.         if (err .ne. 0)
    432. 

  432.      +      call errore('nf_redef: ', err)
    433. 

  433.         err = nf_def_dim(ncid, dim_name(1), NF_UNLIMITED, dimid)
    434. 

  434.         if (err .ne. 0) 
    435. 

  435.      +      call errore('nf_def_dim: ', err)
    436. 

  436.         if (dimid .ne. 1) 
    437. 

  437.      +      call errori('Unexpected dimid: ', dimid)
    438. 

  438.         err = nf_inq_unlimdim(ncid, dimid)
    439. 

  439.         if (err .ne. 0) 
    440. 

  440.      +      call errore('nf_inq_unlimdim: ', err)
    441. 

  441.         if (dimid .ne. RECDIM) 
    442. 

  442.      +      call error('Unexpected recdim: ')
    443. 

  443.         err = nf_inq_dimlen(ncid, dimid, length)
    444. 

  444.         if (length .ne. 0) 
    445. 

  445.      +      call errori('Unexpected length: ', 0)
    446. 

  446.         err = nf_def_dim(ncid, 'abc', NF_UNLIMITED, dimid)
    447. 

  447.         if (err .ne. NF_EUNLIMIT)
    448. 

  448.      +      call errore('2nd unlimited dimension: ', err)
    449. 

  449. 

  450. C           /* define-mode tests: remaining dims */
    451. 

  451.         do 1, i = 2, NDIMS
    452. 

  452.             err = nf_def_dim(ncid, dim_name(i-1), dim_len(i), 
    453. 

  453.      +                       dimid)
    454. 

  454.             if (err .ne. NF_ENAMEINUSE)
    455. 

  455.      +          call errore('duplicate name: ', err)
    456. 

  456.             err = nf_def_dim(ncid, BAD_NAME, dim_len(i), dimid)
    457. 

  457.             if (err .ne. NF_EBADNAME)
    458. 

  458.      +          call errore('bad name: ', err)
    459. 

  459.             err = nf_def_dim(ncid, dim_name(i), NF_UNLIMITED-1, 
    460. 

  460.      +                       dimid)
    461. 

  461.             if (err .ne. NF_EDIMSIZE)
    462. 

  462.      +          call errore('bad size: ', err)
    463. 

  463.             err = nf_def_dim(ncid, dim_name(i), dim_len(i), dimid)
    464. 

  464.             if (err .ne. 0) 
    465. 

  465.      +          call errore('nf_def_dim: ', err)
    466. 

  466.             if (dimid .ne. i) 
    467. 

  467.      +          call errori('Unexpected dimid: ', 0)
    468. 

  468. 1       continue
    469. 

  469. 

  470. C           /* Following just to expand unlimited dim */
    471. 

  471.         call def_vars(ncid)
    472. 

  472.         err = nf_enddef(ncid)
    473. 

  473.         if (err .ne. 0)
    474. 

  474.      +      call errore('nf_enddef: ', err)
    475. 

  475.         call put_vars(ncid)
    476. 

  476. 

  477. C           /* Check all dims */
    478. 

  478.         call check_dims(ncid)
    479. 

  479. 

  480.         err = nf_close(ncid)
    481. 

  481.         if (err .ne. 0)
    482. 

  482.      +      call errore('nf_close: ', err)
    483. 

  483.         err = nf_delete(scratch)
    484. 

  484.         if (err .ne. 0)
    485. 

  485.      +      call errori('delete of scratch file failed: ', err)
    486. 

  486.         end
    487. 

  487. 

  488. 

  489. C Test nf_rename_dim
    490. 

  490. C    try with bad netCDF handle, check error
    491. 

  491. C    check that proper rename worked with nf_inq_dim
    492. 

  492. C    try renaming to existing dimension name, check error
    493. 

  493. C    try with bad dimension handle, check error
    494. 

  494.         subroutine test_nf_rename_dim()
    495. 

  495.         implicit        none
    496. 

  496. #include "tests.inc"
    497. 

  497. 

  498.         integer ncid
    499. 

  499.         integer err             !/* status */
    500. 

  500.         character*(NF_MAX_NAME) name
    501. 

  501. 

  502. C           /* BAD_ID test */
    503. 

  503.         err = nf_rename_dim(BAD_ID, 1, 'abc')
    504. 

  504.         if (err .ne. NF_EBADID)
    505. 

  505.      +      call errore('bad ncid: ', err)
    506. 

  506. 

  507. C           /* main tests */
    508. 

  508.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    509. 

  509.         if (err .ne. 0) then
    510. 

  510.             call errore('nf_create: ', err)
    511. 

  511.             return
    512. 

  512.         end if
    513. 

  513.         call def_dims(ncid)
    514. 

  514.         err = nf_rename_dim(ncid, BAD_DIMID, 'abc')
    515. 

  515.         if (err .ne. NF_EBADDIM)
    516. 

  516.      +      call errore('bad dimid: ', err)
    517. 

  517.         err = nf_rename_dim(ncid, 3, 'abc')
    518. 

  518.         if (err .ne. 0)
    519. 

  519.      +      call errore('nf_rename_dim: ', err)
    520. 

  520.         err = nf_inq_dimname(ncid, 3, name)
    521. 

  521.         if (name .ne. 'abc')
    522. 

  522.      +      call errorc('Unexpected name: ', name)
    523. 

  523.         err = nf_rename_dim(ncid, 1, 'abc')
    524. 

  524.         if (err .ne. NF_ENAMEINUSE)
    525. 

  525.      +      call errore('duplicate name: ', err)
    526. 

  526. 

  527.         err = nf_close(ncid)
    528. 

  528.         if (err .ne. 0)
    529. 

  529.      +      call errore('nf_close: ', err)
    530. 

  530.         err = nf_delete(scratch)
    531. 

  531.         if (err .ne. 0)
    532. 

  532.      +      call errori('delete of scratch file failed: ', err)
    533. 

  533.         end
    534. 

  534. 

  535. 

  536. C Test nf_def_var
    537. 

  537. C    try with bad netCDF handle, check error
    538. 

  538. C    try with bad name, check error
    539. 

  539. C    scalar tests:
    540. 

  540. C      check that proper define worked with nf_inq_var
    541. 

  541. C      try redefining an existing variable, check error
    542. 

  542. C      try with bad datatype, check error
    543. 

  543. C      try with bad number of dimensions, check error
    544. 

  544. C      try in data mode, check error
    545. 

  545. C    check that returned id is one more than previous id
    546. 

  546. C    try with bad dimension ids, check error
    547. 

  547.         subroutine test_nf_def_var()
    548. 

  548.         implicit        none
    549. 

  549. #include "tests.inc"
    550. 

  550. 

  551.         integer ncid
    552. 

  552.         integer vid
    553. 

  553.         integer err             !/* status */
    554. 

  554.         integer i
    555. 

  555.         integer ndims
    556. 

  556.         integer na
    557. 

  557.         character*(NF_MAX_NAME) name
    558. 

  558.         integer dimids(MAX_RANK)
    559. 

  559.         integer datatype
    560. 

  560. 

  561. C           /* BAD_ID test */
    562. 

  562.         err = nf_def_var(BAD_ID, 'abc', NF_SHORT, 0, dimids, vid)
    563. 

  563.         if (err .ne. NF_EBADID)
    564. 

  564.      +      call errore('bad ncid: status = ', err)
    565. 

  565. 

  566. C           /* scalar tests */
    567. 

  567.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    568. 

  568.         if (err .ne. 0) then
    569. 

  569.             call errore('nf_create: ', err)
    570. 

  570.             return
    571. 

  571.         end if
    572. 

  572.         err = nf_def_var(ncid, 'abc', NF_SHORT, 0, dimids, vid)
    573. 

  573.         if (err .ne. 0)
    574. 

  574.      +      call errore('nf_def_var: ', err)
    575. 

  575.         err = nf_inq_var(ncid, vid, name, datatype, ndims, dimids, 
    576. 

  576.      +                   na)
    577. 

  577.         if (err .ne. 0)
    578. 

  578.      +      call errore('nf_inq_var: ', err)
    579. 

  579.         if (name .ne. 'abc')
    580. 

  580.      +      call errorc('Unexpected name: ', name)
    581. 

  581.         if (datatype .ne. NF_SHORT)
    582. 

  582.      +      call error('Unexpected datatype')
    583. 

  583.         if (ndims .ne. 0)
    584. 

  584.      +      call error('Unexpected rank')
    585. 

  585.         err = nf_def_var(ncid, BAD_NAME, NF_SHORT, 0, dimids, vid)
    586. 

  586.         if (err .ne. NF_EBADNAME)
    587. 

  587.      +      call errore('bad name: ', err)
    588. 

  588.         err = nf_def_var(ncid, 'abc', NF_SHORT, 0, dimids, vid)
    589. 

  589.         if (err .ne. NF_ENAMEINUSE)
    590. 

  590.      +      call errore('duplicate name: ', err)
    591. 

  591.         err = nf_def_var(ncid, 'ABC', BAD_TYPE, -1, dimids, vid)
    592. 

  592.         if (err .ne. NF_EBADTYPE)
    593. 

  593.      +      call errore('bad type: ', err)
    594. 

  594.         err = nf_def_var(ncid, 'ABC', NF_SHORT, -1, dimids, vid)
    595. 

  595.         if (err .ne. NF_EINVAL)
    596. 

  596.      +      call errore('bad rank: ', err)
    597. 

  597.         err = nf_enddef(ncid)
    598. 

  598.         if (err .ne. 0)
    599. 

  599.      +      call errore('nf_enddef: ', err)
    600. 

  600.         err = nf_def_var(ncid, 'ABC', NF_SHORT, 0, dimids, vid)
    601. 

  601.         if (err .ne. NF_ENOTINDEFINE)
    602. 

  602.      +      call errore('nf_def_var called in data mode: ', err)
    603. 

  603.         err = nf_close(ncid)
    604. 

  604.         if (err .ne. 0)
    605. 

  605.      +      call errore('nf_close: ', err)
    606. 

  606.         err = nf_delete(scratch)
    607. 

  607.         if (err .ne. 0)
    608. 

  608.      +      call errorc('delete of scratch file failed: ', scratch)
    609. 

  609. 

  610. C           /* general tests using global vars */
    611. 

  611.         err = nf_create(scratch, NF_CLOBBER, ncid)
    612. 

  612.         if (err .ne. 0) then
    613. 

  613.             call errore('nf_create: ', err)
    614. 

  614.             return
    615. 

  615.         end if
    616. 

  616.         call def_dims(ncid)
    617. 

  617.         do 1, i = 1, NVARS
    618. 

  618.             err = nf_def_var(ncid, var_name(i), var_type(i), 
    619. 

  619.      +                       var_rank(i), var_dimid(1,i), vid)
    620. 

  620.             if (err .ne. 0) 
    621. 

  621.      +          call errore('nf_def_var: ', err)
    622. 

  622.             if (vid .ne. i)
    623. 

  623.      +          call error('Unexpected varid')
    624. 

  624. 1       continue
    625. 

  625. 

  626. C           /* try bad dim ids */
    627. 

  627.         dimids(1) = BAD_DIMID
    628. 

  628.         err = nf_def_var(ncid, 'abc', NF_SHORT, 1, dimids, vid)
    629. 

  629.         if (err .ne. NF_EBADDIM)
    630. 

  630.      +      call errore('bad dim ids: ', err)
    631. 

  631.         err = nf_close(ncid)
    632. 

  632.         if (err .ne. 0)
    633. 

  633.      +      call errore('nf_close: ', err)
    634. 

  634. 

  635.         err = nf_delete(scratch)
    636. 

  636.         if (err .ne. 0)
    637. 

  637.      +      call errorc('delete of scratch file failed: ', scratch)
    638. 

  638.         end
    639. 

  639. 

  640. 

  641. C Test nf_rename_var
    642. 

  642. C    try with bad netCDF handle, check error
    643. 

  643. C    try with bad variable handle, check error
    644. 

  644. C    try renaming to existing variable name, check error
    645. 

  645. C    check that proper rename worked with nf_inq_varid
    646. 

  646. C    try in data mode, check error
    647. 

  647.         subroutine test_nf_rename_var()
    648. 

  648.         implicit        none
    649. 

  649. #include "tests.inc"
    650. 

  650. 

  651.         integer ncid
    652. 

  652.         integer vid
    653. 

  653.         integer err
    654. 

  654.         integer i
    655. 

  655.         character*(NF_MAX_NAME) name
    656. 

  656. 

  657.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    658. 

  658.         if (err .ne. 0) then
    659. 

  659.             call errore('nf_create: ', err)
    660. 

  660.             return
    661. 

  661.         end if
    662. 

  662.         err = nf_rename_var(ncid, BAD_VARID, 'newName')
    663. 

  663.         if (err .ne. NF_ENOTVAR)
    664. 

  664.      +      call errore('bad var id: ', err)
    665. 

  665.         call def_dims(ncid)
    666. 

  666.         call def_vars(ncid)
    667. 

  667. 

  668. C           /* Prefix "new_" to each name */
    669. 

  669.         do 1, i = 1, NVARS
    670. 

  670.             err = nf_rename_var(BAD_ID, i, 'newName')
    671. 

  671.             if (err .ne. NF_EBADID)
    672. 

  672.      +          call errore('bad ncid: ', err)
    673. 

  673.             err = nf_rename_var(ncid, i, var_name(NVARS))
    674. 

  674.             if (err .ne. NF_ENAMEINUSE)
    675. 

  675.      +          call errore('duplicate name: ', err)
    676. 

  676.             name = 'new_' // var_name(i)
    677. 

  677.             err = nf_rename_var(ncid, i, name)
    678. 

  678.             if (err .ne. 0)
    679. 

  679.      +          call errore('nf_rename_var: ', err)
    680. 

  680.             err = nf_inq_varid(ncid, name, vid)
    681. 

  681.             if (err .ne. 0)
    682. 

  682.      +          call errore('nf_inq_varid: ', err)
    683. 

  683.             if (vid .ne. i)
    684. 

  684.      +          call error('Unexpected varid')
    685. 

  685. 1       continue
    686. 

  686. 

  687. C           /* Change to data mode */
    688. 

  688. C           /* Try making names even longer. Then restore original names */
    689. 

  689.         err = nf_enddef(ncid)
    690. 

  690.         if (err .ne. 0)
    691. 

  691.      +      call errore('nf_enddef: ', err)
    692. 

  692.         do 2, i = 1, NVARS
    693. 

  693.             name = 'even_longer_' // var_name(i)
    694. 

  694.             err = nf_rename_var(ncid, i, name)
    695. 

  695.             if (err .ne. NF_ENOTINDEFINE)
    696. 

  696.      +          call errore('longer name in data mode: ', err)
    697. 

  697.             err = nf_rename_var(ncid, i, var_name(i))
    698. 

  698.             if (err .ne. 0)
    699. 

  699.      +          call errore('nf_rename_var: ', err)
    700. 

  700.             err = nf_inq_varid(ncid, var_name(i), vid)
    701. 

  701.             if (err .ne. 0)
    702. 

  702.      +          call errore('nf_inq_varid: ', err)
    703. 

  703.             if (vid .ne. i)
    704. 

  704.      +          call error('Unexpected varid')
    705. 

  705. 2       continue
    706. 

  706. 

  707.         call put_vars(ncid)
    708. 

  708.         call check_vars(ncid)
    709. 

  709. 

  710.         err = nf_close(ncid)
    711. 

  711.         if (err .ne. 0)
    712. 

  712.      +      call errore('nf_close: ', err)
    713. 

  713. 

  714.         err = nf_delete(scratch)
    715. 

  715.         if (err .ne. 0)
    716. 

  716.      +      call errorc('delete of scratch file failed: ', scratch)
    717. 

  717.         end
    718. 

  718. 

  719. 

  720. C Test nf_copy_att
    721. 

  721. C    try with bad source or target netCDF handles, check error
    722. 

  722. C    try with bad source or target variable handle, check error
    723. 

  723. C    try with nonexisting attribute, check error
    724. 

  724. C    check that NF_GLOBAL variable for source or target works
    725. 

  725. C    check that new attribute put works with target in define mode
    726. 

  726. C    check that old attribute put works with target in data mode
    727. 

  727. C    check that changing type and length of an attribute work OK
    728. 

  728. C    try with same ncid for source and target, different variables
    729. 

  729. C    try with same ncid for source and target, same variable
    730. 

  730.         subroutine test_nf_copy_att()
    731. 

  731.         implicit        none
    732. 

  732. #include "tests.inc"
    733. 

  733. 

  734.         integer ncid_in
    735. 

  735.         integer ncid_out
    736. 

  736.         integer vid
    737. 

  737.         integer err
    738. 

  738.         integer i
    739. 

  739.         integer j
    740. 

  740.         character*(NF_MAX_NAME) name    !/* of att */
    741. 

  741.         integer datatype                !/* of att */
    742. 

  742.         integer length                  !/* of att */
    743. 

  743.         character*1     value
    744. 

  744. 

  745.         err = nf_open(testfile, NF_NOWRITE, ncid_in)
    746. 

  746.         if (err .ne. 0)
    747. 

  747.      +      call errore('nf_open: ', err)
    748. 

  748.         err = nf_create(scratch, NF_NOCLOBBER, ncid_out)
    749. 

  749.         if (err .ne. 0) then
    750. 

  750.             call errore('nf_create: ', err)
    751. 

  751.             return
    752. 

  752.         end if
    753. 

  753.         call def_dims(ncid_out)
    754. 

  754.         call def_vars(ncid_out)
    755. 

  755. 

  756.         do 1, i = 0, NVARS
    757. 

  757.             vid = VARID(i)
    758. 

  758.             do 2, j = 1, NATTS(i)
    759. 

  759.                 name = ATT_NAME(j,i)
    760. 

  760.                 err = nf_copy_att(ncid_in, BAD_VARID, name, ncid_out, 
    761. 

  761.      +                            vid)
    762. 

  762.                 if (err .ne. NF_ENOTVAR)
    763. 

  763.      +              call errore('bad var id: ', err)
    764. 

  764.                 err = nf_copy_att(ncid_in, vid, name, ncid_out, 
    765. 

  765.      +                            BAD_VARID)
    766. 

  766.                 if (err .ne. NF_ENOTVAR)
    767. 

  767.      +              call errore('bad var id: ', err)
    768. 

  768.                 err = nf_copy_att(BAD_ID, vid, name, ncid_out, vid)
    769. 

  769.                 if (err .ne. NF_EBADID)
    770. 

  770.      +              call errore('bad ncid: ', err)
    771. 

  771.                 err = nf_copy_att(ncid_in, vid, name, BAD_ID, vid)
    772. 

  772.                 if (err .ne. NF_EBADID)
    773. 

  773.      +              call errore('bad ncid: ', err)
    774. 

  774.                 err = nf_copy_att(ncid_in, vid, 'noSuch', ncid_out, vid)
    775. 

  775.                 if (err .ne. NF_ENOTATT)
    776. 

  776.      +              call errore('bad attname: ', err)
    777. 

  777.                 err = nf_copy_att(ncid_in, vid, name, ncid_out, vid)
    778. 

  778.                 if (err .ne. 0)
    779. 

  779.      +              call errore('nf_copy_att: ', err)
    780. 

  780.                 err = nf_copy_att(ncid_out, vid, name, ncid_out, vid)
    781. 

  781.                 if (err .ne. 0)
    782. 

  782.      +              call errore('source = target: ', err)
    783. 

  783. 2           continue
    784. 

  784. 1       continue
    785. 

  785. 

  786.         err = nf_close(ncid_in)
    787. 

  787.         if (err .ne. 0)
    788. 

  788.      +      call errore('nf_close: ', err)
    789. 

  789. 

  790. C           /* Close scratch. Reopen & check attributes */
    791. 

  791.         err = nf_close(ncid_out)
    792. 

  792.         if (err .ne. 0)
    793. 

  793.      +      call errore('nf_close: ', err)
    794. 

  794.         err = nf_open(scratch, NF_WRITE, ncid_out)
    795. 

  795.         if (err .ne. 0)
    796. 

  796.      +      call errore('nf_open: ', err)
    797. 

  797.         call check_atts(ncid_out)
    798. 

  798. 

  799. C           change to define mode
    800. 

  800. C           define single char. global att. ':a' with value 'A'
    801. 

  801. C           This will be used as source for following copies
    802. 

  802.         err = nf_redef(ncid_out)
    803. 

  803.         if (err .ne. 0)
    804. 

  804.      +      call errore('nf_redef: ', err)
    805. 

  805.         err = nf_put_att_text(ncid_out, NF_GLOBAL, 'a', 1, 'A')
    806. 

  806.         if (err .ne. 0)
    807. 

  807.      +      call errore('nf_put_att_text: ', err)
    808. 

  808. 

  809. C           change to data mode
    810. 

  810. C           Use scratch as both source & dest.
    811. 

  811. C           try copy to existing att. change type & decrease length
    812. 

  812. C           rename 1st existing att of each var (if any) 'a'
    813. 

  813. C           if this att. exists them copy ':a' to it
    814. 

  814.         err = nf_enddef(ncid_out)
    815. 

  815.         if (err .ne. 0)
    816. 

  816.      +      call errore('nf_enddef: ', err)
    817. 

  817.         do 3, i = 1, NVARS
    818. 

  818.             if (NATTS(i) .gt. 0 .and. ATT_LEN(1,i) .gt. 0) then
    819. 

  819.                 err = nf_rename_att(ncid_out, i, att_name(1,i), 'a')
    820. 

  820.                 if (err .ne. 0)
    821. 

  821.      +              call errore('nf_rename_att: ', err)
    822. 

  822.                 err = nf_copy_att(ncid_out, NF_GLOBAL, 'a', ncid_out, 
    823. 

  823.      +                            i)
    824. 

  824.                 if (err .ne. 0)
    825. 

  825.      +              call errore('nf_copy_att: ', err)
    826. 

  826.             end if
    827. 

  827. 3       continue
    828. 

  828.         err = nf_close(ncid_out)
    829. 

  829.         if (err .ne. 0)
    830. 

  830.      +      call errore('nf_close: ', err)
    831. 

  831. 

  832. C           /* Reopen & check */
    833. 

  833.         err = nf_open(scratch, NF_WRITE, ncid_out)
    834. 

  834.         if (err .ne. 0)
    835. 

  835.      +      call errore('nf_open: ', err)
    836. 

  836.         do 4, i = 1, NVARS
    837. 

  837.             if (NATTS(i) .gt. 0 .and. ATT_LEN(1,i) .gt. 0) then
    838. 

  838.                 err = nf_inq_att(ncid_out, i, 'a', datatype, length)
    839. 

  839.                 if (err .ne. 0)
    840. 

  840.      +              call errore('nf_inq_att: ', err)
    841. 

  841.                 if (datatype .ne. NF_CHAR)
    842. 

  842.      +              call error('Unexpected type')
    843. 

  843.                 if (length .ne. 1)
    844. 

  844.      +              call error('Unexpected length')
    845. 

  845.                 err = nf_get_att_text(ncid_out, i, 'a', value)
    846. 

  846.                 if (err .ne. 0)
    847. 

  847.      +              call errore('nf_get_att_text: ', err)
    848. 

  848.                 if (value .ne. 'A')
    849. 

  849.      +              call error('Unexpected value')
    850. 

  850.             end if                                                   
    851. 

  851. 4       continue                                                   
    852. 

  852. 

  853.         err = nf_close(ncid_out)
    854. 

  854.         if (err .ne. 0)
    855. 

  855.      +      call errore('nf_close: ', err)
    856. 

  856.         err = nf_delete(scratch)
    857. 

  857.         if (err .ne. 0)
    858. 

  858.      +      call errorc('delete of scratch file failed', scratch)
    859. 

  859.         end
    860. 

  860. 

  861. 

  862. C Test nf_rename_att
    863. 

  863. C    try with bad netCDF handle, check error
    864. 

  864. C    try with bad variable handle, check error
    865. 

  865. C    try with nonexisting att name, check error
    866. 

  866. C    try renaming to existing att name, check error
    867. 

  867. C    check that proper rename worked with nf_inq_attid
    868. 

  868. C    try in data mode, check error
    869. 

  869.         subroutine test_nf_rename_att()
    870. 

  870.         implicit        none
    871. 

  871. #include "tests.inc"
    872. 

  872. 

  873.         integer ncid
    874. 

  874.         integer vid
    875. 

  875.         integer err
    876. 

  876.         integer i
    877. 

  877.         integer j
    878. 

  878.         integer  k
    879. 

  879.         integer attnum
    880. 

  880.         character*(NF_MAX_NAME) atnam
    881. 

  881.         character*(NF_MAX_NAME) name
    882. 

  882.         character*(NF_MAX_NAME) oldname
    883. 

  883.         character*(NF_MAX_NAME) newname
    884. 

  884.         integer nok             !/* count of valid comparisons */
    885. 

  885.         integer datatype
    886. 

  886.         integer attyp
    887. 

  887.         integer length
    888. 

  888.         integer attlength
    889. 

  889.         integer ndx(1)
    890. 

  890.         character*(MAX_NELS)    text
    891. 

  891.         doubleprecision value(MAX_NELS)
    892. 

  892.         doubleprecision expect
    893. 

  893. 

  894.         nok = 0
    895. 

  895. 

  896.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    897. 

  897.         if (err .ne. 0) then
    898. 

  898.             call errore('nf_create: ', err)
    899. 

  899.             return
    900. 

  900.         end if
    901. 

  901.         err = nf_rename_att(ncid, BAD_VARID, 'abc', 'newName')
    902. 

  902.         if (err .ne. NF_ENOTVAR)
    903. 

  903.      +      call errore('bad var id: ', err)
    904. 

  904.         call def_dims(ncid)
    905. 

  905.         call def_vars(ncid)
    906. 

  906.         call put_atts(ncid)
    907. 

  907. 

  908.         do 1, i = 0, NVARS
    909. 

  909.             vid = VARID(i)
    910. 

  910.             do 2, j = 1, NATTS(i)
    911. 

  911.                 atnam = ATT_NAME(j,i)
    912. 

  912.                 err = nf_rename_att(BAD_ID, vid, atnam, 'newName')
    913. 

  913.                 if (err .ne. NF_EBADID)
    914. 

  914.      +              call errore('bad ncid: ', err)
    915. 

  915.                 err = nf_rename_att(ncid, vid, 'noSuch', 'newName')
    916. 

  916.                 if (err .ne. NF_ENOTATT)
    917. 

  917.      +              call errore('bad attname: ', err)
    918. 

  918.                 newname = 'new_' // atnam
    919. 

  919.                 err = nf_rename_att(ncid, vid, atnam, newname)
    920. 

  920.                 if (err .ne. 0)
    921. 

  921.      +              call errore('nf_rename_att: ', err)
    922. 

  922.                 err = nf_inq_attid(ncid, vid, newname, attnum)
    923. 

  923.                 if (err .ne. 0)
    924. 

  924.      +              call errore('nf_inq_attid: ', err)
    925. 

  925.                 if (attnum .ne. j)
    926. 

  926.      +              call error('Unexpected attnum')
    927. 

  927. 2           continue
    928. 

  928. 1       continue
    929. 

  929. 

  930. C           /* Close. Reopen & check */
    931. 

  931.         err = nf_close(ncid)
    932. 

  932.         if (err .ne. 0)
    933. 

  933.      +      call errore('nf_close: ', err)
    934. 

  934.         err = nf_open(scratch, NF_WRITE, ncid)
    935. 

  935.         if (err .ne. 0)
    936. 

  936.      +      call errore('nf_open: ', err)
    937. 

  937. 

  938.         do 3, i = 0, NVARS
    939. 

  939.             vid = VARID(i)
    940. 

  940.             do 4, j = 1, NATTS(i)
    941. 

  941.                 atnam = ATT_NAME(j,i)
    942. 

  942.                 attyp = ATT_TYPE(j,i)
    943. 

  943.                 attlength = ATT_LEN(j,i)
    944. 

  944.                 newname = 'new_' // atnam
    945. 

  945.                 err = nf_inq_attname(ncid, vid, j, name)
    946. 

  946.                 if (err .ne. 0)
    947. 

  947.      +              call errore('nf_inq_attname: ', err)
    948. 

  948.                 if (name .ne. newname)
    949. 

  949.      +              call error('nf_inq_attname: unexpected name')
    950. 

  950.                 err = nf_inq_att(ncid, vid, name, datatype, length)
    951. 

  951.                 if (err .ne. 0)
    952. 

  952.      +              call errore('nf_inq_att: ', err)
    953. 

  953.                 if (datatype .ne. attyp)
    954. 

  954.      +              call error('nf_inq_att: unexpected type')
    955. 

  955.                 if (length .ne. attlength)
    956. 

  956.      +              call error('nf_inq_att: unexpected length')
    957. 

  957.                 if (datatype .eq. NF_CHAR) then
    958. 

  958.                     err = nf_get_att_text(ncid, vid, name, text)
    959. 

  959.                     if (err .ne. 0)
    960. 

  960.      +                  call errore('nf_get_att_text: ', err)
    961. 

  961.                     do 5, k = 1, attlength
    962. 

  962.                         ndx(1) = k
    963. 

  963.                         expect = hash(datatype, -1, ndx)
    964. 

  964.                         if (ichar(text(k:k)) .ne. expect) then
    965. 

  965.                             call error(
    966. 

  966.      +                          'nf_get_att_text: unexpected value')
    967. 

  967.                         else
    968. 

  968.                             nok = nok + 1
    969. 

  969.                         end if
    970. 

  970. 5                   continue
    971. 

  971.                 else
    972. 

  972.                     err = nf_get_att_double(ncid, vid, name, value)
    973. 

  973.                     if (err .ne. 0)
    974. 

  974.      +                  call errore('nf_get_att_double: ', err)
    975. 

  975.                     do 6, k = 1, attlength
    976. 

  976.                         ndx(1) = k
    977. 

  977.                         expect = hash(datatype, -1, ndx)
    978. 

  978.                         if (inRange(expect, datatype)) then
    979. 

  979.                             if (.not. equal(value(k),expect,datatype,
    980. 

  980.      +                                      NF_DOUBLE)) then
    981. 

  981.                                 call error(
    982. 

  982.      +                          'nf_get_att_double: unexpected value')
    983. 

  983.                             else
    984. 

  984.                                 nok = nok + 1
    985. 

  985.                             end if
    986. 

  986.                         end if
    987. 

  987. 6                   continue
    988. 

  988.                 end if
    989. 

  989. 4           continue
    990. 

  990. 3       continue
    991. 

  991.         call print_nok(nok)
    992. 

  992. 

  993. C           /* Now in data mode */
    994. 

  994. C           /* Try making names even longer. Then restore original names */
    995. 

  995. 

  996.         do 7, i = 0, NVARS
    997. 

  997.             vid = VARID(i)
    998. 

  998.             do 8, j = 1, NATTS(i)
    999. 

  999.                 atnam = ATT_NAME(j,i)
    1000. 

  1000.                 oldname = 'new_' // atnam
    1001. 

  1001.                 newname = 'even_longer_' // atnam
    1002. 

  1002.                 err = nf_rename_att(ncid, vid, oldname, newname)
    1003. 

  1003.                 if (err .ne. NF_ENOTINDEFINE)
    1004. 

  1004.      +              call errore('longer name in data mode: ', err)
    1005. 

  1005.                 err = nf_rename_att(ncid, vid, oldname, atnam)
    1006. 

  1006.                 if (err .ne. 0)
    1007. 

  1007.      +              call errore('nf_rename_att: ', err)
    1008. 

  1008.                 err = nf_inq_attid(ncid, vid, atnam, attnum)
    1009. 

  1009.                 if (err .ne. 0)
    1010. 

  1010.      +              call errore('nf_inq_attid: ', err)
    1011. 

  1011.                 if (attnum .ne. j)
    1012. 

  1012.      +              call error('Unexpected attnum')
    1013. 

  1013. 8           continue
    1014. 

  1014. 7       continue
    1015. 

  1015. 

  1016.         err = nf_close(ncid)
    1017. 

  1017.         if (err .ne. 0)
    1018. 

  1018.      +      call errore('nf_close: ', err)
    1019. 

  1019. 

  1020.         err = nf_delete(scratch)
    1021. 

  1021.         if (err .ne. 0)
    1022. 

  1022.      +      call errori('delete of scratch file failed: ', err)
    1023. 

  1023.         end
    1024. 

  1024. 

  1025. 

  1026. C Test nf_del_att
    1027. 

  1027. C    try with bad netCDF handle, check error
    1028. 

  1028. C    try with bad variable handle, check error
    1029. 

  1029. C    try with nonexisting att name, check error
    1030. 

  1030. C    check that proper delete worked using:
    1031. 

  1031. C      nf_inq_attid, nf_inq_natts, nf_inq_varnatts
    1032. 

  1032.         subroutine test_nf_del_att()
    1033. 

  1033.         implicit        none
    1034. 

  1034. #include "tests.inc"
    1035. 

  1035. 

  1036.         integer ncid
    1037. 

  1037.         integer err
    1038. 

  1038.         integer i
    1039. 

  1039.         integer j
    1040. 

  1040.         integer attnum
    1041. 

  1041.         integer na
    1042. 

  1042.         integer numatts
    1043. 

  1043.         integer vid
    1044. 

  1044.         character*(NF_MAX_NAME)  name           !/* of att */
    1045. 

  1045. 

  1046.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    1047. 

  1047.         if (err .ne. 0) then
    1048. 

  1048.             call errore('nf_create: ', err)
    1049. 

  1049.             return
    1050. 

  1050.         end if
    1051. 

  1051.         err = nf_del_att(ncid, BAD_VARID, 'abc')
    1052. 

  1052.         if (err .ne. NF_ENOTVAR)
    1053. 

  1053.      +      call errore('bad var id: ', err)
    1054. 

  1054.         call def_dims(ncid)
    1055. 

  1055.         call def_vars(ncid)
    1056. 

  1056.         call put_atts(ncid)
    1057. 

  1057. 

  1058.         do 1, i = 0, NVARS
    1059. 

  1059.             vid = VARID(i)
    1060. 

  1060.             numatts = NATTS(i)
    1061. 

  1061.             do 2, j = 1, numatts
    1062. 

  1062.                 name = ATT_NAME(j,i)
    1063. 

  1063.                 err = nf_del_att(BAD_ID, vid, name)
    1064. 

  1064.                 if (err .ne. NF_EBADID)
    1065. 

  1065.      +              call errore('bad ncid: ', err)
    1066. 

  1066.                 err = nf_del_att(ncid, vid, 'noSuch')
    1067. 

  1067.                 if (err .ne. NF_ENOTATT)
    1068. 

  1068.      +              call errore('bad attname: ', err)
    1069. 

  1069.                 err = nf_del_att(ncid, vid, name)
    1070. 

  1070.                 if (err .ne. 0)
    1071. 

  1071.      +              call errore('nf_del_att: ', err)
    1072. 

  1072.                 err = nf_inq_attid(ncid, vid, name, attnum)
    1073. 

  1073.                 if (err .ne. NF_ENOTATT)
    1074. 

  1074.      +              call errore('bad attname: ', err)
    1075. 

  1075.                 if (i .lt. 1) then
    1076. 

  1076.                     err = nf_inq_natts(ncid, na)
    1077. 

  1077.                     if (err .ne. 0)
    1078. 

  1078.      +                  call errore('nf_inq_natts: ', err)
    1079. 

  1079. 		    if (na .ne. numatts-j) then
    1080. 

  1080. 			call errori('natts: expected: ', numatts-j)
    1081. 

  1081. 			call errori('natts: got:      ', na)
    1082. 

  1082. 		    end if
    1083. 

  1083. 		end if
    1084. 

  1084. 		err = nf_inq_varnatts(ncid, vid, na)
    1085. 

  1085. 		if (err .ne. 0)
    1086. 

  1086.      +              call errore('nf_inq_natts: ', err)
    1087. 

  1087.                 if (na .ne. numatts-j) then
    1088. 

  1088.                     call errori('natts: expected: ', numatts-j)
    1089. 

  1089.                     call errori('natts: got:      ', na)
    1090. 

  1090.                 end if
    1091. 

  1091. 2           continue
    1092. 

  1092. 1       continue
    1093. 

  1093. 

  1094. C           /* Close. Reopen & check no attributes left */
    1095. 

  1095.         err = nf_close(ncid)
    1096. 

  1096.         if (err .ne. 0)
    1097. 

  1097.      +      call errore('nf_close: ', err)
    1098. 

  1098.         err = nf_open(scratch, NF_WRITE, ncid)
    1099. 

  1099.         if (err .ne. 0)
    1100. 

  1100.      +      call errore('nf_open: ', err)
    1101. 

  1101.         err = nf_inq_natts(ncid, na)
    1102. 

  1102.         if (err .ne. 0)
    1103. 

  1103.      +      call errore('nf_inq_natts: ', err)
    1104. 

  1104.         if (na .ne. 0)
    1105. 

  1105.      +      call errori('natts: expected 0, got ', na)
    1106. 

  1106.         do 3, i = 0, NVARS
    1107. 

  1107.             vid = VARID(i)
    1108. 

  1108.             err = nf_inq_varnatts(ncid, vid, na)
    1109. 

  1109.             if (err .ne. 0)
    1110. 

  1110.      +          call errore('nf_inq_natts: ', err)
    1111. 

  1111.             if (na .ne. 0)
    1112. 

  1112.      +          call errori('natts: expected 0, got ', na)
    1113. 

  1113. 3       continue
    1114. 

  1114. 

  1115. C           /* restore attributes. change to data mode. try to delete */
    1116. 

  1116.         err = nf_redef(ncid)
    1117. 

  1117.         if (err .ne. 0)
    1118. 

  1118.      +      call errore('nf_redef: ', err)
    1119. 

  1119.         call put_atts(ncid)
    1120. 

  1120.         err = nf_enddef(ncid)
    1121. 

  1121.         if (err .ne. 0)
    1122. 

  1122.      +      call errore('nf_enddef: ', err)
    1123. 

  1123. 

  1124.         do 4, i = 0, NVARS
    1125. 

  1125.             vid = VARID(i)
    1126. 

  1126.             numatts = NATTS(i)
    1127. 

  1127.             do 5, j = 1, numatts
    1128. 

  1128.                 name = ATT_NAME(j,i)
    1129. 

  1129.                 err = nf_del_att(ncid, vid, name)
    1130. 

  1130.                 if (err .ne. NF_ENOTINDEFINE)
    1131. 

  1131.      +              call errore('in data mode: ', err)
    1132. 

  1132. 5           continue
    1133. 

  1133. 4       continue
    1134. 

  1134. 

  1135.         err = nf_close(ncid)
    1136. 

  1136.         if (err .ne. 0)
    1137. 

  1137.      +      call errore('nf_close: ', err)
    1138. 

  1138.         err = nf_delete(scratch)
    1139. 

  1139.         if (err .ne. 0)
    1140. 

  1140.      +      call errori('delete of scratch file failed: ', err)
    1141. 

  1141.         end
    1142. 

  1142. 

  1143. 

  1144. C Test nf_set_fill
    1145. 

  1145. C    try with bad netCDF handle, check error
    1146. 

  1146. C    try in read-only mode, check error
    1147. 

  1147. C    try with bad new_fillmode, check error
    1148. 

  1148. C    try in data mode, check error
    1149. 

  1149. C    check that proper set to NF_FILL works for record & non-record variables
    1150. 

  1150. C    (note that it is not possible to test NF_NOFILL mode!)
    1151. 

  1151. C    close file & create again for test using attribute _FillValue
    1152. 

  1152.         subroutine test_nf_set_fill()
    1153. 

  1153.         implicit none
    1154. 

  1154. #include "tests.inc"
    1155. 

  1155. 

  1156.         integer ncid
    1157. 

  1157.         integer vid
    1158. 

  1158.         integer err
    1159. 

  1159.         integer i
    1160. 

  1160.         integer j
    1161. 

  1161.         integer old_fillmode
    1162. 

  1162.         integer nok             !/* count of valid comparisons */
    1163. 

  1163.         character*1 text
    1164. 

  1164.         doubleprecision value
    1165. 

  1165.         doubleprecision fill
    1166. 

  1166.         integer index(MAX_RANK)
    1167. 

  1167. 

  1168.         nok = 0
    1169. 

  1169.         value = 0
    1170. 

  1170. 

  1171. C           /* bad ncid */
    1172. 

  1172.         err = nf_set_fill(BAD_ID, NF_NOFILL, old_fillmode)
    1173. 

  1173.         if (err .ne. NF_EBADID)
    1174. 

  1174.      +      call errore('bad ncid: ', err)
    1175. 

  1175. 

  1176. C           /* try in read-only mode */
    1177. 

  1177.         err = nf_open(testfile, NF_NOWRITE, ncid)
    1178. 

  1178.         if (err .ne. 0)
    1179. 

  1179.      +      call errore('nf_open: ', err)
    1180. 

  1180.         err = nf_set_fill(ncid, NF_NOFILL, old_fillmode)
    1181. 

  1181.         if (err .ne. NF_EPERM)
    1182. 

  1182.      +      call errore('read-only: ', err)
    1183. 

  1183.         err = nf_close(ncid)
    1184. 

  1184.         if (err .ne. 0)
    1185. 

  1185.      +      call errore('nf_close: ', err)
    1186. 

  1186. 

  1187. C           /* create scratch */
    1188. 

  1188.         err = nf_create(scratch, NF_NOCLOBBER, ncid)
    1189. 

  1189.         if (err .ne. 0) then
    1190. 

  1190.             call errore('nf_create: ', err)
    1191. 

  1191.             return
    1192. 

  1192.         end if
    1193. 

  1193. 

  1194. C           /* BAD_FILLMODE */
    1195. 

  1195.         err = nf_set_fill(ncid, BAD_FILLMODE, old_fillmode)
    1196. 

  1196.         if (err .ne. NF_EINVAL)
    1197. 

  1197.      +      call errore('bad fillmode: ', err)
    1198. 

  1198. 

  1199. C           /* proper calls */
    1200. 

  1200.         err = nf_set_fill(ncid, NF_NOFILL, old_fillmode)
    1201. 

  1201.         if (err .ne. 0)
    1202. 

  1202.      +      call errore('nf_set_fill: ', err)
    1203. 

  1203.         if (old_fillmode .ne. NF_FILL)
    1204. 

  1204.      +      call errori('Unexpected old fill mode: ', old_fillmode)
    1205. 

  1205.         err = nf_set_fill(ncid, NF_FILL, old_fillmode)
    1206. 

  1206.         if (err .ne. 0)
    1207. 

  1207.      +      call errore('nf_set_fill: ', err)
    1208. 

  1208.         if (old_fillmode .ne. NF_NOFILL)
    1209. 

  1209.      +      call errori('Unexpected old fill mode: ', old_fillmode)
    1210. 

  1210. 

  1211. C           /* define dims & vars */
    1212. 

  1212.         call def_dims(ncid)
    1213. 

  1213.         call def_vars(ncid)
    1214. 

  1214. 

  1215. C           /* Change to data mode. Set fillmode again */
    1216. 

  1216.         err = nf_enddef(ncid)
    1217. 

  1217.         if (err .ne. 0)
    1218. 

  1218.      +      call errore('nf_enddef: ', err)
    1219. 

  1219.         err = nf_set_fill(ncid, NF_FILL, old_fillmode)
    1220. 

  1220.         if (err .ne. 0)
    1221. 

  1221.      +      call errore('nf_set_fill: ', err)
    1222. 

  1222.         if (old_fillmode .ne. NF_FILL)
    1223. 

  1223.      +      call errori('Unexpected old fill mode: ', old_fillmode)
    1224. 

  1224. 

  1225. C       /* Write record number NRECS to force writing of preceding records */
    1226. 

  1226. C       /* Assumes variable cr is char vector with UNLIMITED dimension */
    1227. 

  1227.         err = nf_inq_varid(ncid, 'cr', vid)
    1228. 

  1228.         if (err .ne. 0)
    1229. 

  1229.      +      call errore('nf_inq_varid: ', err)
    1230. 

  1230.         index(1) = NRECS
    1231. 

  1231.         text = char(NF_FILL_CHAR)
    1232. 

  1232.         err = nf_put_var1_text(ncid, vid, index, text)
    1233. 

  1233.         if (err .ne. 0)
    1234. 

  1234.      +      call errore('nf_put_var1_text: ', err)
    1235. 

  1235. 

  1236. C           /* get all variables & check all values equal default fill */
    1237. 

  1237.         do 1, i = 1, NVARS
    1238. 

  1238.             if (var_type(i) .eq. NF_CHAR) then
    1239. 

  1239.                 fill = NF_FILL_CHAR
    1240. 

  1240.             else if (var_type(i) .eq. NF_BYTE) then
    1241. 

  1241.                 fill = NF_FILL_BYTE
    1242. 

  1242.             else if (var_type(i) .eq. NF_SHORT) then
    1243. 

  1243.                 fill = NF_FILL_SHORT
    1244. 

  1244.             else if (var_type(i) .eq. NF_INT) then
    1245. 

  1245.                 fill = NF_FILL_INT
    1246. 

  1246.             else if (var_type(i) .eq. NF_FLOAT) then
    1247. 

  1247.                 fill = NF_FILL_FLOAT
    1248. 

  1248.             else if (var_type(i) .eq. NF_DOUBLE) then
    1249. 

  1249.                 fill = NF_FILL_DOUBLE
    1250. 

  1250.             else
    1251. 

  1251.                 stop 'test_nf_set_fill(): impossible var_type(i)'
    1252. 

  1252.             end if
    1253. 

  1253. 

  1254.             do 2, j = 1, var_nels(i)
    1255. 

  1255.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    1256. 

  1256.      +                              index)
    1257. 

  1257.                 if (err .ne. 0)
    1258. 

  1258.      +              call error('error in index2indexes()')
    1259. 

  1259.                 if (var_type(i) .eq. NF_CHAR) then
    1260. 

  1260.                     err = nf_get_var1_text(ncid, i, index, text)
    1261. 

  1261.                     if (err .ne. 0)
    1262. 

  1262.      +                  call errore('nf_get_var1_text failed: ',err)
    1263. 

  1263.                     value = ichar(text)
    1264. 

  1264.                 else
    1265. 

  1265.                     err = nf_get_var1_double(ncid, i, index, value)
    1266. 

  1266.                     if (err .ne. 0)
    1267. 

  1267.      +                  call errore('nf_get_var1_double failed: ',err)
    1268. 

  1268.                 end if
    1269. 

  1269.                 if (value .ne. fill .and. 
    1270. 

  1270.      +              abs((fill - value)/fill) .gt. 1.0e-9) then
    1271. 

  1271.                     call errord('Unexpected fill value: ', value)
    1272. 

  1272.                 else
    1273. 

  1273.                     nok = nok + 1
    1274. 

  1274.                 end if
    1275. 

  1275. 2           continue
    1276. 

  1276. 1       continue
    1277. 

  1277. 

  1278. C       /* close scratch & create again for test using attribute _FillValue */
    1279. 

  1279.         err = nf_close(ncid)
    1280. 

  1280.         if (err .ne. 0)
    1281. 

  1281.      +      call errore('nf_close: ', err)
    1282. 

  1282.         err = nf_create(scratch, NF_CLOBBER, ncid)
    1283. 

  1283.         if (err .ne. 0) then
    1284. 

  1284.             call errore('nf_create: ', err)
    1285. 

  1285.             return
    1286. 

  1286.         end if
    1287. 

  1287.         call def_dims(ncid)
    1288. 

  1288.         call def_vars(ncid)
    1289. 

  1289. 

  1290. C           /* set _FillValue = 42 for all vars */
    1291. 

  1291.         fill = 42
    1292. 

  1292.         text = char(int(fill))
    1293. 

  1293.         do 3, i = 1, NVARS
    1294. 

  1294.             if (var_type(i) .eq. NF_CHAR) then
    1295. 

  1295.                 err = nf_put_att_text(ncid, i, '_FillValue', 1, text)
    1296. 

  1296.                 if (err .ne. 0)
    1297. 

  1297.      +              call errore('nf_put_att_text: ', err)
    1298. 

  1298.             else
    1299. 

  1299.                 err = nf_put_att_double(ncid, i, '_FillValue',
    1300. 

  1300.      +                                  var_type(i),1,fill)
    1301. 

  1301.                 if (err .ne. 0)
    1302. 

  1302.      +              call errore('nf_put_att_double: ', err)
    1303. 

  1303.             end if
    1304. 

  1304. 3       continue
    1305. 

  1305. 

  1306. C           /* data mode. write records */
    1307. 

  1307.         err = nf_enddef(ncid)
    1308. 

  1308.         if (err .ne. 0)
    1309. 

  1309.      +      call errore('nf_enddef: ', err)
    1310. 

  1310.         index(1) = NRECS
    1311. 

  1311.         err = nf_put_var1_text(ncid, vid, index, text)
    1312. 

  1312.         if (err .ne. 0)
    1313. 

  1313.      +      call errore('nf_put_var1_text: ', err)
    1314. 

  1314. 

  1315. C           /* get all variables & check all values equal 42 */
    1316. 

  1316.         do 4, i = 1, NVARS
    1317. 

  1317.             do 5, j = 1, var_nels(i)
    1318. 

  1318.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    1319. 

  1319.      +                              index)
    1320. 

  1320.                 if (err .ne. 0)
    1321. 

  1321.      +              call error('error in index2indexes')
    1322. 

  1322.                 if (var_type(i) .eq. NF_CHAR) then
    1323. 

  1323.                     err = nf_get_var1_text(ncid, i, index, text)
    1324. 

  1324.                     if (err .ne. 0)
    1325. 

  1325.      +                  call errore('nf_get_var1_text failed: ',err)
    1326. 

  1326.                     value = ichar(text)
    1327. 

  1327.                 else
    1328. 

  1328.                     err = nf_get_var1_double(ncid, i, index, value)
    1329. 

  1329.                     if (err .ne. 0)
    1330. 

  1330.      +                  call errore('nf_get_var1_double failed: ', err)
    1331. 

  1331.                 end if
    1332. 

  1332.                 if (value .ne. fill) then
    1333. 

  1333.                     call errord(' Value expected: ', fill)
    1334. 

  1334.                     call errord(' Value read:     ', value)
    1335. 

  1335.                 else
    1336. 

  1336.                     nok = nok + 1
    1337. 

  1337.                 end if
    1338. 

  1338. 5           continue
    1339. 

  1339. 4       continue
    1340. 

  1340.         call print_nok(nok)
    1341. 

  1341. 

  1342.         err = nf_close(ncid)
    1343. 

  1343.         if (err .ne. 0)
    1344. 

  1344.      +      call errore('nf_close: ', err)
    1345. 

  1345.         err = nf_delete(scratch)
    1346. 

  1346.         if (err .ne. 0)
    1347. 

  1347.      +      call errori('delete of scratch file failed: ', err)
    1348. 

  1348.         end
    1349. 

  1349. 

  1350. C * Test nc_set_default_format
    1351. 

  1351. C *    try with bad default format
    1352. 

  1352. C *    try with NULL old_formatp
    1353. 

  1353. C *    try in data mode, check error
    1354. 

  1354. C *    check that proper set to NC_FILL works for record & non-record variables
    1355. 

  1355. C *    (note that it is not possible to test NC_NOFILL mode!)
    1356. 

  1356. C *    close file & create again for test using attribute _FillValue
    1357. 

  1357.       subroutine test_nf_set_default_format()
    1358. 

  1358.       implicit none
    1359. 

  1359. #include "tests.inc"
    1360. 

  1360.       
    1361. 

  1361.       integer ncid
    1362. 

  1362.       integer err
    1363. 

  1363.       integer i
    1364. 

  1364.       integer version
    1365. 

  1365.       integer old_format
    1366. 

  1366.       integer nf_get_file_version
    1367. 

  1367.       
    1368. 

  1368. C     /* bad format */
    1369. 

  1369.       err = nf_set_default_format(5, old_format)
    1370. 

  1370.       IF (err .ne. NF_EINVAL)
    1371. 

  1371.      +     call errore("bad default format: status = %d", err)
    1372. 

  1372.      
    1373. 

  1373. C     /* Cycle through available formats. (actually netcdf-4 formats are
    1374. 

  1374. C     ignored for the moment - ed 5/15/5) */
    1375. 

  1375.       do 1 i=1, 2
    1376. 

  1376.          err = nf_set_default_format(i, old_format)
    1377. 

  1377.          if (err .ne. 0) 
    1378. 

  1378.      +         call errore("setting classic format: status = %d", err)
    1379. 

  1379.          err = nf_create(scratch, NF_CLOBBER, ncid)
    1380. 

  1380.          if (err .ne. 0) call errore("bad nf_create: status = %d", err)
    1381. 

  1381.          err = nf_put_att_text(ncid, NF_GLOBAL, "testatt", 
    1382. 

  1382.      +        4, "blah")
    1383. 

  1383.          if (err .ne. 0) call errore("bad put_att: status = %d", err)
    1384. 

  1384.          err = nf_close(ncid)
    1385. 

  1385.          if (err .ne. 0) call errore("bad close: status = %d", err)
    1386. 

  1386.          err = nf_get_file_version(scratch, version)
    1387. 

  1387.          if (err .ne. 0) call errore("bad file version = %d", err)
    1388. 

  1388.          if (version .ne. i)
    1389. 

  1389.      +        call errore("bad file version = %d", err)
    1390. 

  1390.  1    continue
    1391. 

  1391. 

  1392. C    /* Remove the left-over file. */
    1393. 

  1393. C      err = nf_delete(scratch)
    1394. 

  1394.       if (err .ne. 0) call errore("remove failed", err)
    1395. 

  1395.       end
    1396. 

  1396.       
    1397. 

  1397. C     This function looks in a file for the netCDF magic number.
    1398. 

  1398.       integer function nf_get_file_version(path, version)
    1399. 

  1399.       implicit none
    1400. 

  1400. #include "tests.inc"
    1401. 

  1401.       
    1402. 

  1402.       character*(*) path
    1403. 

  1403.       integer version, iosnum
    1404. 

  1404.       character magic*4
    1405. 

  1405.       integer ver
    1406. 

  1406.       integer f
    1407. 

  1407.       parameter (f = 10)
    1408. 

  1408. 

  1409.       open(f, file=path, status='OLD', form='UNFOR…
    1410.

Large files files are truncated, but you can click here to view the full file