PageRenderTime 88ms CodeModel.GetById 19ms RepoModel.GetById 0ms app.codeStats 1ms

/other/netcdf_write_matrix/src/nf_test/test_get.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 5599 lines | 4980 code | 145 blank | 474 comment | 822 complexity | e7ee9925a4301636414196baa095d4ae MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. C Do not edit this file. It is produced from the corresponding .m4 source */
    2. 

  2. 

  3. C*********************************************************************
    4. 

  4. C   Copyright 1996, UCAR/Unidata
    5. 

  5. C   See netcdf/COPYRIGHT file for copying and redistribution conditions.
    6. 

  6. C   $Id: test_get.m4,v 1.10 1997/06/06 21:54:38 steve Exp $
    7. 

  7. C*********************************************************************
    8. 

  8. 

  9.         subroutine test_nf_get_var1_text()
    10. 

  10.         implicit        none
    11. 

  11. #include "tests.inc"
    12. 

  12.         integer ncid
    13. 

  13.         integer i
    14. 

  14.         integer j
    15. 

  15.         integer err
    16. 

  16.         integer nok      
    17. 

  17.         integer index(MAX_RANK)
    18. 

  18.         doubleprecision expect
    19. 

  19.         logical canConvert     
    20. 

  20.         character    value
    21. 

  21.         doubleprecision val
    22. 

  22. 

  23.         nok = 0
    24. 

  24. 

  25.         err = nf_open(testfile, NF_NOWRITE, ncid)
    26. 

  26.         if (err .ne. 0)
    27. 

  27.      +      call errore('nf_open: ', err)
    28. 

  28.         do 1, i = 1, NVARS
    29. 

  29.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    30. 

  30.      +                   (NFT_TEXT .eq. NFT_TEXT)
    31. 

  31.             do 2, j = 1, var_rank(i)
    32. 

  32.                 index(j) = 1
    33. 

  33. 2           continue
    34. 

  34.             err = nf_get_var1_text(BAD_ID, i, index, value)
    35. 

  35.             if (err .ne. NF_EBADID)
    36. 

  36.      +          call errore('bad ncid: ', err)
    37. 

  37.             err = nf_get_var1_text(ncid, BAD_VARID,
    38. 

  38.      +                  index, value)
    39. 

  39.             if (err .ne. NF_ENOTVAR)
    40. 

  40.      +          call errore('bad var id: ', err)
    41. 

  41.             do 3, j = 1, var_rank(i)
    42. 

  42.                 index(j) = var_shape(j,i) + 1
    43. 

  43.                 err = nf_get_var1_text(ncid, i, index, value)
    44. 

  44.                 if (.not. canConvert) then
    45. 

  45.                     if (err .ne. NF_ECHAR)
    46. 

  46.      +                  call errore('conversion: ', err)
    47. 

  47.                 else
    48. 

  48.                     if (err .ne. NF_EINVALCOORDS)
    49. 

  49.      +                  call errore('bad index: ', err)
    50. 

  50.                 endif
    51. 

  51.                 index(j) = 1
    52. 

  52. 3           continue
    53. 

  53.             do 4, j = 1, var_nels(i)
    54. 

  54.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    55. 

  55.      +                              index)
    56. 

  56.                 if (err .ne. 0)
    57. 

  57.      +              call error('error in index2indexes 1')
    58. 

  58.                 expect = hash4( var_type(i), var_rank(i), index, 
    59. 

  59.      +                          NFT_TEXT )
    60. 

  60.                 err = nf_get_var1_text(ncid, i, index,
    61. 

  61.      +                          value)
    62. 

  62.                 if (canConvert) then
    63. 

  63.                     if (inRange3(expect,var_type(i), 
    64. 

  64.      +                           NFT_TEXT)) then
    65. 

  65.                         if (in_internal_range(NFT_TEXT,
    66. 

  66.      +                                        expect)) then
    67. 

  67.                             if (err .ne. 0) then
    68. 

  68.                                 call errore('nf_get_var: ', err)
    69. 

  69.                             else
    70. 

  70.                                 val = ichar(value)
    71. 

  71.                                 if (.not. equal(val, expect, 
    72. 

  72.      +                                          var_type(i), 
    73. 

  73.      +                                          NFT_TEXT)) then
    74. 

  74.                                     call errord('unexpected: ', val)
    75. 

  75.                                 else
    76. 

  76.                                     nok = nok + 1
    77. 

  77.                                 end if
    78. 

  78.                             end if
    79. 

  79.                         else
    80. 

  80.                             if (err .ne. NF_ERANGE)
    81. 

  81.      +                          call errore('Range error: ', err)
    82. 

  82.                         end if
    83. 

  83.                     else
    84. 

  84.                         if (err .ne. 0  .and. err .ne. NF_ERANGE)
    85. 

  85.      +                      call errore('OK or Range error: ', err)
    86. 

  86.                     end if
    87. 

  87.                 else
    88. 

  88.                     if (err .ne. NF_ECHAR)
    89. 

  89.      +                  call errore('wrong type: ', err)
    90. 

  90.                 end if
    91. 

  91. 4           continue
    92. 

  92. 1       continue
    93. 

  93.         err = nf_close(ncid)
    94. 

  94.         if (err .ne. 0)
    95. 

  95.      +      call errore('nf_close: ',  err)
    96. 

  96.         call print_nok(nok)
    97. 

  97.         end
    98. 

  98. 

  99. #ifdef NF_INT1_T
    100. 

  100.         subroutine test_nf_get_var1_int1()
    101. 

  101.         implicit        none
    102. 

  102. #include "tests.inc"
    103. 

  103.         integer ncid
    104. 

  104.         integer i
    105. 

  105.         integer j
    106. 

  106.         integer err
    107. 

  107.         integer nok      
    108. 

  108.         integer index(MAX_RANK)
    109. 

  109.         doubleprecision expect
    110. 

  110.         logical canConvert     
    111. 

  111.         NF_INT1_T    value
    112. 

  112.         doubleprecision val
    113. 

  113. 

  114.         nok = 0
    115. 

  115. 

  116.         err = nf_open(testfile, NF_NOWRITE, ncid)
    117. 

  117.         if (err .ne. 0)
    118. 

  118.      +      call errore('nf_open: ', err)
    119. 

  119.         do 1, i = 1, NVARS
    120. 

  120.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    121. 

  121.      +                   (NFT_INT1 .eq. NFT_TEXT)
    122. 

  122.             do 2, j = 1, var_rank(i)
    123. 

  123.                 index(j) = 1
    124. 

  124. 2           continue
    125. 

  125.             err = nf_get_var1_int1(BAD_ID, i, index, value)
    126. 

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

  127.      +          call errore('bad ncid: ', err)
    128. 

  128.             err = nf_get_var1_int1(ncid, BAD_VARID,
    129. 

  129.      +                  index, value)
    130. 

  130.             if (err .ne. NF_ENOTVAR)
    131. 

  131.      +          call errore('bad var id: ', err)
    132. 

  132.             do 3, j = 1, var_rank(i)
    133. 

  133.                 index(j) = var_shape(j,i) + 1
    134. 

  134.                 err = nf_get_var1_int1(ncid, i, index, value)
    135. 

  135.                 if (.not. canConvert) then
    136. 

  136.                     if (err .ne. NF_ECHAR)
    137. 

  137.      +                  call errore('conversion: ', err)
    138. 

  138.                 else
    139. 

  139.                     if (err .ne. NF_EINVALCOORDS)
    140. 

  140.      +                  call errore('bad index: ', err)
    141. 

  141.                 endif
    142. 

  142.                 index(j) = 1
    143. 

  143. 3           continue
    144. 

  144.             do 4, j = 1, var_nels(i)
    145. 

  145.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    146. 

  146.      +                              index)
    147. 

  147.                 if (err .ne. 0)
    148. 

  148.      +              call error('error in index2indexes 1')
    149. 

  149.                 expect = hash4( var_type(i), var_rank(i), index, 
    150. 

  150.      +                          NFT_INT1 )
    151. 

  151.                 err = nf_get_var1_int1(ncid, i, index,
    152. 

  152.      +                          value)
    153. 

  153.                 if (canConvert) then
    154. 

  154.                     if (inRange3(expect,var_type(i), 
    155. 

  155.      +                           NFT_INT1)) then
    156. 

  156.                         if (in_internal_range(NFT_INT1,
    157. 

  157.      +                                        expect)) then
    158. 

  158.                             if (err .ne. 0) then
    159. 

  159.                                 call errore('nf_get_var: ', err)
    160. 

  160.                             else
    161. 

  161.                                 val = value
    162. 

  162.                                 if (.not. equal(val, expect, 
    163. 

  163.      +                                          var_type(i), 
    164. 

  164.      +                                          NFT_INT1)) then
    165. 

  165.                                     call errord('unexpected: ', val)
    166. 

  166.                                 else
    167. 

  167.                                     nok = nok + 1
    168. 

  168.                                 end if
    169. 

  169.                             end if
    170. 

  170.                         else
    171. 

  171.                             if (err .ne. NF_ERANGE)
    172. 

  172.      +                          call errore('Range error: ', err)
    173. 

  173.                         end if
    174. 

  174.                     else
    175. 

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

  176.      +                      call errore('OK or Range error: ', err)
    177. 

  177.                     end if
    178. 

  178.                 else
    179. 

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

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

  181.                 end if
    182. 

  182. 4           continue
    183. 

  183. 1       continue
    184. 

  184.         err = nf_close(ncid)
    185. 

  185.         if (err .ne. 0)
    186. 

  186.      +      call errore('nf_close: ',  err)
    187. 

  187.         call print_nok(nok)
    188. 

  188.         end
    189. 

  189. 

  190. #endif
    191. 

  191. #ifdef NF_INT2_T
    192. 

  192.         subroutine test_nf_get_var1_int2()
    193. 

  193.         implicit        none
    194. 

  194. #include "tests.inc"
    195. 

  195.         integer ncid
    196. 

  196.         integer i
    197. 

  197.         integer j
    198. 

  198.         integer err
    199. 

  199.         integer nok      
    200. 

  200.         integer index(MAX_RANK)
    201. 

  201.         doubleprecision expect
    202. 

  202.         logical canConvert     
    203. 

  203.         NF_INT2_T    value
    204. 

  204.         doubleprecision val
    205. 

  205. 

  206.         nok = 0
    207. 

  207. 

  208.         err = nf_open(testfile, NF_NOWRITE, ncid)
    209. 

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

  210.      +      call errore('nf_open: ', err)
    211. 

  211.         do 1, i = 1, NVARS
    212. 

  212.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    213. 

  213.      +                   (NFT_INT2 .eq. NFT_TEXT)
    214. 

  214.             do 2, j = 1, var_rank(i)
    215. 

  215.                 index(j) = 1
    216. 

  216. 2           continue
    217. 

  217.             err = nf_get_var1_int2(BAD_ID, i, index, value)
    218. 

  218.             if (err .ne. NF_EBADID)
    219. 

  219.      +          call errore('bad ncid: ', err)
    220. 

  220.             err = nf_get_var1_int2(ncid, BAD_VARID,
    221. 

  221.      +                  index, value)
    222. 

  222.             if (err .ne. NF_ENOTVAR)
    223. 

  223.      +          call errore('bad var id: ', err)
    224. 

  224.             do 3, j = 1, var_rank(i)
    225. 

  225.                 index(j) = var_shape(j,i) + 1
    226. 

  226.                 err = nf_get_var1_int2(ncid, i, index, value)
    227. 

  227.                 if (.not. canConvert) then
    228. 

  228.                     if (err .ne. NF_ECHAR)
    229. 

  229.      +                  call errore('conversion: ', err)
    230. 

  230.                 else
    231. 

  231.                     if (err .ne. NF_EINVALCOORDS)
    232. 

  232.      +                  call errore('bad index: ', err)
    233. 

  233.                 endif
    234. 

  234.                 index(j) = 1
    235. 

  235. 3           continue
    236. 

  236.             do 4, j = 1, var_nels(i)
    237. 

  237.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    238. 

  238.      +                              index)
    239. 

  239.                 if (err .ne. 0)
    240. 

  240.      +              call error('error in index2indexes 1')
    241. 

  241.                 expect = hash4( var_type(i), var_rank(i), index, 
    242. 

  242.      +                          NFT_INT2 )
    243. 

  243.                 err = nf_get_var1_int2(ncid, i, index,
    244. 

  244.      +                          value)
    245. 

  245.                 if (canConvert) then
    246. 

  246.                     if (inRange3(expect,var_type(i), 
    247. 

  247.      +                           NFT_INT2)) then
    248. 

  248.                         if (in_internal_range(NFT_INT2,
    249. 

  249.      +                                        expect)) then
    250. 

  250.                             if (err .ne. 0) then
    251. 

  251.                                 call errore('nf_get_var: ', err)
    252. 

  252.                             else
    253. 

  253.                                 val = value
    254. 

  254.                                 if (.not. equal(val, expect, 
    255. 

  255.      +                                          var_type(i), 
    256. 

  256.      +                                          NFT_INT2)) then
    257. 

  257.                                     call errord('unexpected: ', val)
    258. 

  258.                                 else
    259. 

  259.                                     nok = nok + 1
    260. 

  260.                                 end if
    261. 

  261.                             end if
    262. 

  262.                         else
    263. 

  263.                             if (err .ne. NF_ERANGE)
    264. 

  264.      +                          call errore('Range error: ', err)
    265. 

  265.                         end if
    266. 

  266.                     else
    267. 

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

  268.      +                      call errore('OK or Range error: ', err)
    269. 

  269.                     end if
    270. 

  270.                 else
    271. 

  271.                     if (err .ne. NF_ECHAR)
    272. 

  272.      +                  call errore('wrong type: ', err)
    273. 

  273.                 end if
    274. 

  274. 4           continue
    275. 

  275. 1       continue
    276. 

  276.         err = nf_close(ncid)
    277. 

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

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

  279.         call print_nok(nok)
    280. 

  280.         end
    281. 

  281. 

  282. #endif
    283. 

  283.         subroutine test_nf_get_var1_int()
    284. 

  284.         implicit        none
    285. 

  285. #include "tests.inc"
    286. 

  286.         integer ncid
    287. 

  287.         integer i
    288. 

  288.         integer j
    289. 

  289.         integer err
    290. 

  290.         integer nok      
    291. 

  291.         integer index(MAX_RANK)
    292. 

  292.         doubleprecision expect
    293. 

  293.         logical canConvert     
    294. 

  294.         integer    value
    295. 

  295.         doubleprecision val
    296. 

  296. 

  297.         nok = 0
    298. 

  298. 

  299.         err = nf_open(testfile, NF_NOWRITE, ncid)
    300. 

  300.         if (err .ne. 0)
    301. 

  301.      +      call errore('nf_open: ', err)
    302. 

  302.         do 1, i = 1, NVARS
    303. 

  303.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    304. 

  304.      +                   (NFT_INT .eq. NFT_TEXT)
    305. 

  305.             do 2, j = 1, var_rank(i)
    306. 

  306.                 index(j) = 1
    307. 

  307. 2           continue
    308. 

  308.             err = nf_get_var1_int(BAD_ID, i, index, value)
    309. 

  309.             if (err .ne. NF_EBADID)
    310. 

  310.      +          call errore('bad ncid: ', err)
    311. 

  311.             err = nf_get_var1_int(ncid, BAD_VARID,
    312. 

  312.      +                  index, value)
    313. 

  313.             if (err .ne. NF_ENOTVAR)
    314. 

  314.      +          call errore('bad var id: ', err)
    315. 

  315.             do 3, j = 1, var_rank(i)
    316. 

  316.                 index(j) = var_shape(j,i) + 1
    317. 

  317.                 err = nf_get_var1_int(ncid, i, index, value)
    318. 

  318.                 if (.not. canConvert) then
    319. 

  319.                     if (err .ne. NF_ECHAR)
    320. 

  320.      +                  call errore('conversion: ', err)
    321. 

  321.                 else
    322. 

  322.                     if (err .ne. NF_EINVALCOORDS)
    323. 

  323.      +                  call errore('bad index: ', err)
    324. 

  324.                 endif
    325. 

  325.                 index(j) = 1
    326. 

  326. 3           continue
    327. 

  327.             do 4, j = 1, var_nels(i)
    328. 

  328.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    329. 

  329.      +                              index)
    330. 

  330.                 if (err .ne. 0)
    331. 

  331.      +              call error('error in index2indexes 1')
    332. 

  332.                 expect = hash4( var_type(i), var_rank(i), index, 
    333. 

  333.      +                          NFT_INT )
    334. 

  334.                 err = nf_get_var1_int(ncid, i, index,
    335. 

  335.      +                          value)
    336. 

  336.                 if (canConvert) then
    337. 

  337.                     if (inRange3(expect,var_type(i), 
    338. 

  338.      +                           NFT_INT)) then
    339. 

  339.                         if (in_internal_range(NFT_INT,
    340. 

  340.      +                                        expect)) then
    341. 

  341.                             if (err .ne. 0) then
    342. 

  342.                                 call errore('nf_get_var: ', err)
    343. 

  343.                             else
    344. 

  344.                                 val = value
    345. 

  345.                                 if (.not. equal(val, expect, 
    346. 

  346.      +                                          var_type(i), 
    347. 

  347.      +                                          NFT_INT)) then
    348. 

  348.                                     call errord('unexpected: ', val)
    349. 

  349.                                 else
    350. 

  350.                                     nok = nok + 1
    351. 

  351.                                 end if
    352. 

  352.                             end if
    353. 

  353.                         else
    354. 

  354.                             if (err .ne. NF_ERANGE)
    355. 

  355.      +                          call errore('Range error: ', err)
    356. 

  356.                         end if
    357. 

  357.                     else
    358. 

  358.                         if (err .ne. 0  .and. err .ne. NF_ERANGE)
    359. 

  359.      +                      call errore('OK or Range error: ', err)
    360. 

  360.                     end if
    361. 

  361.                 else
    362. 

  362.                     if (err .ne. NF_ECHAR)
    363. 

  363.      +                  call errore('wrong type: ', err)
    364. 

  364.                 end if
    365. 

  365. 4           continue
    366. 

  366. 1       continue
    367. 

  367.         err = nf_close(ncid)
    368. 

  368.         if (err .ne. 0)
    369. 

  369.      +      call errore('nf_close: ',  err)
    370. 

  370.         call print_nok(nok)
    371. 

  371.         end
    372. 

  372. 

  373.         subroutine test_nf_get_var1_real()
    374. 

  374.         implicit        none
    375. 

  375. #include "tests.inc"
    376. 

  376.         integer ncid
    377. 

  377.         integer i
    378. 

  378.         integer j
    379. 

  379.         integer err
    380. 

  380.         integer nok      
    381. 

  381.         integer index(MAX_RANK)
    382. 

  382.         doubleprecision expect
    383. 

  383.         logical canConvert     
    384. 

  384.         real    value
    385. 

  385.         doubleprecision val
    386. 

  386. 

  387.         nok = 0
    388. 

  388. 

  389.         err = nf_open(testfile, NF_NOWRITE, ncid)
    390. 

  390.         if (err .ne. 0)
    391. 

  391.      +      call errore('nf_open: ', err)
    392. 

  392.         do 1, i = 1, NVARS
    393. 

  393.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    394. 

  394.      +                   (NFT_REAL .eq. NFT_TEXT)
    395. 

  395.             do 2, j = 1, var_rank(i)
    396. 

  396.                 index(j) = 1
    397. 

  397. 2           continue
    398. 

  398.             err = nf_get_var1_real(BAD_ID, i, index, value)
    399. 

  399.             if (err .ne. NF_EBADID)
    400. 

  400.      +          call errore('bad ncid: ', err)
    401. 

  401.             err = nf_get_var1_real(ncid, BAD_VARID,
    402. 

  402.      +                  index, value)
    403. 

  403.             if (err .ne. NF_ENOTVAR)
    404. 

  404.      +          call errore('bad var id: ', err)
    405. 

  405.             do 3, j = 1, var_rank(i)
    406. 

  406.                 index(j) = var_shape(j,i) + 1
    407. 

  407.                 err = nf_get_var1_real(ncid, i, index, value)
    408. 

  408.                 if (.not. canConvert) then
    409. 

  409.                     if (err .ne. NF_ECHAR)
    410. 

  410.      +                  call errore('conversion: ', err)
    411. 

  411.                 else
    412. 

  412.                     if (err .ne. NF_EINVALCOORDS)
    413. 

  413.      +                  call errore('bad index: ', err)
    414. 

  414.                 endif
    415. 

  415.                 index(j) = 1
    416. 

  416. 3           continue
    417. 

  417.             do 4, j = 1, var_nels(i)
    418. 

  418.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    419. 

  419.      +                              index)
    420. 

  420.                 if (err .ne. 0)
    421. 

  421.      +              call error('error in index2indexes 1')
    422. 

  422.                 expect = hash4( var_type(i), var_rank(i), index, 
    423. 

  423.      +                          NFT_REAL )
    424. 

  424.                 err = nf_get_var1_real(ncid, i, index,
    425. 

  425.      +                          value)
    426. 

  426.                 if (canConvert) then
    427. 

  427.                     if (inRange3(expect,var_type(i), 
    428. 

  428.      +                           NFT_REAL)) then
    429. 

  429.                         if (in_internal_range(NFT_REAL,
    430. 

  430.      +                                        expect)) then
    431. 

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

  432.                                 call errore('nf_get_var: ', err)
    433. 

  433.                             else
    434. 

  434.                                 val = value
    435. 

  435.                                 if (.not. equal(val, expect, 
    436. 

  436.      +                                          var_type(i), 
    437. 

  437.      +                                          NFT_REAL)) then
    438. 

  438.                                     call errord('unexpected: ', val)
    439. 

  439.                                 else
    440. 

  440.                                     nok = nok + 1
    441. 

  441.                                 end if
    442. 

  442.                             end if
    443. 

  443.                         else
    444. 

  444.                             if (err .ne. NF_ERANGE)
    445. 

  445.      +                          call errore('Range error: ', err)
    446. 

  446.                         end if
    447. 

  447.                     else
    448. 

  448.                         if (err .ne. 0  .and. err .ne. NF_ERANGE)
    449. 

  449.      +                      call errore('OK or Range error: ', err)
    450. 

  450.                     end if
    451. 

  451.                 else
    452. 

  452.                     if (err .ne. NF_ECHAR)
    453. 

  453.      +                  call errore('wrong type: ', err)
    454. 

  454.                 end if
    455. 

  455. 4           continue
    456. 

  456. 1       continue
    457. 

  457.         err = nf_close(ncid)
    458. 

  458.         if (err .ne. 0)
    459. 

  459.      +      call errore('nf_close: ',  err)
    460. 

  460.         call print_nok(nok)
    461. 

  461.         end
    462. 

  462. 

  463.         subroutine test_nf_get_var1_double()
    464. 

  464.         implicit        none
    465. 

  465. #include "tests.inc"
    466. 

  466.         integer ncid
    467. 

  467.         integer i
    468. 

  468.         integer j
    469. 

  469.         integer err
    470. 

  470.         integer nok      
    471. 

  471.         integer index(MAX_RANK)
    472. 

  472.         doubleprecision expect
    473. 

  473.         logical canConvert     
    474. 

  474.         doubleprecision    value
    475. 

  475.         doubleprecision val
    476. 

  476. 

  477.         nok = 0
    478. 

  478. 

  479.         err = nf_open(testfile, NF_NOWRITE, ncid)
    480. 

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

  481.      +      call errore('nf_open: ', err)
    482. 

  482.         do 1, i = 1, NVARS
    483. 

  483.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    484. 

  484.      +                   (NFT_DOUBLE .eq. NFT_TEXT)
    485. 

  485.             do 2, j = 1, var_rank(i)
    486. 

  486.                 index(j) = 1
    487. 

  487. 2           continue
    488. 

  488.             err = nf_get_var1_double(BAD_ID, i, index, value)
    489. 

  489.             if (err .ne. NF_EBADID)
    490. 

  490.      +          call errore('bad ncid: ', err)
    491. 

  491.             err = nf_get_var1_double(ncid, BAD_VARID,
    492. 

  492.      +                  index, value)
    493. 

  493.             if (err .ne. NF_ENOTVAR)
    494. 

  494.      +          call errore('bad var id: ', err)
    495. 

  495.             do 3, j = 1, var_rank(i)
    496. 

  496.                 index(j) = var_shape(j,i) + 1
    497. 

  497.                 err = nf_get_var1_double(ncid, i, index, value)
    498. 

  498.                 if (.not. canConvert) then
    499. 

  499.                     if (err .ne. NF_ECHAR)
    500. 

  500.      +                  call errore('conversion: ', err)
    501. 

  501.                 else
    502. 

  502.                     if (err .ne. NF_EINVALCOORDS)
    503. 

  503.      +                  call errore('bad index: ', err)
    504. 

  504.                 endif
    505. 

  505.                 index(j) = 1
    506. 

  506. 3           continue
    507. 

  507.             do 4, j = 1, var_nels(i)
    508. 

  508.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    509. 

  509.      +                              index)
    510. 

  510.                 if (err .ne. 0)
    511. 

  511.      +              call error('error in index2indexes 1')
    512. 

  512.                 expect = hash4( var_type(i), var_rank(i), index, 
    513. 

  513.      +                          NFT_DOUBLE )
    514. 

  514.                 err = nf_get_var1_double(ncid, i, index,
    515. 

  515.      +                          value)
    516. 

  516.                 if (canConvert) then
    517. 

  517.                     if (inRange3(expect,var_type(i), 
    518. 

  518.      +                           NFT_DOUBLE)) then
    519. 

  519.                         if (in_internal_range(NFT_DOUBLE,
    520. 

  520.      +                                        expect)) then
    521. 

  521.                             if (err .ne. 0) then
    522. 

  522.                                 call errore('nf_get_var: ', err)
    523. 

  523.                             else
    524. 

  524.                                 val = value
    525. 

  525.                                 if (.not. equal(val, expect, 
    526. 

  526.      +                                          var_type(i), 
    527. 

  527.      +                                          NFT_DOUBLE)) then
    528. 

  528.                                     call errord('unexpected: ', val)
    529. 

  529.                                 else
    530. 

  530.                                     nok = nok + 1
    531. 

  531.                                 end if
    532. 

  532.                             end if
    533. 

  533.                         else
    534. 

  534.                             if (err .ne. NF_ERANGE)
    535. 

  535.      +                          call errore('Range error: ', err)
    536. 

  536.                         end if
    537. 

  537.                     else
    538. 

  538.                         if (err .ne. 0  .and. err .ne. NF_ERANGE)
    539. 

  539.      +                      call errore('OK or Range error: ', err)
    540. 

  540.                     end if
    541. 

  541.                 else
    542. 

  542.                     if (err .ne. NF_ECHAR)
    543. 

  543.      +                  call errore('wrong type: ', err)
    544. 

  544.                 end if
    545. 

  545. 4           continue
    546. 

  546. 1       continue
    547. 

  547.         err = nf_close(ncid)
    548. 

  548.         if (err .ne. 0)
    549. 

  549.      +      call errore('nf_close: ',  err)
    550. 

  550.         call print_nok(nok)
    551. 

  551.         end
    552. 

  552. 

  553. 

  554.         subroutine test_nf_get_var_text()
    555. 

  555.         implicit        none
    556. 

  556. #include "tests.inc"
    557. 

  557.         integer ncid
    558. 

  558.         integer i
    559. 

  559.         integer j
    560. 

  560.         integer err
    561. 

  561.         logical allInExtRange   
    562. 

  562.         logical allInIntRange   
    563. 

  563.         integer nels
    564. 

  564.         integer nok      
    565. 

  565.         integer index(MAX_RANK)
    566. 

  566.         doubleprecision expect(MAX_NELS)
    567. 

  567.         logical canConvert     
    568. 

  568.         character    value(MAX_NELS)
    569. 

  569.         doubleprecision val
    570. 

  570. 

  571.         nok = 0
    572. 

  572. 

  573.         err = nf_open(testfile, NF_NOWRITE, ncid)
    574. 

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

  575.      +      call errore('nf_open: ', err)
    576. 

  576.         do 1, i = 1, NVARS
    577. 

  577.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    578. 

  578.      +                   (NFT_TEXT .eq. NFT_TEXT)
    579. 

  579.             err = nf_get_var_text(BAD_ID, i, value)
    580. 

  580.             if (err .ne. NF_EBADID)
    581. 

  581.      +          call errore('bad ncid: ', err)
    582. 

  582.             err = nf_get_var_text(ncid, BAD_VARID, value)
    583. 

  583.             if (err .ne. NF_ENOTVAR)
    584. 

  584.      +          call errore('bad var id: ', err)
    585. 

  585.             nels = 1
    586. 

  586.             do 3, j = 1, var_rank(i)
    587. 

  587.                 nels = nels * var_shape(j,i)
    588. 

  588. 3           continue
    589. 

  589.             allInExtRange = .true.
    590. 

  590.             allInIntRange = .true.
    591. 

  591.             do 4, j = 1, var_nels(i)
    592. 

  592.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    593. 

  593.      +                              index)
    594. 

  594.                 if (err .ne. 0)
    595. 

  595.      +              call error('error in index2indexes 1')
    596. 

  596.                 expect(j) = hash4( var_type(i), var_rank(i), index, 
    597. 

  597.      +                          NFT_TEXT )
    598. 

  598.                 if (inRange3(expect(j),var_type(i), NFT_TEXT)) then
    599. 

  599.                     allInIntRange = allInIntRange .and.
    600. 

  600.      +                  in_internal_range(NFT_TEXT, expect(j))
    601. 

  601.                 else
    602. 

  602.                     allInExtRange = .false.
    603. 

  603.                 end if
    604. 

  604. 4           continue
    605. 

  605.             err = nf_get_var_text(ncid, i, value)
    606. 

  606.             if (canConvert) then
    607. 

  607.                 if (allInExtRange) then
    608. 

  608.                     if (allInIntRange) then
    609. 

  609.                         if (err .ne. 0) 
    610. 

  610.      +                      call errore('nf_get_var: ', err)
    611. 

  611.                     else
    612. 

  612.                         if (err .ne. NF_ERANGE)
    613. 

  613.      +                      call errore('Range error: ', err)
    614. 

  614.                     endif
    615. 

  615.                 else
    616. 

  616.                     if (err .ne. 0  .and. err .ne. NF_ERANGE)
    617. 

  617.      +                  call errore('Range error: ', err)
    618. 

  618.                 endif
    619. 

  619.                 do 5, j = 1, var_nels(i)
    620. 

  620.                     if (inRange3(expect(j),var_type(i),
    621. 

  621.      +                           NFT_TEXT) .and.
    622. 

  622.      +                  in_internal_range(NFT_TEXT,
    623. 

  623.      +                                          expect(j))) then
    624. 

  624.                         val = ichar(value(j))
    625. 

  625.                         if (.not. equal(val, expect(j), 
    626. 

  626.      +                                  var_type(i), 
    627. 

  627.      +                                  NFT_TEXT)) then
    628. 

  628.                             call errord('unexpected: ', val)
    629. 

  629.                         else
    630. 

  630.                             nok = nok + 1
    631. 

  631.                         end if
    632. 

  632.                     endif
    633. 

  633. 5               continue
    634. 

  634.             else
    635. 

  635.                 if (err .ne. NF_ECHAR)
    636. 

  636.      +                  call errore('wrong type: ', err)
    637. 

  637.             end if
    638. 

  638. 1       continue
    639. 

  639.         err = nf_close(ncid)
    640. 

  640.         if (err .ne. 0)
    641. 

  641.      +      call errore('nf_close: ',  err)
    642. 

  642.         call print_nok(nok)
    643. 

  643.         end
    644. 

  644. 

  645. #ifdef NF_INT1_T
    646. 

  646.         subroutine test_nf_get_var_int1()
    647. 

  647.         implicit        none
    648. 

  648. #include "tests.inc"
    649. 

  649.         integer ncid
    650. 

  650.         integer i
    651. 

  651.         integer j
    652. 

  652.         integer err
    653. 

  653.         logical allInExtRange   
    654. 

  654.         logical allInIntRange   
    655. 

  655.         integer nels
    656. 

  656.         integer nok      
    657. 

  657.         integer index(MAX_RANK)
    658. 

  658.         doubleprecision expect(MAX_NELS)
    659. 

  659.         logical canConvert     
    660. 

  660.         NF_INT1_T    value(MAX_NELS)
    661. 

  661.         doubleprecision val
    662. 

  662. 

  663.         nok = 0
    664. 

  664. 

  665.         err = nf_open(testfile, NF_NOWRITE, ncid)
    666. 

  666.         if (err .ne. 0)
    667. 

  667.      +      call errore('nf_open: ', err)
    668. 

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

  669.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    670. 

  670.      +                   (NFT_INT1 .eq. NFT_TEXT)
    671. 

  671.             err = nf_get_var_int1(BAD_ID, i, value)
    672. 

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

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

  674.             err = nf_get_var_int1(ncid, BAD_VARID, value)
    675. 

  675.             if (err .ne. NF_ENOTVAR)
    676. 

  676.      +          call errore('bad var id: ', err)
    677. 

  677.             nels = 1
    678. 

  678.             do 3, j = 1, var_rank(i)
    679. 

  679.                 nels = nels * var_shape(j,i)
    680. 

  680. 3           continue
    681. 

  681.             allInExtRange = .true.
    682. 

  682.             allInIntRange = .true.
    683. 

  683.             do 4, j = 1, var_nels(i)
    684. 

  684.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    685. 

  685.      +                              index)
    686. 

  686.                 if (err .ne. 0)
    687. 

  687.      +              call error('error in index2indexes 1')
    688. 

  688.                 expect(j) = hash4( var_type(i), var_rank(i), index, 
    689. 

  689.      +                          NFT_INT1 )
    690. 

  690.                 if (inRange3(expect(j),var_type(i), NFT_INT1)) then
    691. 

  691.                     allInIntRange = allInIntRange .and.
    692. 

  692.      +                  in_internal_range(NFT_INT1, expect(j))
    693. 

  693.                 else
    694. 

  694.                     allInExtRange = .false.
    695. 

  695.                 end if
    696. 

  696. 4           continue
    697. 

  697.             err = nf_get_var_int1(ncid, i, value)
    698. 

  698.             if (canConvert) then
    699. 

  699.                 if (allInExtRange) then
    700. 

  700.                     if (allInIntRange) then
    701. 

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

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

  703.                     else
    704. 

  704.                         if (err .ne. NF_ERANGE)
    705. 

  705.      +                      call errore('Range error: ', err)
    706. 

  706.                     endif
    707. 

  707.                 else
    708. 

  708.                     if (err .ne. 0  .and. err .ne. NF_ERANGE)
    709. 

  709.      +                  call errore('Range error: ', err)
    710. 

  710.                 endif
    711. 

  711.                 do 5, j = 1, var_nels(i)
    712. 

  712.                     if (inRange3(expect(j),var_type(i),
    713. 

  713.      +                           NFT_INT1) .and.
    714. 

  714.      +                  in_internal_range(NFT_INT1,
    715. 

  715.      +                                          expect(j))) then
    716. 

  716.                         val = value(j)
    717. 

  717.                         if (.not. equal(val, expect(j), 
    718. 

  718.      +                                  var_type(i), 
    719. 

  719.      +                                  NFT_INT1)) then
    720. 

  720.                             call errord('unexpected: ', val)
    721. 

  721.                         else
    722. 

  722.                             nok = nok + 1
    723. 

  723.                         end if
    724. 

  724.                     endif
    725. 

  725. 5               continue
    726. 

  726.             else
    727. 

  727.                 if (err .ne. NF_ECHAR)
    728. 

  728.      +                  call errore('wrong type: ', err)
    729. 

  729.             end if
    730. 

  730. 1       continue
    731. 

  731.         err = nf_close(ncid)
    732. 

  732.         if (err .ne. 0)
    733. 

  733.      +      call errore('nf_close: ',  err)
    734. 

  734.         call print_nok(nok)
    735. 

  735.         end
    736. 

  736. 

  737. #endif
    738. 

  738. #ifdef NF_INT2_T
    739. 

  739.         subroutine test_nf_get_var_int2()
    740. 

  740.         implicit        none
    741. 

  741. #include "tests.inc"
    742. 

  742.         integer ncid
    743. 

  743.         integer i
    744. 

  744.         integer j
    745. 

  745.         integer err
    746. 

  746.         logical allInExtRange   
    747. 

  747.         logical allInIntRange   
    748. 

  748.         integer nels
    749. 

  749.         integer nok      
    750. 

  750.         integer index(MAX_RANK)
    751. 

  751.         doubleprecision expect(MAX_NELS)
    752. 

  752.         logical canConvert     
    753. 

  753.         NF_INT2_T    value(MAX_NELS)
    754. 

  754.         doubleprecision val
    755. 

  755. 

  756.         nok = 0
    757. 

  757. 

  758.         err = nf_open(testfile, NF_NOWRITE, ncid)
    759. 

  759.         if (err .ne. 0)
    760. 

  760.      +      call errore('nf_open: ', err)
    761. 

  761.         do 1, i = 1, NVARS
    762. 

  762.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    763. 

  763.      +                   (NFT_INT2 .eq. NFT_TEXT)
    764. 

  764.             err = nf_get_var_int2(BAD_ID, i, value)
    765. 

  765.             if (err .ne. NF_EBADID)
    766. 

  766.      +          call errore('bad ncid: ', err)
    767. 

  767.             err = nf_get_var_int2(ncid, BAD_VARID, value)
    768. 

  768.             if (err .ne. NF_ENOTVAR)
    769. 

  769.      +          call errore('bad var id: ', err)
    770. 

  770.             nels = 1
    771. 

  771.             do 3, j = 1, var_rank(i)
    772. 

  772.                 nels = nels * var_shape(j,i)
    773. 

  773. 3           continue
    774. 

  774.             allInExtRange = .true.
    775. 

  775.             allInIntRange = .true.
    776. 

  776.             do 4, j = 1, var_nels(i)
    777. 

  777.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    778. 

  778.      +                              index)
    779. 

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

  780.      +              call error('error in index2indexes 1')
    781. 

  781.                 expect(j) = hash4( var_type(i), var_rank(i), index, 
    782. 

  782.      +                          NFT_INT2 )
    783. 

  783.                 if (inRange3(expect(j),var_type(i), NFT_INT2)) then
    784. 

  784.                     allInIntRange = allInIntRange .and.
    785. 

  785.      +                  in_internal_range(NFT_INT2, expect(j))
    786. 

  786.                 else
    787. 

  787.                     allInExtRange = .false.
    788. 

  788.                 end if
    789. 

  789. 4           continue
    790. 

  790.             err = nf_get_var_int2(ncid, i, value)
    791. 

  791.             if (canConvert) then
    792. 

  792.                 if (allInExtRange) then
    793. 

  793.                     if (allInIntRange) then
    794. 

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

  795.      +                      call errore('nf_get_var: ', err)
    796. 

  796.                     else
    797. 

  797.                         if (err .ne. NF_ERANGE)
    798. 

  798.      +                      call errore('Range error: ', err)
    799. 

  799.                     endif
    800. 

  800.                 else
    801. 

  801.                     if (err .ne. 0  .and. err .ne. NF_ERANGE)
    802. 

  802.      +                  call errore('Range error: ', err)
    803. 

  803.                 endif
    804. 

  804.                 do 5, j = 1, var_nels(i)
    805. 

  805.                     if (inRange3(expect(j),var_type(i),
    806. 

  806.      +                           NFT_INT2) .and.
    807. 

  807.      +                  in_internal_range(NFT_INT2,
    808. 

  808.      +                                          expect(j))) then
    809. 

  809.                         val = value(j)
    810. 

  810.                         if (.not. equal(val, expect(j), 
    811. 

  811.      +                                  var_type(i), 
    812. 

  812.      +                                  NFT_INT2)) then
    813. 

  813.                             call errord('unexpected: ', val)
    814. 

  814.                         else
    815. 

  815.                             nok = nok + 1
    816. 

  816.                         end if
    817. 

  817.                     endif
    818. 

  818. 5               continue
    819. 

  819.             else
    820. 

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

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

  822.             end if
    823. 

  823. 1       continue
    824. 

  824.         err = nf_close(ncid)
    825. 

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

  826.      +      call errore('nf_close: ',  err)
    827. 

  827.         call print_nok(nok)
    828. 

  828.         end
    829. 

  829. 

  830. #endif
    831. 

  831.         subroutine test_nf_get_var_int()
    832. 

  832.         implicit        none
    833. 

  833. #include "tests.inc"
    834. 

  834.         integer ncid
    835. 

  835.         integer i
    836. 

  836.         integer j
    837. 

  837.         integer err
    838. 

  838.         logical allInExtRange   
    839. 

  839.         logical allInIntRange   
    840. 

  840.         integer nels
    841. 

  841.         integer nok      
    842. 

  842.         integer index(MAX_RANK)
    843. 

  843.         doubleprecision expect(MAX_NELS)
    844. 

  844.         logical canConvert     
    845. 

  845.         integer    value(MAX_NELS)
    846. 

  846.         doubleprecision val
    847. 

  847. 

  848.         nok = 0
    849. 

  849. 

  850.         err = nf_open(testfile, NF_NOWRITE, ncid)
    851. 

  851.         if (err .ne. 0)
    852. 

  852.      +      call errore('nf_open: ', err)
    853. 

  853.         do 1, i = 1, NVARS
    854. 

  854.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    855. 

  855.      +                   (NFT_INT .eq. NFT_TEXT)
    856. 

  856.             err = nf_get_var_int(BAD_ID, i, value)
    857. 

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

  858.      +          call errore('bad ncid: ', err)
    859. 

  859.             err = nf_get_var_int(ncid, BAD_VARID, value)
    860. 

  860.             if (err .ne. NF_ENOTVAR)
    861. 

  861.      +          call errore('bad var id: ', err)
    862. 

  862.             nels = 1
    863. 

  863.             do 3, j = 1, var_rank(i)
    864. 

  864.                 nels = nels * var_shape(j,i)
    865. 

  865. 3           continue
    866. 

  866.             allInExtRange = .true.
    867. 

  867.             allInIntRange = .true.
    868. 

  868.             do 4, j = 1, var_nels(i)
    869. 

  869.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    870. 

  870.      +                              index)
    871. 

  871.                 if (err .ne. 0)
    872. 

  872.      +              call error('error in index2indexes 1')
    873. 

  873.                 expect(j) = hash4( var_type(i), var_rank(i), index, 
    874. 

  874.      +                          NFT_INT )
    875. 

  875.                 if (inRange3(expect(j),var_type(i), NFT_INT)) then
    876. 

  876.                     allInIntRange = allInIntRange .and.
    877. 

  877.      +                  in_internal_range(NFT_INT, expect(j))
    878. 

  878.                 else
    879. 

  879.                     allInExtRange = .false.
    880. 

  880.                 end if
    881. 

  881. 4           continue
    882. 

  882.             err = nf_get_var_int(ncid, i, value)
    883. 

  883.             if (canConvert) then
    884. 

  884.                 if (allInExtRange) then
    885. 

  885.                     if (allInIntRange) then
    886. 

  886.                         if (err .ne. 0) 
    887. 

  887.      +                      call errore('nf_get_var: ', err)
    888. 

  888.                     else
    889. 

  889.                         if (err .ne. NF_ERANGE)
    890. 

  890.      +                      call errore('Range error: ', err)
    891. 

  891.                     endif
    892. 

  892.                 else
    893. 

  893.                     if (err .ne. 0  .and. err .ne. NF_ERANGE)
    894. 

  894.      +                  call errore('Range error: ', err)
    895. 

  895.                 endif
    896. 

  896.                 do 5, j = 1, var_nels(i)
    897. 

  897.                     if (inRange3(expect(j),var_type(i),
    898. 

  898.      +                           NFT_INT) .and.
    899. 

  899.      +                  in_internal_range(NFT_INT,
    900. 

  900.      +                                          expect(j))) then
    901. 

  901.                         val = value(j)
    902. 

  902.                         if (.not. equal(val, expect(j), 
    903. 

  903.      +                                  var_type(i), 
    904. 

  904.      +                                  NFT_INT)) then
    905. 

  905.                             call errord('unexpected: ', val)
    906. 

  906.                         else
    907. 

  907.                             nok = nok + 1
    908. 

  908.                         end if
    909. 

  909.                     endif
    910. 

  910. 5               continue
    911. 

  911.             else
    912. 

  912.                 if (err .ne. NF_ECHAR)
    913. 

  913.      +                  call errore('wrong type: ', err)
    914. 

  914.             end if
    915. 

  915. 1       continue
    916. 

  916.         err = nf_close(ncid)
    917. 

  917.         if (err .ne. 0)
    918. 

  918.      +      call errore('nf_close: ',  err)
    919. 

  919.         call print_nok(nok)
    920. 

  920.         end
    921. 

  921. 

  922.         subroutine test_nf_get_var_real()
    923. 

  923.         implicit        none
    924. 

  924. #include "tests.inc"
    925. 

  925.         integer ncid
    926. 

  926.         integer i
    927. 

  927.         integer j
    928. 

  928.         integer err
    929. 

  929.         logical allInExtRange   
    930. 

  930.         logical allInIntRange   
    931. 

  931.         integer nels
    932. 

  932.         integer nok      
    933. 

  933.         integer index(MAX_RANK)
    934. 

  934.         doubleprecision expect(MAX_NELS)
    935. 

  935.         logical canConvert     
    936. 

  936.         real    value(MAX_NELS)
    937. 

  937.         doubleprecision val
    938. 

  938. 

  939.         nok = 0
    940. 

  940. 

  941.         err = nf_open(testfile, NF_NOWRITE, ncid)
    942. 

  942.         if (err .ne. 0)
    943. 

  943.      +      call errore('nf_open: ', err)
    944. 

  944.         do 1, i = 1, NVARS
    945. 

  945.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    946. 

  946.      +                   (NFT_REAL .eq. NFT_TEXT)
    947. 

  947.             err = nf_get_var_real(BAD_ID, i, value)
    948. 

  948.             if (err .ne. NF_EBADID)
    949. 

  949.      +          call errore('bad ncid: ', err)
    950. 

  950.             err = nf_get_var_real(ncid, BAD_VARID, value)
    951. 

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

  952.      +          call errore('bad var id: ', err)
    953. 

  953.             nels = 1
    954. 

  954.             do 3, j = 1, var_rank(i)
    955. 

  955.                 nels = nels * var_shape(j,i)
    956. 

  956. 3           continue
    957. 

  957.             allInExtRange = .true.
    958. 

  958.             allInIntRange = .true.
    959. 

  959.             do 4, j = 1, var_nels(i)
    960. 

  960.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    961. 

  961.      +                              index)
    962. 

  962.                 if (err .ne. 0)
    963. 

  963.      +              call error('error in index2indexes 1')
    964. 

  964.                 expect(j) = hash4( var_type(i), var_rank(i), index, 
    965. 

  965.      +                          NFT_REAL )
    966. 

  966.                 if (inRange3(expect(j),var_type(i), NFT_REAL)) then
    967. 

  967.                     allInIntRange = allInIntRange .and.
    968. 

  968.      +                  in_internal_range(NFT_REAL, expect(j))
    969. 

  969.                 else
    970. 

  970.                     allInExtRange = .false.
    971. 

  971.                 end if
    972. 

  972. 4           continue
    973. 

  973.             err = nf_get_var_real(ncid, i, value)
    974. 

  974.             if (canConvert) then
    975. 

  975.                 if (allInExtRange) then
    976. 

  976.                     if (allInIntRange) then
    977. 

  977.                         if (err .ne. 0) 
    978. 

  978.      +                      call errore('nf_get_var: ', err)
    979. 

  979.                     else
    980. 

  980.                         if (err .ne. NF_ERANGE)
    981. 

  981.      +                      call errore('Range error: ', err)
    982. 

  982.                     endif
    983. 

  983.                 else
    984. 

  984.                     if (err .ne. 0  .and. err .ne. NF_ERANGE)
    985. 

  985.      +                  call errore('Range error: ', err)
    986. 

  986.                 endif
    987. 

  987.                 do 5, j = 1, var_nels(i)
    988. 

  988.                     if (inRange3(expect(j),var_type(i),
    989. 

  989.      +                           NFT_REAL) .and.
    990. 

  990.      +                  in_internal_range(NFT_REAL,
    991. 

  991.      +                                          expect(j))) then
    992. 

  992.                         val = value(j)
    993. 

  993.                         if (.not. equal(val, expect(j), 
    994. 

  994.      +                                  var_type(i), 
    995. 

  995.      +                                  NFT_REAL)) then
    996. 

  996.                             call errord('unexpected: ', val)
    997. 

  997.                         else
    998. 

  998.                             nok = nok + 1
    999. 

  999.                         end if
    1000. 

  1000.                     endif
    1001. 

  1001. 5               continue
    1002. 

  1002.             else
    1003. 

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

  1004.      +                  call errore('wrong type: ', err)
    1005. 

  1005.             end if
    1006. 

  1006. 1       continue
    1007. 

  1007.         err = nf_close(ncid)
    1008. 

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

  1009.      +      call errore('nf_close: ',  err)
    1010. 

  1010.         call print_nok(nok)
    1011. 

  1011.         end
    1012. 

  1012. 

  1013.         subroutine test_nf_get_var_double()
    1014. 

  1014.         implicit        none
    1015. 

  1015. #include "tests.inc"
    1016. 

  1016.         integer ncid
    1017. 

  1017.         integer i
    1018. 

  1018.         integer j
    1019. 

  1019.         integer err
    1020. 

  1020.         logical allInExtRange   
    1021. 

  1021.         logical allInIntRange   
    1022. 

  1022.         integer nels
    1023. 

  1023.         integer nok      
    1024. 

  1024.         integer index(MAX_RANK)
    1025. 

  1025.         doubleprecision expect(MAX_NELS)
    1026. 

  1026.         logical canConvert     
    1027. 

  1027.         doubleprecision    value(MAX_NELS)
    1028. 

  1028.         doubleprecision val
    1029. 

  1029. 

  1030.         nok = 0
    1031. 

  1031. 

  1032.         err = nf_open(testfile, NF_NOWRITE, ncid)
    1033. 

  1033.         if (err .ne. 0)
    1034. 

  1034.      +      call errore('nf_open: ', err)
    1035. 

  1035.         do 1, i = 1, NVARS
    1036. 

  1036.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv.
    1037. 

  1037.      +                   (NFT_DOUBLE .eq. NFT_TEXT)
    1038. 

  1038.             err = nf_get_var_double(BAD_ID, i, value)
    1039. 

  1039.             if (err .ne. NF_EBADID)
    1040. 

  1040.      +          call errore('bad ncid: ', err)
    1041. 

  1041.             err = nf_get_var_double(ncid, BAD_VARID, value)
    1042. 

  1042.             if (err .ne. NF_ENOTVAR)
    1043. 

  1043.      +          call errore('bad var id: ', err)
    1044. 

  1044.             nels = 1
    1045. 

  1045.             do 3, j = 1, var_rank(i)
    1046. 

  1046.                 nels = nels * var_shape(j,i)
    1047. 

  1047. 3           continue
    1048. 

  1048.             allInExtRange = .true.
    1049. 

  1049.             allInIntRange = .true.
    1050. 

  1050.             do 4, j = 1, var_nels(i)
    1051. 

  1051.                 err = index2indexes(j, var_rank(i), var_shape(1,i), 
    1052. 

  1052.      +                              index)
    1053. 

  1053.                 if (err .ne. 0)
    1054. 

  1054.      +              call error('error in index2indexes 1')
    1055. 

  1055.                 expect(j) = hash4( var_type(i), var_rank(i), index, 
    1056. 

  1056.      +                          NFT_DOUBLE )
    1057. 

  1057.                 if (inRange3(expect(j),var_type(i), NFT_DOUBLE)) then
    1058. 

  1058.                     allInIntRange = allInIntRange .and.
    1059. 

  1059.      +                  in_internal_range(NFT_DOUBLE, expect(j))
    1060. 

  1060.                 else
    1061. 

  1061.                     allInExtRange = .false.
    1062. 

  1062.                 end if
    1063. 

  1063. 4           continue
    1064. 

  1064.             err = nf_get_var_double(ncid, i, value)
    1065. 

  1065.             if (canConvert) then
    1066. 

  1066.                 if (allInExtRange) then
    1067. 

  1067.                     if (allInIntRange) then
    1068. 

  1068.                         if (err .ne. 0) 
    1069. 

  1069.      +                      call errore('nf_get_var: ', err)
    1070. 

  1070.                     else
    1071. 

  1071.                         if (err .ne. NF_ERANGE)
    1072. 

  1072.      +                      call errore('Range error: ', err)
    1073. 

  1073.                     endif
    1074. 

  1074.                 else
    1075. 

  1075.                     if (err .ne. 0  .and. err .ne. NF_ERANGE)
    1076. 

  1076.      +                  call errore('Range error: ', err)
    1077. 

  1077.                 endif
    1078. 

  1078.                 do 5, j = 1, var_nels(i)
    1079. 

  1079.                     if (inRange3(expect(j),var_type(i),
    1080. 

  1080.      +                           NFT_DOUBLE) .and.
    1081. 

  1081.      +                  in_internal_range(NFT_DOUBLE,
    1082. 

  1082.      +                                          expect(j))) then
    1083. 

  1083.                         val = value(j)
    1084. 

  1084.                         if (.not. equal(val, expect(j), 
    1085. 

  1085.      +                                  var_type(i), 
    1086. 

  1086.      +                                  NFT_DOUBLE)) then
    1087. 

  1087.                             call errord('unexpected: ', val)
    1088. 

  1088.                         else
    1089. 

  1089.                             nok = nok + 1
    1090. 

  1090.                         end if
    1091. 

  1091.                     endif
    1092. 

  1092. 5               continue
    1093. 

  1093.             else
    1094. 

  1094.                 if (err .ne. NF_ECHAR)
    1095. 

  1095.      +                  call errore('wrong type: ', err)
    1096. 

  1096.             end if
    1097. 

  1097. 1       continue
    1098. 

  1098.         err = nf_close(ncid)
    1099. 

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

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

  1101.         call print_nok(nok)
    1102. 

  1102.         end
    1103. 

  1103. 

  1104. 

  1105.         subroutine test_nf_get_vara_text()
    1106. 

  1106.         implicit        none
    1107. 

  1107. #include "tests.inc"
    1108. 

  1108.         integer ncid
    1109. 

  1109.         integer d
    1110. 

  1110.         integer i
    1111. 

  1111.         integer j
    1112. 

  1112.         integer k
    1113. 

  1113.         integer err
    1114. 

  1114.         logical allInExtRange   
    1115. 

  1115.         logical allInIntRange   
    1116. 

  1116.         integer nels
    1117. 

  1117.         integer nslabs
    1118. 

  1118.         integer nok      
    1119. 

  1119.         integer start(MAX_RANK)
    1120. 

  1120.         integer edge(MAX_RANK)
    1121. 

  1121.         integer index(MAX_RANK)
    1122. 

  1122.         integer mid(MAX_RANK)
    1123. 

  1123.         logical canConvert     
    1124. 

  1124.         character    value(MAX_NELS)
    1125. 

  1125.         doubleprecision expect(MAX_NELS)
    1126. 

  1126.         doubleprecision val
    1127. 

  1127.         integer udshift
    1128. 

  1128. 

  1129.         nok = 0
    1130. 

  1130. 

  1131.         err = nf_open(testfile, NF_NOWRITE, ncid)
    1132. 

  1132.         if (err .ne. 0)
    1133. 

  1133.      +      call errore('nf_open: ', err)
    1134. 

  1134.         do 1, i = 1, NVARS
    1135. 

  1135.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    1136. 

  1136.      +                   (NFT_TEXT .eq. NFT_TEXT)
    1137. 

  1137.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    1138. 

  1138.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    1139. 

  1139.             do 2, j = 1, var_rank(i)
    1140. 

  1140.                 start(j) = 1
    1141. 

  1141.                 edge(j) = 1
    1142. 

  1142. 2           continue
    1143. 

  1143.             err = nf_get_vara_text(BAD_ID, i, start,
    1144. 

  1144.      +                  edge, value)
    1145. 

  1145.             if (err .ne. NF_EBADID)
    1146. 

  1146.      +          call errore('bad ncid: ', err)
    1147. 

  1147.             err = nf_get_vara_text(ncid, BAD_VARID, start, 
    1148. 

  1148.      +                           edge, value)
    1149. 

  1149.             if (err .ne. NF_ENOTVAR)
    1150. 

  1150.      +          call errore('bad var id: ', err)
    1151. 

  1151.             do 3, j = 1, var_rank(i)
    1152. 

  1152.                 start(j) = var_shape(j,i) + 1
    1153. 

  1153.                 err = nf_get_vara_text(ncid, i, start,
    1154. 

  1154.      +                               edge, value)
    1155. 

  1155.                 if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1156. 

  1156.      +              call errore('bad index: ', err)
    1157. 

  1157.                 start(j) = 1
    1158. 

  1158.                 edge(j) = var_shape(j,i) + 1
    1159. 

  1159.                 err = nf_get_vara_text(ncid, i, start,
    1160. 

  1160.      +                               edge, value)
    1161. 

  1161.                 if (canConvert .and. err .ne. NF_EEDGE)
    1162. 

  1162.      +              call errore('bad edge: ', err)
    1163. 

  1163.                 edge(j) = 1
    1164. 

  1164. 3           continue
    1165. 

  1165. 

  1166. C           /* Check non-scalars for correct error returned even when */
    1167. 

  1167. C           /* there is nothing to get (edge(j).eq.0) */
    1168. 

  1168.             if (var_rank(i) .gt. 0) then
    1169. 

  1169.                 do 10, j = 1, var_rank(i)
    1170. 

  1170.                     edge(j) = 0
    1171. 

  1171. 10              continue
    1172. 

  1172.                 err = nf_get_vara_text(BAD_ID, i, start,
    1173. 

  1173.      +                  edge, value)
    1174. 

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

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

  1176.                 err = nf_get_vara_text(ncid, BAD_VARID,
    1177. 

  1177.      +                  start, edge, value)
    1178. 

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

  1179.      +              call errore('bad var id: ', err)
    1180. 

  1180.                 do 11, j = 1, var_rank(i)
    1181. 

  1181.                     if (var_dimid(j,i) .gt. 1) then     !/* skip record dim */
    1182. 

  1182.                         start(j) = var_shape(j,i) + 1
    1183. 

  1183.                         err = nf_get_vara_text(ncid, i,
    1184. 

  1184.      +                          start, edge, value)
    1185. 

  1185.                         if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1186. 

  1186.      +                      call errore('bad start: ', err)
    1187. 

  1187.                         start(j) = 1
    1188. 

  1188.                     endif
    1189. 

  1189. 11              continue
    1190. 

  1190.                 err = nf_get_vara_text(ncid, i, start,
    1191. 

  1191.      +                          edge, value)
    1192. 

  1192.                 if (canConvert) then
    1193. 

  1193.                     if (err .ne. 0) 
    1194. 

  1194.      +                  call error(nf_strerror(err))
    1195. 

  1195.                 else
    1196. 

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

  1197.      +                  call errore('wrong type: ', err)
    1198. 

  1198.                 endif
    1199. 

  1199.                 do 12, j = 1, var_rank(i)
    1200. 

  1200.                     edge(j) = 1
    1201. 

  1201. 12              continue
    1202. 

  1202.             endif
    1203. 

  1203. 

  1204. C           Choose a random point dividing each dim into 2 parts
    1205. 

  1205. C           get 2^rank (nslabs) slabs so defined
    1206. 

  1206.             nslabs = 1
    1207. 

  1207.             do 4, j = 1, var_rank(i)
    1208. 

  1208.                 mid(j) = roll( var_shape(j,i) )
    1209. 

  1209.                 nslabs = nslabs * 2
    1210. 

  1210. 4           continue
    1211. 

  1211. C           bits of k determine whether to get lower or upper part of dim 
    1212. 

  1212.             do 5, k = 1, nslabs
    1213. 

  1213.                 nels = 1
    1214. 

  1214.                 do 6, j = 1, var_rank(i)
    1215. 

  1215.                     if (mod(udshift((k-1), -(j-1)), 2) .eq. 1) then
    1216. 

  1216.                         start(j) = 1
    1217. 

  1217.                         edge(j) = mid(j)
    1218. 

  1218.                     else
    1219. 

  1219.                         start(j) = 1 + mid(j)
    1220. 

  1220.                         edge(j) = var_shape(j,i) - mid(j)
    1221. 

  1221.                     end if
    1222. 

  1222.                     nels = nels * edge(j)
    1223. 

  1223. 6               continue
    1224. 

  1224.                 allInIntRange = .true.
    1225. 

  1225.                 allInExtRange = .true.
    1226. 

  1226.                 do 7, j = 1, nels
    1227. 

  1227.                     err = index2indexes(j, var_rank(i), edge, index)
    1228. 

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

  1229.      +                  call error('error in index2indexes 1')
    1230. 

  1230.                     do 8, d = 1, var_rank(i)
    1231. 

  1231.                         index(d) = index(d) + start(d) - 1
    1232. 

  1232. 8                   continue
    1233. 

  1233.                     expect(j) = hash4(var_type(i), var_rank(i), index, 
    1234. 

  1234.      +                                NFT_TEXT)
    1235. 

  1235.                     if (inRange3(expect(j),var_type(i), 
    1236. 

  1236.      +                           NFT_TEXT)) then
    1237. 

  1237.                         allInIntRange = 
    1238. 

  1238.      +                      allInIntRange .and.
    1239. 

  1239.      +                      in_internal_range(NFT_TEXT, expect(j))
    1240. 

  1240.                     else
    1241. 

  1241.                         allInExtRange = .false.
    1242. 

  1242.                     end if
    1243. 

  1243. 7               continue
    1244. 

  1244.                 err = nf_get_vara_text(ncid, i, start,
    1245. 

  1245.      +                          edge, value)
    1246. 

  1246.                 if (canConvert) then
    1247. 

  1247.                     if (allInExtRange) then
    1248. 

  1248.                         if (allInIntRange) then
    1249. 

  1249.                             if (err .ne. 0)
    1250. 

  1250.      +                          call errore('nf_get_vara_text:', err)
    1251. 

  1251.                         else
    1252. 

  1252.                             if (err .ne. NF_ERANGE)
    1253. 

  1253.      +                          call errore('Range error: ', err)
    1254. 

  1254.                         end if
    1255. 

  1255.                     else
    1256. 

  1256.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    1257. 

  1257.      +                      call errore('OK or Range error: ', err)
    1258. 

  1258.                     end if
    1259. 

  1259.                     do 9, j = 1, nels
    1260. 

  1260.                         if (inRange3(expect(j),var_type(i),
    1261. 

  1261.      +                               NFT_TEXT) .and.
    1262. 

  1262.      +                      in_internal_range(NFT_TEXT, expect(j)))
    1263. 

  1263.      +                          then
    1264. 

  1264.                             val = ichar(value(j))
    1265. 

  1265.                             if (.not.equal(val,expect(j),
    1266. 

  1266.      +                                     var_type(i),NFT_TEXT)) 
    1267. 

  1267.      +                              then
    1268. 

  1268.                                 call error(
    1269. 

  1269.      +                              'value read not that expected')
    1270. 

  1270.                                 if (verbose) then
    1271. 

  1271.                                     call error(' ')
    1272. 

  1272.                                     call errori('varid: ', i)
    1273. 

  1273.                                     call errorc('var_name: ',
    1274. 

  1274.      +                                  var_name(i))
    1275. 

  1275.                                     call errori('element number: %d ', 
    1276. 

  1276.      +                                          j)
    1277. 

  1277.                                     call errord('expect: ', expect(j))
    1278. 

  1278.                                     call errord('got: ', val)
    1279. 

  1279.                                 end if
    1280. 

  1280.                             else
    1281. 

  1281.                                 nok = nok + 1
    1282. 

  1282.                             end if
    1283. 

  1283.                         end if
    1284. 

  1284. 9                   continue
    1285. 

  1285.                 else
    1286. 

  1286.                     if (nels .gt. 0  .and. err .ne. NF_ECHAR)
    1287. 

  1287.      +                  call errore('wrong type: ', err)
    1288. 

  1288.                 end if
    1289. 

  1289. 5           continue
    1290. 

  1290. 1       continue
    1291. 

  1291.         err = nf_close(ncid)
    1292. 

  1292.         if (err .ne. 0)
    1293. 

  1293.      +      call errorc('nf_close: ', nf_strerror(err))
    1294. 

  1294.         call print_nok(nok)
    1295. 

  1295.         end
    1296. 

  1296. 

  1297. #ifdef NF_INT1_T
    1298. 

  1298.         subroutine test_nf_get_vara_int1()
    1299. 

  1299.         implicit        none
    1300. 

  1300. #include "tests.inc"
    1301. 

  1301.         integer ncid
    1302. 

  1302.         integer d
    1303. 

  1303.         integer i
    1304. 

  1304.         integer j
    1305. 

  1305.         integer k
    1306. 

  1306.         integer err
    1307. 

  1307.         logical allInExtRange   
    1308. 

  1308.         logical allInIntRange   
    1309. 

  1309.         integer nels
    1310. 

  1310.         integer nslabs
    1311. 

  1311.         integer nok      
    1312. 

  1312.         integer start(MAX_RANK)
    1313. 

  1313.         integer edge(MAX_RANK)
    1314. 

  1314.         integer index(MAX_RANK)
    1315. 

  1315.         integer mid(MAX_RANK)
    1316. 

  1316.         logical canConvert     
    1317. 

  1317.         NF_INT1_T    value(MAX_NELS)
    1318. 

  1318.         doubleprecision expect(MAX_NELS)
    1319. 

  1319.         doubleprecision val
    1320. 

  1320.         integer udshift
    1321. 

  1321. 

  1322.         nok = 0
    1323. 

  1323. 

  1324.         err = nf_open(testfile, NF_NOWRITE, ncid)
    1325. 

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

  1326.      +      call errore('nf_open: ', err)
    1327. 

  1327.         do 1, i = 1, NVARS
    1328. 

  1328.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    1329. 

  1329.      +                   (NFT_INT1 .eq. NFT_TEXT)
    1330. 

  1330.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    1331. 

  1331.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    1332. 

  1332.             do 2, j = 1, var_rank(i)
    1333. 

  1333.                 start(j) = 1
    1334. 

  1334.                 edge(j) = 1
    1335. 

  1335. 2           continue
    1336. 

  1336.             err = nf_get_vara_int1(BAD_ID, i, start,
    1337. 

  1337.      +                  edge, value)
    1338. 

  1338.             if (err .ne. NF_EBADID)
    1339. 

  1339.      +          call errore('bad ncid: ', err)
    1340. 

  1340.             err = nf_get_vara_int1(ncid, BAD_VARID, start, 
    1341. 

  1341.      +                           edge, value)
    1342. 

  1342.             if (err .ne. NF_ENOTVAR)
    1343. 

  1343.      +          call errore('bad var id: ', err)
    1344. 

  1344.             do 3, j = 1, var_rank(i)
    1345. 

  1345.                 start(j) = var_shape(j,i) + 1
    1346. 

  1346.                 err = nf_get_vara_int1(ncid, i, start,
    1347. 

  1347.      +                               edge, value)
    1348. 

  1348.                 if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1349. 

  1349.      +              call errore('bad index: ', err)
    1350. 

  1350.                 start(j) = 1
    1351. 

  1351.                 edge(j) = var_shape(j,i) + 1
    1352. 

  1352.                 err = nf_get_vara_int1(ncid, i, start,
    1353. 

  1353.      +                               edge, value)
    1354. 

  1354.                 if (canConvert .and. err .ne. NF_EEDGE)
    1355. 

  1355.      +              call errore('bad edge: ', err)
    1356. 

  1356.                 edge(j) = 1
    1357. 

  1357. 3           continue
    1358. 

  1358. 

  1359. C           /* Check non-scalars for correct error returned even when */
    1360. 

  1360. C           /* there is nothing to get (edge(j).eq.0) */
    1361. 

  1361.             if (var_rank(i) .gt. 0) then
    1362. 

  1362.                 do 10, j = 1, var_rank(i)
    1363. 

  1363.                     edge(j) = 0
    1364. 

  1364. 10              continue
    1365. 

  1365.                 err = nf_get_vara_int1(BAD_ID, i, start,
    1366. 

  1366.      +                  edge, value)
    1367. 

  1367.                 if (err .ne. NF_EBADID) 
    1368. 

  1368.      +              call errore('bad ncid: ', err)
    1369. 

  1369.                 err = nf_get_vara_int1(ncid, BAD_VARID,
    1370. 

  1370.      +                  start, edge, value)
    1371. 

  1371.                 if (err .ne. NF_ENOTVAR) 
    1372. 

  1372.      +              call errore('bad var id: ', err)
    1373. 

  1373.                 do 11, j = 1, var_rank(i)
    1374. 

  1374.                     if (var_dimid(j,i) .gt. 1) then     !/* skip record dim */
    1375. 

  1375.                         start(j) = var_shape(j,i) + 1
    1376. 

  1376.                         err = nf_get_vara_int1(ncid, i,
    1377. 

  1377.      +                          start, edge, value)
    1378. 

  1378.                         if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1379. 

  1379.      +                      call errore('bad start: ', err)
    1380. 

  1380.                         start(j) = 1
    1381. 

  1381.                     endif
    1382. 

  1382. 11              continue
    1383. 

  1383.                 err = nf_get_vara_int1(ncid, i, start,
    1384. 

  1384.      +                          edge, value)
    1385. 

  1385.                 if (canConvert) then
    1386. 

  1386.                     if (err .ne. 0) 
    1387. 

  1387.      +                  call error(nf_strerror(err))
    1388. 

  1388.                 else
    1389. 

  1389.                     if (err .ne. NF_ECHAR)
    1390. 

  1390.      +                  call errore('wrong type: ', err)
    1391. 

  1391.                 endif
    1392. 

  1392.                 do 12, j = 1, var_rank(i)
    1393. 

  1393.                     edge(j) = 1
    1394. 

  1394. 12              continue
    1395. 

  1395.             endif
    1396. 

  1396. 

  1397. C           Choose a random point dividing each dim into 2 parts
    1398. 

  1398. C           get 2^rank (nslabs) slabs so defined
    1399. 

  1399.             nslabs = 1
    1400. 

  1400.             do 4, j = 1, var_rank(i)
    1401. 

  1401.                 mid(j) = roll( var_shape(j,i) )
    1402. 

  1402.                 nslabs = nslabs * 2
    1403. 

  1403. 4           continue
    1404. 

  1404. C           bits of k determine whether to get lower or upper part of dim 
    1405. 

  1405.             do 5, k = 1, nslabs
    1406. 

  1406.                 nels = 1
    1407. 

  1407.                 do 6, j = 1, var_rank(i)
    1408. 

  1408.                     if (mod(udshift((k-1), -(j-1)), 2) .eq. 1) then
    1409. 

  1409.                         start(j) = 1
    1410. 

  1410.                         edge(j) = mid(j)
    1411. 

  1411.                     else
    1412. 

  1412.                         start(j) = 1 + mid(j)
    1413. 

  1413.                         edge(j) = var_shape(j,i) - mid(j)
    1414. 

  1414.                     end if
    1415. 

  1415.                     nels = nels * edge(j)
    1416. 

  1416. 6               continue
    1417. 

  1417.                 allInIntRange = .true.
    1418. 

  1418.                 allInExtRange = .true.
    1419. 

  1419.                 do 7, j = 1, nels
    1420. 

  1420.                     err = index2indexes(j, var_rank(i), edge, index)
    1421. 

  1421.                     if (err .ne. 0)
    1422. 

  1422.      +                  call error('error in index2indexes 1')
    1423. 

  1423.                     do 8, d = 1, var_rank(i)
    1424. 

  1424.                         index(d) = index(d) + start(d) - 1
    1425. 

  1425. 8                   continue
    1426. 

  1426.                     expect(j) = hash4(var_type(i), var_rank(i), index, 
    1427. 

  1427.      +                                NFT_INT1)
    1428. 

  1428.                     if (inRange3(expect(j),var_type(i), 
    1429. 

  1429.      +                           NFT_INT1)) then
    1430. 

  1430.                         allInIntRange = 
    1431. 

  1431.      +                      allInIntRange .and.
    1432. 

  1432.      +                      in_internal_range(NFT_INT1, expect(j))
    1433. 

  1433.                     else
    1434. 

  1434.                         allInExtRange = .false.
    1435. 

  1435.                     end if
    1436. 

  1436. 7               continue
    1437. 

  1437.                 err = nf_get_vara_int1(ncid, i, start,
    1438. 

  1438.      +                          edge, value)
    1439. 

  1439.                 if (canConvert) then
    1440. 

  1440.                     if (allInExtRange) then
    1441. 

  1441.                         if (allInIntRange) then
    1442. 

  1442.                             if (err .ne. 0)
    1443. 

  1443.      +                          call errore('nf_get_vara_int1:', err)
    1444. 

  1444.                         else
    1445. 

  1445.                             if (err .ne. NF_ERANGE)
    1446. 

  1446.      +                          call errore('Range error: ', err)
    1447. 

  1447.                         end if
    1448. 

  1448.                     else
    1449. 

  1449.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    1450. 

  1450.      +                      call errore('OK or Range error: ', err)
    1451. 

  1451.                     end if
    1452. 

  1452.                     do 9, j = 1, nels
    1453. 

  1453.                         if (inRange3(expect(j),var_type(i),
    1454. 

  1454.      +                               NFT_INT1) .and.
    1455. 

  1455.      +                      in_internal_range(NFT_INT1, expect(j)))
    1456. 

  1456.      +                          then
    1457. 

  1457.                             val = value(j)
    1458. 

  1458.                             if (.not.equal(val,expect(j),
    1459. 

  1459.      +                                     var_type(i),NFT_INT1)) 
    1460. 

  1460.      +                              then
    1461. 

  1461.                                 call error(
    1462. 

  1462.      +                              'value read not that expected')
    1463. 

  1463.                                 if (verbose) then
    1464. 

  1464.                                     call error(' ')
    1465. 

  1465.                                     call errori('varid: ', i)
    1466. 

  1466.                                     call errorc('var_name: ',
    1467. 

  1467.      +                                  var_name(i))
    1468. 

  1468.                                     call errori('element number: %d ', 
    1469. 

  1469.      +                                          j)
    1470. 

  1470.                                     call errord('expect: ', expect(j))
    1471. 

  1471.                                     call errord('got: ', val)
    1472. 

  1472.                                 end if
    1473. 

  1473.                             else
    1474. 

  1474.                                 nok = nok + 1
    1475. 

  1475.                             end if
    1476. 

  1476.                         end if
    1477. 

  1477. 9                   continue
    1478. 

  1478.                 else
    1479. 

  1479.                     if (nels .gt. 0  .and. err .ne. NF_ECHAR)
    1480. 

  1480.      +                  call errore('wrong type: ', err)
    1481. 

  1481.                 end if
    1482. 

  1482. 5           continue
    1483. 

  1483. 1       continue
    1484. 

  1484.         err = nf_close(ncid)
    1485. 

  1485.         if (err .ne. 0)
    1486. 

  1486.      +      call errorc('nf_close: ', nf_strerror(err))
    1487. 

  1487.         call print_nok(nok)
    1488. 

  1488.         end
    1489. 

  1489. 

  1490. #endif
    1491. 

  1491. #ifdef NF_INT2_T
    1492. 

  1492.         subroutine test_nf_get_vara_int2()
    1493. 

  1493.         implicit        none
    1494. 

  1494. #include "tests.inc"
    1495. 

  1495.         integer ncid
    1496. 

  1496.         integer d
    1497. 

  1497.         integer i
    1498. 

  1498.         integer j
    1499. 

  1499.         integer k
    1500. 

  1500.         integer err
    1501. 

  1501.         logical allInExtRange   
    1502. 

  1502.         logical allInIntRange   
    1503. 

  1503.         integer nels
    1504. 

  1504.         integer nslabs
    1505. 

  1505.         integer nok      
    1506. 

  1506.         integer start(MAX_RANK)
    1507. 

  1507.         integer edge(MAX_RANK)
    1508. 

  1508.         integer index(MAX_RANK)
    1509. 

  1509.         integer mid(MAX_RANK)
    1510. 

  1510.         logical canConvert     
    1511. 

  1511.         NF_INT2_T    value(MAX_NELS)
    1512. 

  1512.         doubleprecision expect(MAX_NELS)
    1513. 

  1513.         doubleprecision val
    1514. 

  1514.         integer udshift
    1515. 

  1515. 

  1516.         nok = 0
    1517. 

  1517. 

  1518.         err = nf_open(testfile, NF_NOWRITE, ncid)
    1519. 

  1519.         if (err .ne. 0)
    1520. 

  1520.      +      call errore('nf_open: ', err)
    1521. 

  1521.         do 1, i = 1, NVARS
    1522. 

  1522.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    1523. 

  1523.      +                   (NFT_INT2 .eq. NFT_TEXT)
    1524. 

  1524.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    1525. 

  1525.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    1526. 

  1526.             do 2, j = 1, var_rank(i)
    1527. 

  1527.                 start(j) = 1
    1528. 

  1528.                 edge(j) = 1
    1529. 

  1529. 2           continue
    1530. 

  1530.             err = nf_get_vara_int2(BAD_ID, i, start,
    1531. 

  1531.      +                  edge, value)
    1532. 

  1532.             if (err .ne. NF_EBADID)
    1533. 

  1533.      +          call errore('bad ncid: ', err)
    1534. 

  1534.             err = nf_get_vara_int2(ncid, BAD_VARID, start, 
    1535. 

  1535.      +                           edge, value)
    1536. 

  1536.             if (err .ne. NF_ENOTVAR)
    1537. 

  1537.      +          call errore('bad var id: ', err)
    1538. 

  1538.             do 3, j = 1, var_rank(i)
    1539. 

  1539.                 start(j) = var_shape(j,i) + 1
    1540. 

  1540.                 err = nf_get_vara_int2(ncid, i, start,
    1541. 

  1541.      +                               edge, value)
    1542. 

  1542.                 if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1543. 

  1543.      +              call errore('bad index: ', err)
    1544. 

  1544.                 start(j) = 1
    1545. 

  1545.                 edge(j) = var_shape(j,i) + 1
    1546. 

  1546.                 err = nf_get_vara_int2(ncid, i, start,
    1547. 

  1547.      +                               edge, value)
    1548. 

  1548.                 if (canConvert .and. err .ne. NF_EEDGE)
    1549. 

  1549.      +              call errore('bad edge: ', err)
    1550. 

  1550.                 edge(j) = 1
    1551. 

  1551. 3           continue
    1552. 

  1552. 

  1553. C           /* Check non-scalars for correct error returned even when */
    1554. 

  1554. C           /* there is nothing to get (edge(j).eq.0) */
    1555. 

  1555.             if (var_rank(i) .gt. 0) then
    1556. 

  1556.                 do 10, j = 1, var_rank(i)
    1557. 

  1557.                     edge(j) = 0
    1558. 

  1558. 10              continue
    1559. 

  1559.                 err = nf_get_vara_int2(BAD_ID, i, start,
    1560. 

  1560.      +                  edge, value)
    1561. 

  1561.                 if (err .ne. NF_EBADID) 
    1562. 

  1562.      +              call errore('bad ncid: ', err)
    1563. 

  1563.                 err = nf_get_vara_int2(ncid, BAD_VARID,
    1564. 

  1564.      +                  start, edge, value)
    1565. 

  1565.                 if (err .ne. NF_ENOTVAR) 
    1566. 

  1566.      +              call errore('bad var id: ', err)
    1567. 

  1567.                 do 11, j = 1, var_rank(i)
    1568. 

  1568.                     if (var_dimid(j,i) .gt. 1) then     !/* skip record dim */
    1569. 

  1569.                         start(j) = var_shape(j,i) + 1
    1570. 

  1570.                         err = nf_get_vara_int2(ncid, i,
    1571. 

  1571.      +                          start, edge, value)
    1572. 

  1572.                         if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1573. 

  1573.      +                      call errore('bad start: ', err)
    1574. 

  1574.                         start(j) = 1
    1575. 

  1575.                     endif
    1576. 

  1576. 11              continue
    1577. 

  1577.                 err = nf_get_vara_int2(ncid, i, start,
    1578. 

  1578.      +                          edge, value)
    1579. 

  1579.                 if (canConvert) then
    1580. 

  1580.                     if (err .ne. 0) 
    1581. 

  1581.      +                  call error(nf_strerror(err))
    1582. 

  1582.                 else
    1583. 

  1583.                     if (err .ne. NF_ECHAR)
    1584. 

  1584.      +                  call errore('wrong type: ', err)
    1585. 

  1585.                 endif
    1586. 

  1586.                 do 12, j = 1, var_rank(i)
    1587. 

  1587.                     edge(j) = 1
    1588. 

  1588. 12              continue
    1589. 

  1589.             endif
    1590. 

  1590. 

  1591. C           Choose a random point dividing each dim into 2 parts
    1592. 

  1592. C           get 2^rank (nslabs) slabs so defined
    1593. 

  1593.             nslabs = 1
    1594. 

  1594.             do 4, j = 1, var_rank(i)
    1595. 

  1595.                 mid(j) = roll( var_shape(j,i) )
    1596. 

  1596.                 nslabs = nslabs * 2
    1597. 

  1597. 4           continue
    1598. 

  1598. C           bits of k determine whether to get lower or upper part of dim 
    1599. 

  1599.             do 5, k = 1, nslabs
    1600. 

  1600.                 nels = 1
    1601. 

  1601.                 do 6, j = 1, var_rank(i)
    1602. 

  1602.                     if (mod(udshift((k-1), -(j-1)), 2) .eq. 1) then
    1603. 

  1603.                         start(j) = 1
    1604. 

  1604.                         edge(j) = mid(j)
    1605. 

  1605.                     else
    1606. 

  1606.                         start(j) = 1 + mid(j)
    1607. 

  1607.                         edge(j) = var_shape(j,i) - mid(j)
    1608. 

  1608.                     end if
    1609. 

  1609.                     nels = nels * edge(j)
    1610. 

  1610. 6               continue
    1611. 

  1611.                 allInIntRange = .true.
    1612. 

  1612.                 allInExtRange = .true.
    1613. 

  1613.                 do 7, j = 1, nels
    1614. 

  1614.                     err = index2indexes(j, var_rank(i), edge, index)
    1615. 

  1615.                     if (err .ne. 0)
    1616. 

  1616.      +                  call error('error in index2indexes 1')
    1617. 

  1617.                     do 8, d = 1, var_rank(i)
    1618. 

  1618.                         index(d) = index(d) + start(d) - 1
    1619. 

  1619. 8                   continue
    1620. 

  1620.                     expect(j) = hash4(var_type(i), var_rank(i), index, 
    1621. 

  1621.      +                                NFT_INT2)
    1622. 

  1622.                     if (inRange3(expect(j),var_type(i), 
    1623. 

  1623.      +                           NFT_INT2)) then
    1624. 

  1624.                         allInIntRange = 
    1625. 

  1625.      +                      allInIntRange .and.
    1626. 

  1626.      +                      in_internal_range(NFT_INT2, expect(j))
    1627. 

  1627.                     else
    1628. 

  1628.                         allInExtRange = .false.
    1629. 

  1629.                     end if
    1630. 

  1630. 7               continue
    1631. 

  1631.                 err = nf_get_vara_int2(ncid, i, start,
    1632. 

  1632.      +                          edge, value)
    1633. 

  1633.                 if (canConvert) then
    1634. 

  1634.                     if (allInExtRange) then
    1635. 

  1635.                         if (allInIntRange) then
    1636. 

  1636.                             if (err .ne. 0)
    1637. 

  1637.      +                          call errore('nf_get_vara_int2:', err)
    1638. 

  1638.                         else
    1639. 

  1639.                             if (err .ne. NF_ERANGE)
    1640. 

  1640.      +                          call errore('Range error: ', err)
    1641. 

  1641.                         end if
    1642. 

  1642.                     else
    1643. 

  1643.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    1644. 

  1644.      +                      call errore('OK or Range error: ', err)
    1645. 

  1645.                     end if
    1646. 

  1646.                     do 9, j = 1, nels
    1647. 

  1647.                         if (inRange3(expect(j),var_type(i),
    1648. 

  1648.      +                               NFT_INT2) .and.
    1649. 

  1649.      +                      in_internal_range(NFT_INT2, expect(j)))
    1650. 

  1650.      +                          then
    1651. 

  1651.                             val = value(j)
    1652. 

  1652.                             if (.not.equal(val,expect(j),
    1653. 

  1653.      +                                     var_type(i),NFT_INT2)) 
    1654. 

  1654.      +                              then
    1655. 

  1655.                                 call error(
    1656. 

  1656.      +                              'value read not that expected')
    1657. 

  1657.                                 if (verbose) then
    1658. 

  1658.                                     call error(' ')
    1659. 

  1659.                                     call errori('varid: ', i)
    1660. 

  1660.                                     call errorc('var_name: ',
    1661. 

  1661.      +                                  var_name(i))
    1662. 

  1662.                                     call errori('element number: %d ', 
    1663. 

  1663.      +                                          j)
    1664. 

  1664.                                     call errord('expect: ', expect(j))
    1665. 

  1665.                                     call errord('got: ', val)
    1666. 

  1666.                                 end if
    1667. 

  1667.                             else
    1668. 

  1668.                                 nok = nok + 1
    1669. 

  1669.                             end if
    1670. 

  1670.                         end if
    1671. 

  1671. 9                   continue
    1672. 

  1672.                 else
    1673. 

  1673.                     if (nels .gt. 0  .and. err .ne. NF_ECHAR)
    1674. 

  1674.      +                  call errore('wrong type: ', err)
    1675. 

  1675.                 end if
    1676. 

  1676. 5           continue
    1677. 

  1677. 1       continue
    1678. 

  1678.         err = nf_close(ncid)
    1679. 

  1679.         if (err .ne. 0)
    1680. 

  1680.      +      call errorc('nf_close: ', nf_strerror(err))
    1681. 

  1681.         call print_nok(nok)
    1682. 

  1682.         end
    1683. 

  1683. 

  1684. #endif
    1685. 

  1685.         subroutine test_nf_get_vara_int()
    1686. 

  1686.         implicit        none
    1687. 

  1687. #include "tests.inc"
    1688. 

  1688.         integer ncid
    1689. 

  1689.         integer d
    1690. 

  1690.         integer i
    1691. 

  1691.         integer j
    1692. 

  1692.         integer k
    1693. 

  1693.         integer err
    1694. 

  1694.         logical allInExtRange   
    1695. 

  1695.         logical allInIntRange   
    1696. 

  1696.         integer nels
    1697. 

  1697.         integer nslabs
    1698. 

  1698.         integer nok      
    1699. 

  1699.         integer start(MAX_RANK)
    1700. 

  1700.         integer edge(MAX_RANK)
    1701. 

  1701.         integer index(MAX_RANK)
    1702. 

  1702.         integer mid(MAX_RANK)
    1703. 

  1703.         logical canConvert     
    1704. 

  1704.         integer    value(MAX_NELS)
    1705. 

  1705.         doubleprecision expect(MAX_NELS)
    1706. 

  1706.         doubleprecision val
    1707. 

  1707.         integer udshift
    1708. 

  1708. 

  1709.         nok = 0
    1710. 

  1710. 

  1711.         err = nf_open(testfile, NF_NOWRITE, ncid)
    1712. 

  1712.         if (err .ne. 0)
    1713. 

  1713.      +      call errore('nf_open: ', err)
    1714. 

  1714.         do 1, i = 1, NVARS
    1715. 

  1715.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    1716. 

  1716.      +                   (NFT_INT .eq. NFT_TEXT)
    1717. 

  1717.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    1718. 

  1718.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    1719. 

  1719.             do 2, j = 1, var_rank(i)
    1720. 

  1720.                 start(j) = 1
    1721. 

  1721.                 edge(j) = 1
    1722. 

  1722. 2           continue
    1723. 

  1723.             err = nf_get_vara_int(BAD_ID, i, start,
    1724. 

  1724.      +                  edge, value)
    1725. 

  1725.             if (err .ne. NF_EBADID)
    1726. 

  1726.      +          call errore('bad ncid: ', err)
    1727. 

  1727.             err = nf_get_vara_int(ncid, BAD_VARID, start, 
    1728. 

  1728.      +                           edge, value)
    1729. 

  1729.             if (err .ne. NF_ENOTVAR)
    1730. 

  1730.      +          call errore('bad var id: ', err)
    1731. 

  1731.             do 3, j = 1, var_rank(i)
    1732. 

  1732.                 start(j) = var_shape(j,i) + 1
    1733. 

  1733.                 err = nf_get_vara_int(ncid, i, start,
    1734. 

  1734.      +                               edge, value)
    1735. 

  1735.                 if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1736. 

  1736.      +              call errore('bad index: ', err)
    1737. 

  1737.                 start(j) = 1
    1738. 

  1738.                 edge(j) = var_shape(j,i) + 1
    1739. 

  1739.                 err = nf_get_vara_int(ncid, i, start,
    1740. 

  1740.      +                               edge, value)
    1741. 

  1741.                 if (canConvert .and. err .ne. NF_EEDGE)
    1742. 

  1742.      +              call errore('bad edge: ', err)
    1743. 

  1743.                 edge(j) = 1
    1744. 

  1744. 3           continue
    1745. 

  1745. 

  1746. C           /* Check non-scalars for correct error returned even when */
    1747. 

  1747. C           /* there is nothing to get (edge(j).eq.0) */
    1748. 

  1748.             if (var_rank(i) .gt. 0) then
    1749. 

  1749.                 do 10, j = 1, var_rank(i)
    1750. 

  1750.                     edge(j) = 0
    1751. 

  1751. 10              continue
    1752. 

  1752.                 err = nf_get_vara_int(BAD_ID, i, start,
    1753. 

  1753.      +                  edge, value)
    1754. 

  1754.                 if (err .ne. NF_EBADID) 
    1755. 

  1755.      +              call errore('bad ncid: ', err)
    1756. 

  1756.                 err = nf_get_vara_int(ncid, BAD_VARID,
    1757. 

  1757.      +                  start, edge, value)
    1758. 

  1758.                 if (err .ne. NF_ENOTVAR) 
    1759. 

  1759.      +              call errore('bad var id: ', err)
    1760. 

  1760.                 do 11, j = 1, var_rank(i)
    1761. 

  1761.                     if (var_dimid(j,i) .gt. 1) then     !/* skip record dim */
    1762. 

  1762.                         start(j) = var_shape(j,i) + 1
    1763. 

  1763.                         err = nf_get_vara_int(ncid, i,
    1764. 

  1764.      +                          start, edge, value)
    1765. 

  1765.                         if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1766. 

  1766.      +                      call errore('bad start: ', err)
    1767. 

  1767.                         start(j) = 1
    1768. 

  1768.                     endif
    1769. 

  1769. 11              continue
    1770. 

  1770.                 err = nf_get_vara_int(ncid, i, start,
    1771. 

  1771.      +                          edge, value)
    1772. 

  1772.                 if (canConvert) then
    1773. 

  1773.                     if (err .ne. 0) 
    1774. 

  1774.      +                  call error(nf_strerror(err))
    1775. 

  1775.                 else
    1776. 

  1776.                     if (err .ne. NF_ECHAR)
    1777. 

  1777.      +                  call errore('wrong type: ', err)
    1778. 

  1778.                 endif
    1779. 

  1779.                 do 12, j = 1, var_rank(i)
    1780. 

  1780.                     edge(j) = 1
    1781. 

  1781. 12              continue
    1782. 

  1782.             endif
    1783. 

  1783. 

  1784. C           Choose a random point dividing each dim into 2 parts
    1785. 

  1785. C           get 2^rank (nslabs) slabs so defined
    1786. 

  1786.             nslabs = 1
    1787. 

  1787.             do 4, j = 1, var_rank(i)
    1788. 

  1788.                 mid(j) = roll( var_shape(j,i) )
    1789. 

  1789.                 nslabs = nslabs * 2
    1790. 

  1790. 4           continue
    1791. 

  1791. C           bits of k determine whether to get lower or upper part of dim 
    1792. 

  1792.             do 5, k = 1, nslabs
    1793. 

  1793.                 nels = 1
    1794. 

  1794.                 do 6, j = 1, var_rank(i)
    1795. 

  1795.                     if (mod(udshift((k-1), -(j-1)), 2) .eq. 1) then
    1796. 

  1796.                         start(j) = 1
    1797. 

  1797.                         edge(j) = mid(j)
    1798. 

  1798.                     else
    1799. 

  1799.                         start(j) = 1 + mid(j)
    1800. 

  1800.                         edge(j) = var_shape(j,i) - mid(j)
    1801. 

  1801.                     end if
    1802. 

  1802.                     nels = nels * edge(j)
    1803. 

  1803. 6               continue
    1804. 

  1804.                 allInIntRange = .true.
    1805. 

  1805.                 allInExtRange = .true.
    1806. 

  1806.                 do 7, j = 1, nels
    1807. 

  1807.                     err = index2indexes(j, var_rank(i), edge, index)
    1808. 

  1808.                     if (err .ne. 0)
    1809. 

  1809.      +                  call error('error in index2indexes 1')
    1810. 

  1810.                     do 8, d = 1, var_rank(i)
    1811. 

  1811.                         index(d) = index(d) + start(d) - 1
    1812. 

  1812. 8                   continue
    1813. 

  1813.                     expect(j) = hash4(var_type(i), var_rank(i), index, 
    1814. 

  1814.      +                                NFT_INT)
    1815. 

  1815.                     if (inRange3(expect(j),var_type(i), 
    1816. 

  1816.      +                           NFT_INT)) then
    1817. 

  1817.                         allInIntRange = 
    1818. 

  1818.      +                      allInIntRange .and.
    1819. 

  1819.      +                      in_internal_range(NFT_INT, expect(j))
    1820. 

  1820.                     else
    1821. 

  1821.                         allInExtRange = .false.
    1822. 

  1822.                     end if
    1823. 

  1823. 7               continue
    1824. 

  1824.                 err = nf_get_vara_int(ncid, i, start,
    1825. 

  1825.      +                          edge, value)
    1826. 

  1826.                 if (canConvert) then
    1827. 

  1827.                     if (allInExtRange) then
    1828. 

  1828.                         if (allInIntRange) then
    1829. 

  1829.                             if (err .ne. 0)
    1830. 

  1830.      +                          call errore('nf_get_vara_int:', err)
    1831. 

  1831.                         else
    1832. 

  1832.                             if (err .ne. NF_ERANGE)
    1833. 

  1833.      +                          call errore('Range error: ', err)
    1834. 

  1834.                         end if
    1835. 

  1835.                     else
    1836. 

  1836.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    1837. 

  1837.      +                      call errore('OK or Range error: ', err)
    1838. 

  1838.                     end if
    1839. 

  1839.                     do 9, j = 1, nels
    1840. 

  1840.                         if (inRange3(expect(j),var_type(i),
    1841. 

  1841.      +                               NFT_INT) .and.
    1842. 

  1842.      +                      in_internal_range(NFT_INT, expect(j)))
    1843. 

  1843.      +                          then
    1844. 

  1844.                             val = value(j)
    1845. 

  1845.                             if (.not.equal(val,expect(j),
    1846. 

  1846.      +                                     var_type(i),NFT_INT)) 
    1847. 

  1847.      +                              then
    1848. 

  1848.                                 call error(
    1849. 

  1849.      +                              'value read not that expected')
    1850. 

  1850.                                 if (verbose) then
    1851. 

  1851.                                     call error(' ')
    1852. 

  1852.                                     call errori('varid: ', i)
    1853. 

  1853.                                     call errorc('var_name: ',
    1854. 

  1854.      +                                  var_name(i))
    1855. 

  1855.                                     call errori('element number: %d ', 
    1856. 

  1856.      +                                          j)
    1857. 

  1857.                                     call errord('expect: ', expect(j))
    1858. 

  1858.                                     call errord('got: ', val)
    1859. 

  1859.                                 end if
    1860. 

  1860.                             else
    1861. 

  1861.                                 nok = nok + 1
    1862. 

  1862.                             end if
    1863. 

  1863.                         end if
    1864. 

  1864. 9                   continue
    1865. 

  1865.                 else
    1866. 

  1866.                     if (nels .gt. 0  .and. err .ne. NF_ECHAR)
    1867. 

  1867.      +                  call errore('wrong type: ', err)
    1868. 

  1868.                 end if
    1869. 

  1869. 5           continue
    1870. 

  1870. 1       continue
    1871. 

  1871.         err = nf_close(ncid)
    1872. 

  1872.         if (err .ne. 0)
    1873. 

  1873.      +      call errorc('nf_close: ', nf_strerror(err))
    1874. 

  1874.         call print_nok(nok)
    1875. 

  1875.         end
    1876. 

  1876. 

  1877.         subroutine test_nf_get_vara_real()
    1878. 

  1878.         implicit        none
    1879. 

  1879. #include "tests.inc"
    1880. 

  1880.         integer ncid
    1881. 

  1881.         integer d
    1882. 

  1882.         integer i
    1883. 

  1883.         integer j
    1884. 

  1884.         integer k
    1885. 

  1885.         integer err
    1886. 

  1886.         logical allInExtRange   
    1887. 

  1887.         logical allInIntRange   
    1888. 

  1888.         integer nels
    1889. 

  1889.         integer nslabs
    1890. 

  1890.         integer nok      
    1891. 

  1891.         integer start(MAX_RANK)
    1892. 

  1892.         integer edge(MAX_RANK)
    1893. 

  1893.         integer index(MAX_RANK)
    1894. 

  1894.         integer mid(MAX_RANK)
    1895. 

  1895.         logical canConvert     
    1896. 

  1896.         real    value(MAX_NELS)
    1897. 

  1897.         doubleprecision expect(MAX_NELS)
    1898. 

  1898.         doubleprecision val
    1899. 

  1899.         integer udshift
    1900. 

  1900. 

  1901.         nok = 0
    1902. 

  1902. 

  1903.         err = nf_open(testfile, NF_NOWRITE, ncid)
    1904. 

  1904.         if (err .ne. 0)
    1905. 

  1905.      +      call errore('nf_open: ', err)
    1906. 

  1906.         do 1, i = 1, NVARS
    1907. 

  1907.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    1908. 

  1908.      +                   (NFT_REAL .eq. NFT_TEXT)
    1909. 

  1909.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    1910. 

  1910.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    1911. 

  1911.             do 2, j = 1, var_rank(i)
    1912. 

  1912.                 start(j) = 1
    1913. 

  1913.                 edge(j) = 1
    1914. 

  1914. 2           continue
    1915. 

  1915.             err = nf_get_vara_real(BAD_ID, i, start,
    1916. 

  1916.      +                  edge, value)
    1917. 

  1917.             if (err .ne. NF_EBADID)
    1918. 

  1918.      +          call errore('bad ncid: ', err)
    1919. 

  1919.             err = nf_get_vara_real(ncid, BAD_VARID, start, 
    1920. 

  1920.      +                           edge, value)
    1921. 

  1921.             if (err .ne. NF_ENOTVAR)
    1922. 

  1922.      +          call errore('bad var id: ', err)
    1923. 

  1923.             do 3, j = 1, var_rank(i)
    1924. 

  1924.                 start(j) = var_shape(j,i) + 1
    1925. 

  1925.                 err = nf_get_vara_real(ncid, i, start,
    1926. 

  1926.      +                               edge, value)
    1927. 

  1927.                 if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1928. 

  1928.      +              call errore('bad index: ', err)
    1929. 

  1929.                 start(j) = 1
    1930. 

  1930.                 edge(j) = var_shape(j,i) + 1
    1931. 

  1931.                 err = nf_get_vara_real(ncid, i, start,
    1932. 

  1932.      +                               edge, value)
    1933. 

  1933.                 if (canConvert .and. err .ne. NF_EEDGE)
    1934. 

  1934.      +              call errore('bad edge: ', err)
    1935. 

  1935.                 edge(j) = 1
    1936. 

  1936. 3           continue
    1937. 

  1937. 

  1938. C           /* Check non-scalars for correct error returned even when */
    1939. 

  1939. C           /* there is nothing to get (edge(j).eq.0) */
    1940. 

  1940.             if (var_rank(i) .gt. 0) then
    1941. 

  1941.                 do 10, j = 1, var_rank(i)
    1942. 

  1942.                     edge(j) = 0
    1943. 

  1943. 10              continue
    1944. 

  1944.                 err = nf_get_vara_real(BAD_ID, i, start,
    1945. 

  1945.      +                  edge, value)
    1946. 

  1946.                 if (err .ne. NF_EBADID) 
    1947. 

  1947.      +              call errore('bad ncid: ', err)
    1948. 

  1948.                 err = nf_get_vara_real(ncid, BAD_VARID,
    1949. 

  1949.      +                  start, edge, value)
    1950. 

  1950.                 if (err .ne. NF_ENOTVAR) 
    1951. 

  1951.      +              call errore('bad var id: ', err)
    1952. 

  1952.                 do 11, j = 1, var_rank(i)
    1953. 

  1953.                     if (var_dimid(j,i) .gt. 1) then     !/* skip record dim */
    1954. 

  1954.                         start(j) = var_shape(j,i) + 1
    1955. 

  1955.                         err = nf_get_vara_real(ncid, i,
    1956. 

  1956.      +                          start, edge, value)
    1957. 

  1957.                         if (canConvert .and. err .ne. NF_EINVALCOORDS)
    1958. 

  1958.      +                      call errore('bad start: ', err)
    1959. 

  1959.                         start(j) = 1
    1960. 

  1960.                     endif
    1961. 

  1961. 11              continue
    1962. 

  1962.                 err = nf_get_vara_real(ncid, i, start,
    1963. 

  1963.      +                          edge, value)
    1964. 

  1964.                 if (canConvert) then
    1965. 

  1965.                     if (err .ne. 0) 
    1966. 

  1966.      +                  call error(nf_strerror(err))
    1967. 

  1967.                 else
    1968. 

  1968.                     if (err .ne. NF_ECHAR)
    1969. 

  1969.      +                  call errore('wrong type: ', err)
    1970. 

  1970.                 endif
    1971. 

  1971.                 do 12, j = 1, var_rank(i)
    1972. 

  1972.                     edge(j) = 1
    1973. 

  1973. 12              continue
    1974. 

  1974.             endif
    1975. 

  1975. 

  1976. C           Choose a random point dividing each dim into 2 parts
    1977. 

  1977. C           get 2^rank (nslabs) slabs so defined
    1978. 

  1978.             nslabs = 1
    1979. 

  1979.             do 4, j = 1, var_rank(i)
    1980. 

  1980.                 mid(j) = roll( var_shape(j,i) )
    1981. 

  1981.                 nslabs = nslabs * 2
    1982. 

  1982. 4           continue
    1983. 

  1983. C           bits of k determine whether to get lower or upper part of dim 
    1984. 

  1984.             do 5, k = 1, nslabs
    1985. 

  1985.                 nels = 1
    1986. 

  1986.                 do 6, j = 1, var_rank(i)
    1987. 

  1987.                     if (mod(udshift((k-1), -(j-1)), 2) .eq. 1) then
    1988. 

  1988.                         start(j) = 1
    1989. 

  1989.                         edge(j) = mid(j)
    1990. 

  1990.                     else
    1991. 

  1991.                         start(j) = 1 + mid(j)
    1992. 

  1992.                         edge(j) = var_shape(j,i) - mid(j)
    1993. 

  1993.                     end if
    1994. 

  1994.                     nels = nels * edge(j)
    1995. 

  1995. 6               continue
    1996. 

  1996.                 allInIntRange = .true.
    1997. 

  1997.                 allInExtRange = .true.
    1998. 

  1998.                 do 7, j = 1, nels
    1999. 

  1999.                     err = index2indexes(j, var_rank(i), edge, index)
    2000. 

  2000.                     if (err .ne. 0)
    2001. 

  2001.      +                  call error('error in index2indexes 1')
    2002. 

  2002.                     do 8, d = 1, var_rank(i)
    2003. 

  2003.                         index(d) = index(d) + start(d) - 1
    2004. 

  2004. 8                   continue
    2005. 

  2005.                     expect(j) = hash4(var_type(i), var_rank(i), index, 
    2006. 

  2006.      +                                NFT_REAL)
    2007. 

  2007.                     if (inRange3(expect(j),var_type(i), 
    2008. 

  2008.      +                           NFT_REAL)) then
    2009. 

  2009.                         allInIntRange = 
    2010. 

  2010.      +                      allInIntRange .and.
    2011. 

  2011.      +                      in_internal_range(NFT_REAL, expect(j))
    2012. 

  2012.                     else
    2013. 

  2013.                         allInExtRange = .false.
    2014. 

  2014.                     end if
    2015. 

  2015. 7               continue
    2016. 

  2016.                 err = nf_get_vara_real(ncid, i, start,
    2017. 

  2017.      +                          edge, value)
    2018. 

  2018.                 if (canConvert) then
    2019. 

  2019.                     if (allInExtRange) then
    2020. 

  2020.                         if (allInIntRange) then
    2021. 

  2021.                             if (err .ne. 0)
    2022. 

  2022.      +                          call errore('nf_get_vara_real:', err)
    2023. 

  2023.                         else
    2024. 

  2024.                             if (err .ne. NF_ERANGE)
    2025. 

  2025.      +                          call errore('Range error: ', err)
    2026. 

  2026.                         end if
    2027. 

  2027.                     else
    2028. 

  2028.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    2029. 

  2029.      +                      call errore('OK or Range error: ', err)
    2030. 

  2030.                     end if
    2031. 

  2031.                     do 9, j = 1, nels
    2032. 

  2032.                         if (inRange3(expect(j),var_type(i),
    2033. 

  2033.      +                               NFT_REAL) .and.
    2034. 

  2034.      +                      in_internal_range(NFT_REAL, expect(j)))
    2035. 

  2035.      +                          then
    2036. 

  2036.                             val = value(j)
    2037. 

  2037.                             if (.not.equal(val,expect(j),
    2038. 

  2038.      +                                     var_type(i),NFT_REAL)) 
    2039. 

  2039.      +                              then
    2040. 

  2040.                                 call error(
    2041. 

  2041.      +                              'value read not that expected')
    2042. 

  2042.                                 if (verbose) then
    2043. 

  2043.                                     call error(' ')
    2044. 

  2044.                                     call errori('varid: ', i)
    2045. 

  2045.                                     call errorc('var_name: ',
    2046. 

  2046.      +                                  var_name(i))
    2047. 

  2047.                                     call errori('element number: %d ', 
    2048. 

  2048.      +                                          j)
    2049. 

  2049.                                     call errord('expect: ', expect(j))
    2050. 

  2050.                                     call errord('got: ', val)
    2051. 

  2051.                                 end if
    2052. 

  2052.                             else
    2053. 

  2053.                                 nok = nok + 1
    2054. 

  2054.                             end if
    2055. 

  2055.                         end if
    2056. 

  2056. 9                   continue
    2057. 

  2057.                 else
    2058. 

  2058.                     if (nels .gt. 0  .and. err .ne. NF_ECHAR)
    2059. 

  2059.      +                  call errore('wrong type: ', err)
    2060. 

  2060.                 end if
    2061. 

  2061. 5           continue
    2062. 

  2062. 1       continue
    2063. 

  2063.         err = nf_close(ncid)
    2064. 

  2064.         if (err .ne. 0)
    2065. 

  2065.      +      call errorc('nf_close: ', nf_strerror(err))
    2066. 

  2066.         call print_nok(nok)
    2067. 

  2067.         end
    2068. 

  2068. 

  2069.         subroutine test_nf_get_vara_double()
    2070. 

  2070.         implicit        none
    2071. 

  2071. #include "tests.inc"
    2072. 

  2072.         integer ncid
    2073. 

  2073.         integer d
    2074. 

  2074.         integer i
    2075. 

  2075.         integer j
    2076. 

  2076.         integer k
    2077. 

  2077.         integer err
    2078. 

  2078.         logical allInExtRange   
    2079. 

  2079.         logical allInIntRange   
    2080. 

  2080.         integer nels
    2081. 

  2081.         integer nslabs
    2082. 

  2082.         integer nok      
    2083. 

  2083.         integer start(MAX_RANK)
    2084. 

  2084.         integer edge(MAX_RANK)
    2085. 

  2085.         integer index(MAX_RANK)
    2086. 

  2086.         integer mid(MAX_RANK)
    2087. 

  2087.         logical canConvert     
    2088. 

  2088.         doubleprecision    value(MAX_NELS)
    2089. 

  2089.         doubleprecision expect(MAX_NELS)
    2090. 

  2090.         doubleprecision val
    2091. 

  2091.         integer udshift
    2092. 

  2092. 

  2093.         nok = 0
    2094. 

  2094. 

  2095.         err = nf_open(testfile, NF_NOWRITE, ncid)
    2096. 

  2096.         if (err .ne. 0)
    2097. 

  2097.      +      call errore('nf_open: ', err)
    2098. 

  2098.         do 1, i = 1, NVARS
    2099. 

  2099.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    2100. 

  2100.      +                   (NFT_DOUBLE .eq. NFT_TEXT)
    2101. 

  2101.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    2102. 

  2102.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    2103. 

  2103.             do 2, j = 1, var_rank(i)
    2104. 

  2104.                 start(j) = 1
    2105. 

  2105.                 edge(j) = 1
    2106. 

  2106. 2           continue
    2107. 

  2107.             err = nf_get_vara_double(BAD_ID, i, start,
    2108. 

  2108.      +                  edge, value)
    2109. 

  2109.             if (err .ne. NF_EBADID)
    2110. 

  2110.      +          call errore('bad ncid: ', err)
    2111. 

  2111.             err = nf_get_vara_double(ncid, BAD_VARID, start, 
    2112. 

  2112.      +                           edge, value)
    2113. 

  2113.             if (err .ne. NF_ENOTVAR)
    2114. 

  2114.      +          call errore('bad var id: ', err)
    2115. 

  2115.             do 3, j = 1, var_rank(i)
    2116. 

  2116.                 start(j) = var_shape(j,i) + 1
    2117. 

  2117.                 err = nf_get_vara_double(ncid, i, start,
    2118. 

  2118.      +                               edge, value)
    2119. 

  2119.                 if (canConvert .and. err .ne. NF_EINVALCOORDS)
    2120. 

  2120.      +              call errore('bad index: ', err)
    2121. 

  2121.                 start(j) = 1
    2122. 

  2122.                 edge(j) = var_shape(j,i) + 1
    2123. 

  2123.                 err = nf_get_vara_double(ncid, i, start,
    2124. 

  2124.      +                               edge, value)
    2125. 

  2125.                 if (canConvert .and. err .ne. NF_EEDGE)
    2126. 

  2126.      +              call errore('bad edge: ', err)
    2127. 

  2127.                 edge(j) = 1
    2128. 

  2128. 3           continue
    2129. 

  2129. 

  2130. C           /* Check non-scalars for correct error returned even when */
    2131. 

  2131. C           /* there is nothing to get (edge(j).eq.0) */
    2132. 

  2132.             if (var_rank(i) .gt. 0) then
    2133. 

  2133.                 do 10, j = 1, var_rank(i)
    2134. 

  2134.                     edge(j) = 0
    2135. 

  2135. 10              continue
    2136. 

  2136.                 err = nf_get_vara_double(BAD_ID, i, start,
    2137. 

  2137.      +                  edge, value)
    2138. 

  2138.                 if (err .ne. NF_EBADID) 
    2139. 

  2139.      +              call errore('bad ncid: ', err)
    2140. 

  2140.                 err = nf_get_vara_double(ncid, BAD_VARID,
    2141. 

  2141.      +                  start, edge, value)
    2142. 

  2142.                 if (err .ne. NF_ENOTVAR) 
    2143. 

  2143.      +              call errore('bad var id: ', err)
    2144. 

  2144.                 do 11, j = 1, var_rank(i)
    2145. 

  2145.                     if (var_dimid(j,i) .gt. 1) then     !/* skip record dim */
    2146. 

  2146.                         start(j) = var_shape(j,i) + 1
    2147. 

  2147.                         err = nf_get_vara_double(ncid, i,
    2148. 

  2148.      +                          start, edge, value)
    2149. 

  2149.                         if (canConvert .and. err .ne. NF_EINVALCOORDS)
    2150. 

  2150.      +                      call errore('bad start: ', err)
    2151. 

  2151.                         start(j) = 1
    2152. 

  2152.                     endif
    2153. 

  2153. 11              continue
    2154. 

  2154.                 err = nf_get_vara_double(ncid, i, start,
    2155. 

  2155.      +                          edge, value)
    2156. 

  2156.                 if (canConvert) then
    2157. 

  2157.                     if (err .ne. 0) 
    2158. 

  2158.      +                  call error(nf_strerror(err))
    2159. 

  2159.                 else
    2160. 

  2160.                     if (err .ne. NF_ECHAR)
    2161. 

  2161.      +                  call errore('wrong type: ', err)
    2162. 

  2162.                 endif
    2163. 

  2163.                 do 12, j = 1, var_rank(i)
    2164. 

  2164.                     edge(j) = 1
    2165. 

  2165. 12              continue
    2166. 

  2166.             endif
    2167. 

  2167. 

  2168. C           Choose a random point dividing each dim into 2 parts
    2169. 

  2169. C           get 2^rank (nslabs) slabs so defined
    2170. 

  2170.             nslabs = 1
    2171. 

  2171.             do 4, j = 1, var_rank(i)
    2172. 

  2172.                 mid(j) = roll( var_shape(j,i) )
    2173. 

  2173.                 nslabs = nslabs * 2
    2174. 

  2174. 4           continue
    2175. 

  2175. C           bits of k determine whether to get lower or upper part of dim 
    2176. 

  2176.             do 5, k = 1, nslabs
    2177. 

  2177.                 nels = 1
    2178. 

  2178.                 do 6, j = 1, var_rank(i)
    2179. 

  2179.                     if (mod(udshift((k-1), -(j-1)), 2) .eq. 1) then
    2180. 

  2180.                         start(j) = 1
    2181. 

  2181.                         edge(j) = mid(j)
    2182. 

  2182.                     else
    2183. 

  2183.                         start(j) = 1 + mid(j)
    2184. 

  2184.                         edge(j) = var_shape(j,i) - mid(j)
    2185. 

  2185.                     end if
    2186. 

  2186.                     nels = nels * edge(j)
    2187. 

  2187. 6               continue
    2188. 

  2188.                 allInIntRange = .true.
    2189. 

  2189.                 allInExtRange = .true.
    2190. 

  2190.                 do 7, j = 1, nels
    2191. 

  2191.                     err = index2indexes(j, var_rank(i), edge, index)
    2192. 

  2192.                     if (err .ne. 0)
    2193. 

  2193.      +                  call error('error in index2indexes 1')
    2194. 

  2194.                     do 8, d = 1, var_rank(i)
    2195. 

  2195.                         index(d) = index(d) + start(d) - 1
    2196. 

  2196. 8                   continue
    2197. 

  2197.                     expect(j) = hash4(var_type(i), var_rank(i), index, 
    2198. 

  2198.      +                                NFT_DOUBLE)
    2199. 

  2199.                     if (inRange3(expect(j),var_type(i), 
    2200. 

  2200.      +                           NFT_DOUBLE)) then
    2201. 

  2201.                         allInIntRange = 
    2202. 

  2202.      +                      allInIntRange .and.
    2203. 

  2203.      +                      in_internal_range(NFT_DOUBLE, expect(j))
    2204. 

  2204.                     else
    2205. 

  2205.                         allInExtRange = .false.
    2206. 

  2206.                     end if
    2207. 

  2207. 7               continue
    2208. 

  2208.                 err = nf_get_vara_double(ncid, i, start,
    2209. 

  2209.      +                          edge, value)
    2210. 

  2210.                 if (canConvert) then
    2211. 

  2211.                     if (allInExtRange) then
    2212. 

  2212.                         if (allInIntRange) then
    2213. 

  2213.                             if (err .ne. 0)
    2214. 

  2214.      +                          call errore('nf_get_vara_double:', err)
    2215. 

  2215.                         else
    2216. 

  2216.                             if (err .ne. NF_ERANGE)
    2217. 

  2217.      +                          call errore('Range error: ', err)
    2218. 

  2218.                         end if
    2219. 

  2219.                     else
    2220. 

  2220.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    2221. 

  2221.      +                      call errore('OK or Range error: ', err)
    2222. 

  2222.                     end if
    2223. 

  2223.                     do 9, j = 1, nels
    2224. 

  2224.                         if (inRange3(expect(j),var_type(i),
    2225. 

  2225.      +                               NFT_DOUBLE) .and.
    2226. 

  2226.      +                      in_internal_range(NFT_DOUBLE, expect(j)))
    2227. 

  2227.      +                          then
    2228. 

  2228.                             val = value(j)
    2229. 

  2229.                             if (.not.equal(val,expect(j),
    2230. 

  2230.      +                                     var_type(i),NFT_DOUBLE)) 
    2231. 

  2231.      +                              then
    2232. 

  2232.                                 call error(
    2233. 

  2233.      +                              'value read not that expected')
    2234. 

  2234.                                 if (verbose) then
    2235. 

  2235.                                     call error(' ')
    2236. 

  2236.                                     call errori('varid: ', i)
    2237. 

  2237.                                     call errorc('var_name: ',
    2238. 

  2238.      +                                  var_name(i))
    2239. 

  2239.                                     call errori('element number: %d ', 
    2240. 

  2240.      +                                          j)
    2241. 

  2241.                                     call errord('expect: ', expect(j))
    2242. 

  2242.                                     call errord('got: ', val)
    2243. 

  2243.                                 end if
    2244. 

  2244.                             else
    2245. 

  2245.                                 nok = nok + 1
    2246. 

  2246.                             end if
    2247. 

  2247.                         end if
    2248. 

  2248. 9                   continue
    2249. 

  2249.                 else
    2250. 

  2250.                     if (nels .gt. 0  .and. err .ne. NF_ECHAR)
    2251. 

  2251.      +                  call errore('wrong type: ', err)
    2252. 

  2252.                 end if
    2253. 

  2253. 5           continue
    2254. 

  2254. 1       continue
    2255. 

  2255.         err = nf_close(ncid)
    2256. 

  2256.         if (err .ne. 0)
    2257. 

  2257.      +      call errorc('nf_close: ', nf_strerror(err))
    2258. 

  2258.         call print_nok(nok)
    2259. 

  2259.         end
    2260. 

  2260. 

  2261. 

  2262.         subroutine test_nf_get_vars_text()
    2263. 

  2263.         implicit        none
    2264. 

  2264. #include "tests.inc"
    2265. 

  2265.         integer ncid
    2266. 

  2266.         integer d
    2267. 

  2267.         integer i
    2268. 

  2268.         integer j
    2269. 

  2269.         integer k
    2270. 

  2270.         integer m
    2271. 

  2271.         integer err
    2272. 

  2272.         logical allInExtRange   
    2273. 

  2273.         logical allInIntRange   
    2274. 

  2274.         integer nels
    2275. 

  2275.         integer nslabs
    2276. 

  2276.         integer nstarts         
    2277. 

  2277.         integer nok             
    2278. 

  2278.         integer start(MAX_RANK)
    2279. 

  2279.         integer edge(MAX_RANK)
    2280. 

  2280.         integer index(MAX_RANK)
    2281. 

  2281.         integer index2(MAX_RANK)
    2282. 

  2282.         integer mid(MAX_RANK)
    2283. 

  2283.         integer count(MAX_RANK)
    2284. 

  2284.         integer sstride(MAX_RANK)
    2285. 

  2285.         integer stride(MAX_RANK)
    2286. 

  2286.         logical canConvert     
    2287. 

  2287.         character    value(MAX_NELS)
    2288. 

  2288.         doubleprecision expect(MAX_NELS)
    2289. 

  2289.         doubleprecision val
    2290. 

  2290.         integer udshift
    2291. 

  2291. 

  2292.         nok = 0
    2293. 

  2293. 

  2294.         err = nf_open(testfile, NF_NOWRITE, ncid)
    2295. 

  2295.         if (err .ne. 0)
    2296. 

  2296.      +      call errore('nf_open: ', err)
    2297. 

  2297.         do 1, i = 1, NVARS
    2298. 

  2298.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    2299. 

  2299.      +                   (NFT_TEXT .eq. NFT_TEXT)
    2300. 

  2300.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    2301. 

  2301.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    2302. 

  2302.             do 2, j = 1, var_rank(i)
    2303. 

  2303.                 start(j) = 1
    2304. 

  2304.                 edge(j) = 1
    2305. 

  2305.                 stride(j) = 1
    2306. 

  2306. 2           continue
    2307. 

  2307.             err = nf_get_vars_text(BAD_ID, i, start,
    2308. 

  2308.      +                  edge, stride, value)
    2309. 

  2309.             if (err .ne. NF_EBADID)
    2310. 

  2310.      +          call errore('bad ncid: ', err)
    2311. 

  2311.             err = nf_get_vars_text(ncid, BAD_VARID,
    2312. 

  2312.      +                  start, edge, stride, 
    2313. 

  2313.      +                           value)
    2314. 

  2314.             if (err .ne. NF_ENOTVAR)
    2315. 

  2315.      +          call errore('bad var id: ', err)
    2316. 

  2316.             do 3, j = 1, var_rank(i)
    2317. 

  2317.                 start(j) = var_shape(j,i) + 1
    2318. 

  2318.                 err = nf_get_vars_text(ncid, i, start,
    2319. 

  2319.      +                               edge, stride, 
    2320. 

  2320.      +                               value)
    2321. 

  2321.                 if (.not. canConvert) then
    2322. 

  2322.                     if (err .ne. NF_ECHAR)
    2323. 

  2323.      +                  call errore('conversion: ', err)
    2324. 

  2324.                 else
    2325. 

  2325.                     if (err .ne. NF_EINVALCOORDS)
    2326. 

  2326.      +                  call errore('bad index: ', err)
    2327. 

  2327.                 endif
    2328. 

  2328.                 start(j) = 1
    2329. 

  2329.                 edge(j) = var_shape(j,i) + 1
    2330. 

  2330.                 err = nf_get_vars_text(ncid, i, start,
    2331. 

  2331.      +                               edge, stride, 
    2332. 

  2332.      +                               value)
    2333. 

  2333.                 if (.not. canConvert) then
    2334. 

  2334.                     if (err .ne. NF_ECHAR)
    2335. 

  2335.      +                  call errore('conversion: ', err)
    2336. 

  2336.                 else
    2337. 

  2337.                     if (err .ne. NF_EEDGE)
    2338. 

  2338.      +                  call errore('bad edge: ', err)
    2339. 

  2339.                 endif
    2340. 

  2340.                 edge(j) = 1
    2341. 

  2341.                 stride(j) = 0
    2342. 

  2342.                 err = nf_get_vars_text(ncid, i, start,
    2343. 

  2343.      +                               edge, stride, 
    2344. 

  2344.      +                               value)
    2345. 

  2345.                 if (.not. canConvert) then
    2346. 

  2346.                     if (err .ne. NF_ECHAR)
    2347. 

  2347.      +                  call errore('conversion: ', err)
    2348. 

  2348.                 else
    2349. 

  2349.                     if (err .ne. NF_ESTRIDE)
    2350. 

  2350.      +                  call errore('bad stride: ', err)
    2351. 

  2351.                 endif
    2352. 

  2352.                 stride(j) = 1
    2353. 

  2353. 3           continue
    2354. 

  2354. C               Choose a random point dividing each dim into 2 parts
    2355. 

  2355. C               get 2^rank (nslabs) slabs so defined
    2356. 

  2356.             nslabs = 1
    2357. 

  2357.             do 4, j = 1, var_rank(i)
    2358. 

  2358.                 mid(j) = roll( var_shape(j,i) )
    2359. 

  2359.                 nslabs = nslabs * 2
    2360. 

  2360. 4           continue
    2361. 

  2361. C               bits of k determine whether to get lower or upper part of dim
    2362. 

  2362. C               choose random stride from 1 to edge
    2363. 

  2363.             do 5, k = 1, nslabs
    2364. 

  2364.                 nstarts = 1
    2365. 

  2365.                 do 6, j = 1, var_rank(i)
    2366. 

  2366.                     if (mod(udshift(k-1, j-1), 2) .eq. 1) then
    2367. 

  2367.                         start(j) = 1
    2368. 

  2368.                         edge(j) = mid(j)
    2369. 

  2369.                     else
    2370. 

  2370.                         start(j) = 1 + mid(j)
    2371. 

  2371.                         edge(j) = var_shape(j,i) - mid(j)
    2372. 

  2372.                     end if
    2373. 

  2373.                     if (edge(j) .gt. 0) then
    2374. 

  2374.                         sstride(j) = 1 + roll(edge(j))
    2375. 

  2375.                     else
    2376. 

  2376.                         sstride(j) = 1
    2377. 

  2377.                     end if
    2378. 

  2378.                     nstarts = nstarts * stride(j)
    2379. 

  2379. 6               continue
    2380. 

  2380.                 do 7, m = 1, nstarts
    2381. 

  2381.                     err = index2indexes(m, var_rank(i), sstride, 
    2382. 

  2382.      +                                  index)
    2383. 

  2383.                     if (err .ne. 0)
    2384. 

  2384.      +                  call error('error in index2indexes')
    2385. 

  2385.                     nels = 1
    2386. 

  2386.                     do 8, j = 1, var_rank(i)
    2387. 

  2387.                         count(j) = 1 + (edge(j) - index(j)) / 
    2388. 

  2388.      +                                  stride(j)
    2389. 

  2389.                         nels = nels * count(j)
    2390. 

  2390.                         index(j) = index(j) + start(j) - 1
    2391. 

  2391. 8                   continue
    2392. 

  2392. C                           Random choice of forward or backward 
    2393. 

  2393. C    /* TODO
    2394. 

  2394. C                   if ( roll(2) ) then
    2395. 

  2395. C                       for (j = 0 j < var_rank(i) j++) {
    2396. 

  2396. C                           index(j) += (count(j) - 1) * stride(j)
    2397. 

  2397. C                           stride(j) = -stride(j)
    2398. 

  2398. C                       }
    2399. 

  2399. C                   end if
    2400. 

  2400. C    */
    2401. 

  2401.                     allInIntRange = .true.
    2402. 

  2402.                     allInExtRange = .true.
    2403. 

  2403.                     do 9, j = 1, nels
    2404. 

  2404.                         err = index2indexes(j, var_rank(i), count, 
    2405. 

  2405.      +                                      index2)
    2406. 

  2406.                         if (err .ne. 0)
    2407. 

  2407.      +                      call error('error in index2indexes() 1')
    2408. 

  2408.                         do 10, d = 1, var_rank(i)
    2409. 

  2409.                             index2(d) = index(d) + (index2(d)-1) * 
    2410. 

  2410.      +                                  stride(d)
    2411. 

  2411. 10                      continue
    2412. 

  2412.                         expect(j) = hash4(var_type(i), var_rank(i), 
    2413. 

  2413.      +                                    index2, NFT_TEXT)
    2414. 

  2414.                         if (inRange3(expect(j),var_type(i),
    2415. 

  2415.      +                               NFT_TEXT)) then
    2416. 

  2416.                             allInIntRange = 
    2417. 

  2417.      +                          allInIntRange .and.
    2418. 

  2418.      +                          in_internal_range(NFT_TEXT, 
    2419. 

  2419.      +                                            expect(j))
    2420. 

  2420.                         else
    2421. 

  2421.                             allInExtRange = .false.
    2422. 

  2422.                         end if
    2423. 

  2423. 9                   continue
    2424. 

  2424.                     err = nf_get_vars_text(ncid, i, index,
    2425. 

  2425.      +                                   count, stride,
    2426. 

  2426.      +                                   value)
    2427. 

  2427.                     if (canConvert) then
    2428. 

  2428.                         if (allInExtRange) then
    2429. 

  2429.                             if (allInIntRange) then
    2430. 

  2430.                                 if (err .ne. 0)
    2431. 

  2431.      +                              call error(nf_strerror(err))
    2432. 

  2432.                             else
    2433. 

  2433.                                 if (err .ne. NF_ERANGE)
    2434. 

  2434.      +                              call errore('Range error: ', err)
    2435. 

  2435.                             end if
    2436. 

  2436.                         else
    2437. 

  2437.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    2438. 

  2438.      +                          call errore('OK or Range error: ', err)
    2439. 

  2439.                         end if
    2440. 

  2440.                         do 11, j = 1, nels
    2441. 

  2441.                             if (inRange3(expect(j),var_type(i),
    2442. 

  2442.      +                          NFT_TEXT) .and.
    2443. 

  2443.      +                          in_internal_range(NFT_TEXT, 
    2444. 

  2444.      +                                            expect(j))) then
    2445. 

  2445.                                 val = ichar(value(j))
    2446. 

  2446.                                 if (.not.equal(val, expect(j),
    2447. 

  2447.      +                              var_type(i), NFT_TEXT)) then
    2448. 

  2448.                                     call error(
    2449. 

  2449.      +                                  'value read not that expected')
    2450. 

  2450.                                     if (verbose) then
    2451. 

  2451.                                         call error(' ')
    2452. 

  2452.                                         call errori('varid: ', i)
    2453. 

  2453.                                         call errorc('var_name: ', 
    2454. 

  2454.      +                                              var_name(i))
    2455. 

  2455.                                         call errori('element number: ',
    2456. 

  2456.      +                                              j)
    2457. 

  2457.                                         call errord('expect: ', 
    2458. 

  2458.      +                                              expect(j))
    2459. 

  2459.                                         call errord('got: ', val)
    2460. 

  2460.                                     end if
    2461. 

  2461.                                 else
    2462. 

  2462.                                     nok = nok + 1
    2463. 

  2463.                                 end if
    2464. 

  2464.                             end if
    2465. 

  2465. 11                      continue
    2466. 

  2466.                     else
    2467. 

  2467.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    2468. 

  2468.      +                      call errore('wrong type: ', err)
    2469. 

  2469.                     end if
    2470. 

  2470. 7               continue
    2471. 

  2471. 5           continue
    2472. 

  2472. 

  2473. 1       continue
    2474. 

  2474.         err = nf_close(ncid)
    2475. 

  2475.         if (err .ne. 0)
    2476. 

  2476.      +      call errore('nf_close: ', err)
    2477. 

  2477.         call print_nok(nok)
    2478. 

  2478.         end
    2479. 

  2479. 

  2480. #ifdef NF_INT1_T
    2481. 

  2481.         subroutine test_nf_get_vars_int1()
    2482. 

  2482.         implicit        none
    2483. 

  2483. #include "tests.inc"
    2484. 

  2484.         integer ncid
    2485. 

  2485.         integer d
    2486. 

  2486.         integer i
    2487. 

  2487.         integer j
    2488. 

  2488.         integer k
    2489. 

  2489.         integer m
    2490. 

  2490.         integer err
    2491. 

  2491.         logical allInExtRange   
    2492. 

  2492.         logical allInIntRange   
    2493. 

  2493.         integer nels
    2494. 

  2494.         integer nslabs
    2495. 

  2495.         integer nstarts         
    2496. 

  2496.         integer nok             
    2497. 

  2497.         integer start(MAX_RANK)
    2498. 

  2498.         integer edge(MAX_RANK)
    2499. 

  2499.         integer index(MAX_RANK)
    2500. 

  2500.         integer index2(MAX_RANK)
    2501. 

  2501.         integer mid(MAX_RANK)
    2502. 

  2502.         integer count(MAX_RANK)
    2503. 

  2503.         integer sstride(MAX_RANK)
    2504. 

  2504.         integer stride(MAX_RANK)
    2505. 

  2505.         logical canConvert     
    2506. 

  2506.         NF_INT1_T    value(MAX_NELS)
    2507. 

  2507.         doubleprecision expect(MAX_NELS)
    2508. 

  2508.         doubleprecision val
    2509. 

  2509.         integer udshift
    2510. 

  2510. 

  2511.         nok = 0
    2512. 

  2512. 

  2513.         err = nf_open(testfile, NF_NOWRITE, ncid)
    2514. 

  2514.         if (err .ne. 0)
    2515. 

  2515.      +      call errore('nf_open: ', err)
    2516. 

  2516.         do 1, i = 1, NVARS
    2517. 

  2517.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    2518. 

  2518.      +                   (NFT_INT1 .eq. NFT_TEXT)
    2519. 

  2519.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    2520. 

  2520.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    2521. 

  2521.             do 2, j = 1, var_rank(i)
    2522. 

  2522.                 start(j) = 1
    2523. 

  2523.                 edge(j) = 1
    2524. 

  2524.                 stride(j) = 1
    2525. 

  2525. 2           continue
    2526. 

  2526.             err = nf_get_vars_int1(BAD_ID, i, start,
    2527. 

  2527.      +                  edge, stride, value)
    2528. 

  2528.             if (err .ne. NF_EBADID)
    2529. 

  2529.      +          call errore('bad ncid: ', err)
    2530. 

  2530.             err = nf_get_vars_int1(ncid, BAD_VARID,
    2531. 

  2531.      +                  start, edge, stride, 
    2532. 

  2532.      +                           value)
    2533. 

  2533.             if (err .ne. NF_ENOTVAR)
    2534. 

  2534.      +          call errore('bad var id: ', err)
    2535. 

  2535.             do 3, j = 1, var_rank(i)
    2536. 

  2536.                 start(j) = var_shape(j,i) + 1
    2537. 

  2537.                 err = nf_get_vars_int1(ncid, i, start,
    2538. 

  2538.      +                               edge, stride, 
    2539. 

  2539.      +                               value)
    2540. 

  2540.                 if (.not. canConvert) then
    2541. 

  2541.                     if (err .ne. NF_ECHAR)
    2542. 

  2542.      +                  call errore('conversion: ', err)
    2543. 

  2543.                 else
    2544. 

  2544.                     if (err .ne. NF_EINVALCOORDS)
    2545. 

  2545.      +                  call errore('bad index: ', err)
    2546. 

  2546.                 endif
    2547. 

  2547.                 start(j) = 1
    2548. 

  2548.                 edge(j) = var_shape(j,i) + 1
    2549. 

  2549.                 err = nf_get_vars_int1(ncid, i, start,
    2550. 

  2550.      +                               edge, stride, 
    2551. 

  2551.      +                               value)
    2552. 

  2552.                 if (.not. canConvert) then
    2553. 

  2553.                     if (err .ne. NF_ECHAR)
    2554. 

  2554.      +                  call errore('conversion: ', err)
    2555. 

  2555.                 else
    2556. 

  2556.                     if (err .ne. NF_EEDGE)
    2557. 

  2557.      +                  call errore('bad edge: ', err)
    2558. 

  2558.                 endif
    2559. 

  2559.                 edge(j) = 1
    2560. 

  2560.                 stride(j) = 0
    2561. 

  2561.                 err = nf_get_vars_int1(ncid, i, start,
    2562. 

  2562.      +                               edge, stride, 
    2563. 

  2563.      +                               value)
    2564. 

  2564.                 if (.not. canConvert) then
    2565. 

  2565.                     if (err .ne. NF_ECHAR)
    2566. 

  2566.      +                  call errore('conversion: ', err)
    2567. 

  2567.                 else
    2568. 

  2568.                     if (err .ne. NF_ESTRIDE)
    2569. 

  2569.      +                  call errore('bad stride: ', err)
    2570. 

  2570.                 endif
    2571. 

  2571.                 stride(j) = 1
    2572. 

  2572. 3           continue
    2573. 

  2573. C               Choose a random point dividing each dim into 2 parts
    2574. 

  2574. C               get 2^rank (nslabs) slabs so defined
    2575. 

  2575.             nslabs = 1
    2576. 

  2576.             do 4, j = 1, var_rank(i)
    2577. 

  2577.                 mid(j) = roll( var_shape(j,i) )
    2578. 

  2578.                 nslabs = nslabs * 2
    2579. 

  2579. 4           continue
    2580. 

  2580. C               bits of k determine whether to get lower or upper part of dim
    2581. 

  2581. C               choose random stride from 1 to edge
    2582. 

  2582.             do 5, k = 1, nslabs
    2583. 

  2583.                 nstarts = 1
    2584. 

  2584.                 do 6, j = 1, var_rank(i)
    2585. 

  2585.                     if (mod(udshift(k-1, j-1), 2) .eq. 1) then
    2586. 

  2586.                         start(j) = 1
    2587. 

  2587.                         edge(j) = mid(j)
    2588. 

  2588.                     else
    2589. 

  2589.                         start(j) = 1 + mid(j)
    2590. 

  2590.                         edge(j) = var_shape(j,i) - mid(j)
    2591. 

  2591.                     end if
    2592. 

  2592.                     if (edge(j) .gt. 0) then
    2593. 

  2593.                         sstride(j) = 1 + roll(edge(j))
    2594. 

  2594.                     else
    2595. 

  2595.                         sstride(j) = 1
    2596. 

  2596.                     end if
    2597. 

  2597.                     nstarts = nstarts * stride(j)
    2598. 

  2598. 6               continue
    2599. 

  2599.                 do 7, m = 1, nstarts
    2600. 

  2600.                     err = index2indexes(m, var_rank(i), sstride, 
    2601. 

  2601.      +                                  index)
    2602. 

  2602.                     if (err .ne. 0)
    2603. 

  2603.      +                  call error('error in index2indexes')
    2604. 

  2604.                     nels = 1
    2605. 

  2605.                     do 8, j = 1, var_rank(i)
    2606. 

  2606.                         count(j) = 1 + (edge(j) - index(j)) / 
    2607. 

  2607.      +                                  stride(j)
    2608. 

  2608.                         nels = nels * count(j)
    2609. 

  2609.                         index(j) = index(j) + start(j) - 1
    2610. 

  2610. 8                   continue
    2611. 

  2611. C                           Random choice of forward or backward 
    2612. 

  2612. C    /* TODO
    2613. 

  2613. C                   if ( roll(2) ) then
    2614. 

  2614. C                       for (j = 0 j < var_rank(i) j++) {
    2615. 

  2615. C                           index(j) += (count(j) - 1) * stride(j)
    2616. 

  2616. C                           stride(j) = -stride(j)
    2617. 

  2617. C                       }
    2618. 

  2618. C                   end if
    2619. 

  2619. C    */
    2620. 

  2620.                     allInIntRange = .true.
    2621. 

  2621.                     allInExtRange = .true.
    2622. 

  2622.                     do 9, j = 1, nels
    2623. 

  2623.                         err = index2indexes(j, var_rank(i), count, 
    2624. 

  2624.      +                                      index2)
    2625. 

  2625.                         if (err .ne. 0)
    2626. 

  2626.      +                      call error('error in index2indexes() 1')
    2627. 

  2627.                         do 10, d = 1, var_rank(i)
    2628. 

  2628.                             index2(d) = index(d) + (index2(d)-1) * 
    2629. 

  2629.      +                                  stride(d)
    2630. 

  2630. 10                      continue
    2631. 

  2631.                         expect(j) = hash4(var_type(i), var_rank(i), 
    2632. 

  2632.      +                                    index2, NFT_INT1)
    2633. 

  2633.                         if (inRange3(expect(j),var_type(i),
    2634. 

  2634.      +                               NFT_INT1)) then
    2635. 

  2635.                             allInIntRange = 
    2636. 

  2636.      +                          allInIntRange .and.
    2637. 

  2637.      +                          in_internal_range(NFT_INT1, 
    2638. 

  2638.      +                                            expect(j))
    2639. 

  2639.                         else
    2640. 

  2640.                             allInExtRange = .false.
    2641. 

  2641.                         end if
    2642. 

  2642. 9                   continue
    2643. 

  2643.                     err = nf_get_vars_int1(ncid, i, index,
    2644. 

  2644.      +                                   count, stride,
    2645. 

  2645.      +                                   value)
    2646. 

  2646.                     if (canConvert) then
    2647. 

  2647.                         if (allInExtRange) then
    2648. 

  2648.                             if (allInIntRange) then
    2649. 

  2649.                                 if (err .ne. 0)
    2650. 

  2650.      +                              call error(nf_strerror(err))
    2651. 

  2651.                             else
    2652. 

  2652.                                 if (err .ne. NF_ERANGE)
    2653. 

  2653.      +                              call errore('Range error: ', err)
    2654. 

  2654.                             end if
    2655. 

  2655.                         else
    2656. 

  2656.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    2657. 

  2657.      +                          call errore('OK or Range error: ', err)
    2658. 

  2658.                         end if
    2659. 

  2659.                         do 11, j = 1, nels
    2660. 

  2660.                             if (inRange3(expect(j),var_type(i),
    2661. 

  2661.      +                          NFT_INT1) .and.
    2662. 

  2662.      +                          in_internal_range(NFT_INT1, 
    2663. 

  2663.      +                                            expect(j))) then
    2664. 

  2664.                                 val = value(j)
    2665. 

  2665.                                 if (.not.equal(val, expect(j),
    2666. 

  2666.      +                              var_type(i), NFT_INT1)) then
    2667. 

  2667.                                     call error(
    2668. 

  2668.      +                                  'value read not that expected')
    2669. 

  2669.                                     if (verbose) then
    2670. 

  2670.                                         call error(' ')
    2671. 

  2671.                                         call errori('varid: ', i)
    2672. 

  2672.                                         call errorc('var_name: ', 
    2673. 

  2673.      +                                              var_name(i))
    2674. 

  2674.                                         call errori('element number: ',
    2675. 

  2675.      +                                              j)
    2676. 

  2676.                                         call errord('expect: ', 
    2677. 

  2677.      +                                              expect(j))
    2678. 

  2678.                                         call errord('got: ', val)
    2679. 

  2679.                                     end if
    2680. 

  2680.                                 else
    2681. 

  2681.                                     nok = nok + 1
    2682. 

  2682.                                 end if
    2683. 

  2683.                             end if
    2684. 

  2684. 11                      continue
    2685. 

  2685.                     else
    2686. 

  2686.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    2687. 

  2687.      +                      call errore('wrong type: ', err)
    2688. 

  2688.                     end if
    2689. 

  2689. 7               continue
    2690. 

  2690. 5           continue
    2691. 

  2691. 

  2692. 1       continue
    2693. 

  2693.         err = nf_close(ncid)
    2694. 

  2694.         if (err .ne. 0)
    2695. 

  2695.      +      call errore('nf_close: ', err)
    2696. 

  2696.         call print_nok(nok)
    2697. 

  2697.         end
    2698. 

  2698. 

  2699. #endif
    2700. 

  2700. #ifdef NF_INT2_T
    2701. 

  2701.         subroutine test_nf_get_vars_int2()
    2702. 

  2702.         implicit        none
    2703. 

  2703. #include "tests.inc"
    2704. 

  2704.         integer ncid
    2705. 

  2705.         integer d
    2706. 

  2706.         integer i
    2707. 

  2707.         integer j
    2708. 

  2708.         integer k
    2709. 

  2709.         integer m
    2710. 

  2710.         integer err
    2711. 

  2711.         logical allInExtRange   
    2712. 

  2712.         logical allInIntRange   
    2713. 

  2713.         integer nels
    2714. 

  2714.         integer nslabs
    2715. 

  2715.         integer nstarts         
    2716. 

  2716.         integer nok             
    2717. 

  2717.         integer start(MAX_RANK)
    2718. 

  2718.         integer edge(MAX_RANK)
    2719. 

  2719.         integer index(MAX_RANK)
    2720. 

  2720.         integer index2(MAX_RANK)
    2721. 

  2721.         integer mid(MAX_RANK)
    2722. 

  2722.         integer count(MAX_RANK)
    2723. 

  2723.         integer sstride(MAX_RANK)
    2724. 

  2724.         integer stride(MAX_RANK)
    2725. 

  2725.         logical canConvert     
    2726. 

  2726.         NF_INT2_T    value(MAX_NELS)
    2727. 

  2727.         doubleprecision expect(MAX_NELS)
    2728. 

  2728.         doubleprecision val
    2729. 

  2729.         integer udshift
    2730. 

  2730. 

  2731.         nok = 0
    2732. 

  2732. 

  2733.         err = nf_open(testfile, NF_NOWRITE, ncid)
    2734. 

  2734.         if (err .ne. 0)
    2735. 

  2735.      +      call errore('nf_open: ', err)
    2736. 

  2736.         do 1, i = 1, NVARS
    2737. 

  2737.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    2738. 

  2738.      +                   (NFT_INT2 .eq. NFT_TEXT)
    2739. 

  2739.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    2740. 

  2740.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    2741. 

  2741.             do 2, j = 1, var_rank(i)
    2742. 

  2742.                 start(j) = 1
    2743. 

  2743.                 edge(j) = 1
    2744. 

  2744.                 stride(j) = 1
    2745. 

  2745. 2           continue
    2746. 

  2746.             err = nf_get_vars_int2(BAD_ID, i, start,
    2747. 

  2747.      +                  edge, stride, value)
    2748. 

  2748.             if (err .ne. NF_EBADID)
    2749. 

  2749.      +          call errore('bad ncid: ', err)
    2750. 

  2750.             err = nf_get_vars_int2(ncid, BAD_VARID,
    2751. 

  2751.      +                  start, edge, stride, 
    2752. 

  2752.      +                           value)
    2753. 

  2753.             if (err .ne. NF_ENOTVAR)
    2754. 

  2754.      +          call errore('bad var id: ', err)
    2755. 

  2755.             do 3, j = 1, var_rank(i)
    2756. 

  2756.                 start(j) = var_shape(j,i) + 1
    2757. 

  2757.                 err = nf_get_vars_int2(ncid, i, start,
    2758. 

  2758.      +                               edge, stride, 
    2759. 

  2759.      +                               value)
    2760. 

  2760.                 if (.not. canConvert) then
    2761. 

  2761.                     if (err .ne. NF_ECHAR)
    2762. 

  2762.      +                  call errore('conversion: ', err)
    2763. 

  2763.                 else
    2764. 

  2764.                     if (err .ne. NF_EINVALCOORDS)
    2765. 

  2765.      +                  call errore('bad index: ', err)
    2766. 

  2766.                 endif
    2767. 

  2767.                 start(j) = 1
    2768. 

  2768.                 edge(j) = var_shape(j,i) + 1
    2769. 

  2769.                 err = nf_get_vars_int2(ncid, i, start,
    2770. 

  2770.      +                               edge, stride, 
    2771. 

  2771.      +                               value)
    2772. 

  2772.                 if (.not. canConvert) then
    2773. 

  2773.                     if (err .ne. NF_ECHAR)
    2774. 

  2774.      +                  call errore('conversion: ', err)
    2775. 

  2775.                 else
    2776. 

  2776.                     if (err .ne. NF_EEDGE)
    2777. 

  2777.      +                  call errore('bad edge: ', err)
    2778. 

  2778.                 endif
    2779. 

  2779.                 edge(j) = 1
    2780. 

  2780.                 stride(j) = 0
    2781. 

  2781.                 err = nf_get_vars_int2(ncid, i, start,
    2782. 

  2782.      +                               edge, stride, 
    2783. 

  2783.      +                               value)
    2784. 

  2784.                 if (.not. canConvert) then
    2785. 

  2785.                     if (err .ne. NF_ECHAR)
    2786. 

  2786.      +                  call errore('conversion: ', err)
    2787. 

  2787.                 else
    2788. 

  2788.                     if (err .ne. NF_ESTRIDE)
    2789. 

  2789.      +                  call errore('bad stride: ', err)
    2790. 

  2790.                 endif
    2791. 

  2791.                 stride(j) = 1
    2792. 

  2792. 3           continue
    2793. 

  2793. C               Choose a random point dividing each dim into 2 parts
    2794. 

  2794. C               get 2^rank (nslabs) slabs so defined
    2795. 

  2795.             nslabs = 1
    2796. 

  2796.             do 4, j = 1, var_rank(i)
    2797. 

  2797.                 mid(j) = roll( var_shape(j,i) )
    2798. 

  2798.                 nslabs = nslabs * 2
    2799. 

  2799. 4           continue
    2800. 

  2800. C               bits of k determine whether to get lower or upper part of dim
    2801. 

  2801. C               choose random stride from 1 to edge
    2802. 

  2802.             do 5, k = 1, nslabs
    2803. 

  2803.                 nstarts = 1
    2804. 

  2804.                 do 6, j = 1, var_rank(i)
    2805. 

  2805.                     if (mod(udshift(k-1, j-1), 2) .eq. 1) then
    2806. 

  2806.                         start(j) = 1
    2807. 

  2807.                         edge(j) = mid(j)
    2808. 

  2808.                     else
    2809. 

  2809.                         start(j) = 1 + mid(j)
    2810. 

  2810.                         edge(j) = var_shape(j,i) - mid(j)
    2811. 

  2811.                     end if
    2812. 

  2812.                     if (edge(j) .gt. 0) then
    2813. 

  2813.                         sstride(j) = 1 + roll(edge(j))
    2814. 

  2814.                     else
    2815. 

  2815.                         sstride(j) = 1
    2816. 

  2816.                     end if
    2817. 

  2817.                     nstarts = nstarts * stride(j)
    2818. 

  2818. 6               continue
    2819. 

  2819.                 do 7, m = 1, nstarts
    2820. 

  2820.                     err = index2indexes(m, var_rank(i), sstride, 
    2821. 

  2821.      +                                  index)
    2822. 

  2822.                     if (err .ne. 0)
    2823. 

  2823.      +                  call error('error in index2indexes')
    2824. 

  2824.                     nels = 1
    2825. 

  2825.                     do 8, j = 1, var_rank(i)
    2826. 

  2826.                         count(j) = 1 + (edge(j) - index(j)) / 
    2827. 

  2827.      +                                  stride(j)
    2828. 

  2828.                         nels = nels * count(j)
    2829. 

  2829.                         index(j) = index(j) + start(j) - 1
    2830. 

  2830. 8                   continue
    2831. 

  2831. C                           Random choice of forward or backward 
    2832. 

  2832. C    /* TODO
    2833. 

  2833. C                   if ( roll(2) ) then
    2834. 

  2834. C                       for (j = 0 j < var_rank(i) j++) {
    2835. 

  2835. C                           index(j) += (count(j) - 1) * stride(j)
    2836. 

  2836. C                           stride(j) = -stride(j)
    2837. 

  2837. C                       }
    2838. 

  2838. C                   end if
    2839. 

  2839. C    */
    2840. 

  2840.                     allInIntRange = .true.
    2841. 

  2841.                     allInExtRange = .true.
    2842. 

  2842.                     do 9, j = 1, nels
    2843. 

  2843.                         err = index2indexes(j, var_rank(i), count, 
    2844. 

  2844.      +                                      index2)
    2845. 

  2845.                         if (err .ne. 0)
    2846. 

  2846.      +                      call error('error in index2indexes() 1')
    2847. 

  2847.                         do 10, d = 1, var_rank(i)
    2848. 

  2848.                             index2(d) = index(d) + (index2(d)-1) * 
    2849. 

  2849.      +                                  stride(d)
    2850. 

  2850. 10                      continue
    2851. 

  2851.                         expect(j) = hash4(var_type(i), var_rank(i), 
    2852. 

  2852.      +                                    index2, NFT_INT2)
    2853. 

  2853.                         if (inRange3(expect(j),var_type(i),
    2854. 

  2854.      +                               NFT_INT2)) then
    2855. 

  2855.                             allInIntRange = 
    2856. 

  2856.      +                          allInIntRange .and.
    2857. 

  2857.      +                          in_internal_range(NFT_INT2, 
    2858. 

  2858.      +                                            expect(j))
    2859. 

  2859.                         else
    2860. 

  2860.                             allInExtRange = .false.
    2861. 

  2861.                         end if
    2862. 

  2862. 9                   continue
    2863. 

  2863.                     err = nf_get_vars_int2(ncid, i, index,
    2864. 

  2864.      +                                   count, stride,
    2865. 

  2865.      +                                   value)
    2866. 

  2866.                     if (canConvert) then
    2867. 

  2867.                         if (allInExtRange) then
    2868. 

  2868.                             if (allInIntRange) then
    2869. 

  2869.                                 if (err .ne. 0)
    2870. 

  2870.      +                              call error(nf_strerror(err))
    2871. 

  2871.                             else
    2872. 

  2872.                                 if (err .ne. NF_ERANGE)
    2873. 

  2873.      +                              call errore('Range error: ', err)
    2874. 

  2874.                             end if
    2875. 

  2875.                         else
    2876. 

  2876.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    2877. 

  2877.      +                          call errore('OK or Range error: ', err)
    2878. 

  2878.                         end if
    2879. 

  2879.                         do 11, j = 1, nels
    2880. 

  2880.                             if (inRange3(expect(j),var_type(i),
    2881. 

  2881.      +                          NFT_INT2) .and.
    2882. 

  2882.      +                          in_internal_range(NFT_INT2, 
    2883. 

  2883.      +                                            expect(j))) then
    2884. 

  2884.                                 val = value(j)
    2885. 

  2885.                                 if (.not.equal(val, expect(j),
    2886. 

  2886.      +                              var_type(i), NFT_INT2)) then
    2887. 

  2887.                                     call error(
    2888. 

  2888.      +                                  'value read not that expected')
    2889. 

  2889.                                     if (verbose) then
    2890. 

  2890.                                         call error(' ')
    2891. 

  2891.                                         call errori('varid: ', i)
    2892. 

  2892.                                         call errorc('var_name: ', 
    2893. 

  2893.      +                                              var_name(i))
    2894. 

  2894.                                         call errori('element number: ',
    2895. 

  2895.      +                                              j)
    2896. 

  2896.                                         call errord('expect: ', 
    2897. 

  2897.      +                                              expect(j))
    2898. 

  2898.                                         call errord('got: ', val)
    2899. 

  2899.                                     end if
    2900. 

  2900.                                 else
    2901. 

  2901.                                     nok = nok + 1
    2902. 

  2902.                                 end if
    2903. 

  2903.                             end if
    2904. 

  2904. 11                      continue
    2905. 

  2905.                     else
    2906. 

  2906.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    2907. 

  2907.      +                      call errore('wrong type: ', err)
    2908. 

  2908.                     end if
    2909. 

  2909. 7               continue
    2910. 

  2910. 5           continue
    2911. 

  2911. 

  2912. 1       continue
    2913. 

  2913.         err = nf_close(ncid)
    2914. 

  2914.         if (err .ne. 0)
    2915. 

  2915.      +      call errore('nf_close: ', err)
    2916. 

  2916.         call print_nok(nok)
    2917. 

  2917.         end
    2918. 

  2918. 

  2919. #endif
    2920. 

  2920.         subroutine test_nf_get_vars_int()
    2921. 

  2921.         implicit        none
    2922. 

  2922. #include "tests.inc"
    2923. 

  2923.         integer ncid
    2924. 

  2924.         integer d
    2925. 

  2925.         integer i
    2926. 

  2926.         integer j
    2927. 

  2927.         integer k
    2928. 

  2928.         integer m
    2929. 

  2929.         integer err
    2930. 

  2930.         logical allInExtRange   
    2931. 

  2931.         logical allInIntRange   
    2932. 

  2932.         integer nels
    2933. 

  2933.         integer nslabs
    2934. 

  2934.         integer nstarts         
    2935. 

  2935.         integer nok             
    2936. 

  2936.         integer start(MAX_RANK)
    2937. 

  2937.         integer edge(MAX_RANK)
    2938. 

  2938.         integer index(MAX_RANK)
    2939. 

  2939.         integer index2(MAX_RANK)
    2940. 

  2940.         integer mid(MAX_RANK)
    2941. 

  2941.         integer count(MAX_RANK)
    2942. 

  2942.         integer sstride(MAX_RANK)
    2943. 

  2943.         integer stride(MAX_RANK)
    2944. 

  2944.         logical canConvert     
    2945. 

  2945.         integer    value(MAX_NELS)
    2946. 

  2946.         doubleprecision expect(MAX_NELS)
    2947. 

  2947.         doubleprecision val
    2948. 

  2948.         integer udshift
    2949. 

  2949. 

  2950.         nok = 0
    2951. 

  2951. 

  2952.         err = nf_open(testfile, NF_NOWRITE, ncid)
    2953. 

  2953.         if (err .ne. 0)
    2954. 

  2954.      +      call errore('nf_open: ', err)
    2955. 

  2955.         do 1, i = 1, NVARS
    2956. 

  2956.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    2957. 

  2957.      +                   (NFT_INT .eq. NFT_TEXT)
    2958. 

  2958.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    2959. 

  2959.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    2960. 

  2960.             do 2, j = 1, var_rank(i)
    2961. 

  2961.                 start(j) = 1
    2962. 

  2962.                 edge(j) = 1
    2963. 

  2963.                 stride(j) = 1
    2964. 

  2964. 2           continue
    2965. 

  2965.             err = nf_get_vars_int(BAD_ID, i, start,
    2966. 

  2966.      +                  edge, stride, value)
    2967. 

  2967.             if (err .ne. NF_EBADID)
    2968. 

  2968.      +          call errore('bad ncid: ', err)
    2969. 

  2969.             err = nf_get_vars_int(ncid, BAD_VARID,
    2970. 

  2970.      +                  start, edge, stride, 
    2971. 

  2971.      +                           value)
    2972. 

  2972.             if (err .ne. NF_ENOTVAR)
    2973. 

  2973.      +          call errore('bad var id: ', err)
    2974. 

  2974.             do 3, j = 1, var_rank(i)
    2975. 

  2975.                 start(j) = var_shape(j,i) + 1
    2976. 

  2976.                 err = nf_get_vars_int(ncid, i, start,
    2977. 

  2977.      +                               edge, stride, 
    2978. 

  2978.      +                               value)
    2979. 

  2979.                 if (.not. canConvert) then
    2980. 

  2980.                     if (err .ne. NF_ECHAR)
    2981. 

  2981.      +                  call errore('conversion: ', err)
    2982. 

  2982.                 else
    2983. 

  2983.                     if (err .ne. NF_EINVALCOORDS)
    2984. 

  2984.      +                  call errore('bad index: ', err)
    2985. 

  2985.                 endif
    2986. 

  2986.                 start(j) = 1
    2987. 

  2987.                 edge(j) = var_shape(j,i) + 1
    2988. 

  2988.                 err = nf_get_vars_int(ncid, i, start,
    2989. 

  2989.      +                               edge, stride, 
    2990. 

  2990.      +                               value)
    2991. 

  2991.                 if (.not. canConvert) then
    2992. 

  2992.                     if (err .ne. NF_ECHAR)
    2993. 

  2993.      +                  call errore('conversion: ', err)
    2994. 

  2994.                 else
    2995. 

  2995.                     if (err .ne. NF_EEDGE)
    2996. 

  2996.      +                  call errore('bad edge: ', err)
    2997. 

  2997.                 endif
    2998. 

  2998.                 edge(j) = 1
    2999. 

  2999.                 stride(j) = 0
    3000. 

  3000.                 err = nf_get_vars_int(ncid, i, start,
    3001. 

  3001.      +                               edge, stride, 
    3002. 

  3002.      +                               value)
    3003. 

  3003.                 if (.not. canConvert) then
    3004. 

  3004.                     if (err .ne. NF_ECHAR)
    3005. 

  3005.      +                  call errore('conversion: ', err)
    3006. 

  3006.                 else
    3007. 

  3007.                     if (err .ne. NF_ESTRIDE)
    3008. 

  3008.      +                  call errore('bad stride: ', err)
    3009. 

  3009.                 endif
    3010. 

  3010.                 stride(j) = 1
    3011. 

  3011. 3           continue
    3012. 

  3012. C               Choose a random point dividing each dim into 2 parts
    3013. 

  3013. C               get 2^rank (nslabs) slabs so defined
    3014. 

  3014.             nslabs = 1
    3015. 

  3015.             do 4, j = 1, var_rank(i)
    3016. 

  3016.                 mid(j) = roll( var_shape(j,i) )
    3017. 

  3017.                 nslabs = nslabs * 2
    3018. 

  3018. 4           continue
    3019. 

  3019. C               bits of k determine whether to get lower or upper part of dim
    3020. 

  3020. C               choose random stride from 1 to edge
    3021. 

  3021.             do 5, k = 1, nslabs
    3022. 

  3022.                 nstarts = 1
    3023. 

  3023.                 do 6, j = 1, var_rank(i)
    3024. 

  3024.                     if (mod(udshift(k-1, j-1), 2) .eq. 1) then
    3025. 

  3025.                         start(j) = 1
    3026. 

  3026.                         edge(j) = mid(j)
    3027. 

  3027.                     else
    3028. 

  3028.                         start(j) = 1 + mid(j)
    3029. 

  3029.                         edge(j) = var_shape(j,i) - mid(j)
    3030. 

  3030.                     end if
    3031. 

  3031.                     if (edge(j) .gt. 0) then
    3032. 

  3032.                         sstride(j) = 1 + roll(edge(j))
    3033. 

  3033.                     else
    3034. 

  3034.                         sstride(j) = 1
    3035. 

  3035.                     end if
    3036. 

  3036.                     nstarts = nstarts * stride(j)
    3037. 

  3037. 6               continue
    3038. 

  3038.                 do 7, m = 1, nstarts
    3039. 

  3039.                     err = index2indexes(m, var_rank(i), sstride, 
    3040. 

  3040.      +                                  index)
    3041. 

  3041.                     if (err .ne. 0)
    3042. 

  3042.      +                  call error('error in index2indexes')
    3043. 

  3043.                     nels = 1
    3044. 

  3044.                     do 8, j = 1, var_rank(i)
    3045. 

  3045.                         count(j) = 1 + (edge(j) - index(j)) / 
    3046. 

  3046.      +                                  stride(j)
    3047. 

  3047.                         nels = nels * count(j)
    3048. 

  3048.                         index(j) = index(j) + start(j) - 1
    3049. 

  3049. 8                   continue
    3050. 

  3050. C                           Random choice of forward or backward 
    3051. 

  3051. C    /* TODO
    3052. 

  3052. C                   if ( roll(2) ) then
    3053. 

  3053. C                       for (j = 0 j < var_rank(i) j++) {
    3054. 

  3054. C                           index(j) += (count(j) - 1) * stride(j)
    3055. 

  3055. C                           stride(j) = -stride(j)
    3056. 

  3056. C                       }
    3057. 

  3057. C                   end if
    3058. 

  3058. C    */
    3059. 

  3059.                     allInIntRange = .true.
    3060. 

  3060.                     allInExtRange = .true.
    3061. 

  3061.                     do 9, j = 1, nels
    3062. 

  3062.                         err = index2indexes(j, var_rank(i), count, 
    3063. 

  3063.      +                                      index2)
    3064. 

  3064.                         if (err .ne. 0)
    3065. 

  3065.      +                      call error('error in index2indexes() 1')
    3066. 

  3066.                         do 10, d = 1, var_rank(i)
    3067. 

  3067.                             index2(d) = index(d) + (index2(d)-1) * 
    3068. 

  3068.      +                                  stride(d)
    3069. 

  3069. 10                      continue
    3070. 

  3070.                         expect(j) = hash4(var_type(i), var_rank(i), 
    3071. 

  3071.      +                                    index2, NFT_INT)
    3072. 

  3072.                         if (inRange3(expect(j),var_type(i),
    3073. 

  3073.      +                               NFT_INT)) then
    3074. 

  3074.                             allInIntRange = 
    3075. 

  3075.      +                          allInIntRange .and.
    3076. 

  3076.      +                          in_internal_range(NFT_INT, 
    3077. 

  3077.      +                                            expect(j))
    3078. 

  3078.                         else
    3079. 

  3079.                             allInExtRange = .false.
    3080. 

  3080.                         end if
    3081. 

  3081. 9                   continue
    3082. 

  3082.                     err = nf_get_vars_int(ncid, i, index,
    3083. 

  3083.      +                                   count, stride,
    3084. 

  3084.      +                                   value)
    3085. 

  3085.                     if (canConvert) then
    3086. 

  3086.                         if (allInExtRange) then
    3087. 

  3087.                             if (allInIntRange) then
    3088. 

  3088.                                 if (err .ne. 0)
    3089. 

  3089.      +                              call error(nf_strerror(err))
    3090. 

  3090.                             else
    3091. 

  3091.                                 if (err .ne. NF_ERANGE)
    3092. 

  3092.      +                              call errore('Range error: ', err)
    3093. 

  3093.                             end if
    3094. 

  3094.                         else
    3095. 

  3095.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    3096. 

  3096.      +                          call errore('OK or Range error: ', err)
    3097. 

  3097.                         end if
    3098. 

  3098.                         do 11, j = 1, nels
    3099. 

  3099.                             if (inRange3(expect(j),var_type(i),
    3100. 

  3100.      +                          NFT_INT) .and.
    3101. 

  3101.      +                          in_internal_range(NFT_INT, 
    3102. 

  3102.      +                                            expect(j))) then
    3103. 

  3103.                                 val = value(j)
    3104. 

  3104.                                 if (.not.equal(val, expect(j),
    3105. 

  3105.      +                              var_type(i), NFT_INT)) then
    3106. 

  3106.                                     call error(
    3107. 

  3107.      +                                  'value read not that expected')
    3108. 

  3108.                                     if (verbose) then
    3109. 

  3109.                                         call error(' ')
    3110. 

  3110.                                         call errori('varid: ', i)
    3111. 

  3111.                                         call errorc('var_name: ', 
    3112. 

  3112.      +                                              var_name(i))
    3113. 

  3113.                                         call errori('element number: ',
    3114. 

  3114.      +                                              j)
    3115. 

  3115.                                         call errord('expect: ', 
    3116. 

  3116.      +                                              expect(j))
    3117. 

  3117.                                         call errord('got: ', val)
    3118. 

  3118.                                     end if
    3119. 

  3119.                                 else
    3120. 

  3120.                                     nok = nok + 1
    3121. 

  3121.                                 end if
    3122. 

  3122.                             end if
    3123. 

  3123. 11                      continue
    3124. 

  3124.                     else
    3125. 

  3125.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    3126. 

  3126.      +                      call errore('wrong type: ', err)
    3127. 

  3127.                     end if
    3128. 

  3128. 7               continue
    3129. 

  3129. 5           continue
    3130. 

  3130. 

  3131. 1       continue
    3132. 

  3132.         err = nf_close(ncid)
    3133. 

  3133.         if (err .ne. 0)
    3134. 

  3134.      +      call errore('nf_close: ', err)
    3135. 

  3135.         call print_nok(nok)
    3136. 

  3136.         end
    3137. 

  3137. 

  3138.         subroutine test_nf_get_vars_real()
    3139. 

  3139.         implicit        none
    3140. 

  3140. #include "tests.inc"
    3141. 

  3141.         integer ncid
    3142. 

  3142.         integer d
    3143. 

  3143.         integer i
    3144. 

  3144.         integer j
    3145. 

  3145.         integer k
    3146. 

  3146.         integer m
    3147. 

  3147.         integer err
    3148. 

  3148.         logical allInExtRange   
    3149. 

  3149.         logical allInIntRange   
    3150. 

  3150.         integer nels
    3151. 

  3151.         integer nslabs
    3152. 

  3152.         integer nstarts         
    3153. 

  3153.         integer nok             
    3154. 

  3154.         integer start(MAX_RANK)
    3155. 

  3155.         integer edge(MAX_RANK)
    3156. 

  3156.         integer index(MAX_RANK)
    3157. 

  3157.         integer index2(MAX_RANK)
    3158. 

  3158.         integer mid(MAX_RANK)
    3159. 

  3159.         integer count(MAX_RANK)
    3160. 

  3160.         integer sstride(MAX_RANK)
    3161. 

  3161.         integer stride(MAX_RANK)
    3162. 

  3162.         logical canConvert     
    3163. 

  3163.         real    value(MAX_NELS)
    3164. 

  3164.         doubleprecision expect(MAX_NELS)
    3165. 

  3165.         doubleprecision val
    3166. 

  3166.         integer udshift
    3167. 

  3167. 

  3168.         nok = 0
    3169. 

  3169. 

  3170.         err = nf_open(testfile, NF_NOWRITE, ncid)
    3171. 

  3171.         if (err .ne. 0)
    3172. 

  3172.      +      call errore('nf_open: ', err)
    3173. 

  3173.         do 1, i = 1, NVARS
    3174. 

  3174.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    3175. 

  3175.      +                   (NFT_REAL .eq. NFT_TEXT)
    3176. 

  3176.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    3177. 

  3177.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    3178. 

  3178.             do 2, j = 1, var_rank(i)
    3179. 

  3179.                 start(j) = 1
    3180. 

  3180.                 edge(j) = 1
    3181. 

  3181.                 stride(j) = 1
    3182. 

  3182. 2           continue
    3183. 

  3183.             err = nf_get_vars_real(BAD_ID, i, start,
    3184. 

  3184.      +                  edge, stride, value)
    3185. 

  3185.             if (err .ne. NF_EBADID)
    3186. 

  3186.      +          call errore('bad ncid: ', err)
    3187. 

  3187.             err = nf_get_vars_real(ncid, BAD_VARID,
    3188. 

  3188.      +                  start, edge, stride, 
    3189. 

  3189.      +                           value)
    3190. 

  3190.             if (err .ne. NF_ENOTVAR)
    3191. 

  3191.      +          call errore('bad var id: ', err)
    3192. 

  3192.             do 3, j = 1, var_rank(i)
    3193. 

  3193.                 start(j) = var_shape(j,i) + 1
    3194. 

  3194.                 err = nf_get_vars_real(ncid, i, start,
    3195. 

  3195.      +                               edge, stride, 
    3196. 

  3196.      +                               value)
    3197. 

  3197.                 if (.not. canConvert) then
    3198. 

  3198.                     if (err .ne. NF_ECHAR)
    3199. 

  3199.      +                  call errore('conversion: ', err)
    3200. 

  3200.                 else
    3201. 

  3201.                     if (err .ne. NF_EINVALCOORDS)
    3202. 

  3202.      +                  call errore('bad index: ', err)
    3203. 

  3203.                 endif
    3204. 

  3204.                 start(j) = 1
    3205. 

  3205.                 edge(j) = var_shape(j,i) + 1
    3206. 

  3206.                 err = nf_get_vars_real(ncid, i, start,
    3207. 

  3207.      +                               edge, stride, 
    3208. 

  3208.      +                               value)
    3209. 

  3209.                 if (.not. canConvert) then
    3210. 

  3210.                     if (err .ne. NF_ECHAR)
    3211. 

  3211.      +                  call errore('conversion: ', err)
    3212. 

  3212.                 else
    3213. 

  3213.                     if (err .ne. NF_EEDGE)
    3214. 

  3214.      +                  call errore('bad edge: ', err)
    3215. 

  3215.                 endif
    3216. 

  3216.                 edge(j) = 1
    3217. 

  3217.                 stride(j) = 0
    3218. 

  3218.                 err = nf_get_vars_real(ncid, i, start,
    3219. 

  3219.      +                               edge, stride, 
    3220. 

  3220.      +                               value)
    3221. 

  3221.                 if (.not. canConvert) then
    3222. 

  3222.                     if (err .ne. NF_ECHAR)
    3223. 

  3223.      +                  call errore('conversion: ', err)
    3224. 

  3224.                 else
    3225. 

  3225.                     if (err .ne. NF_ESTRIDE)
    3226. 

  3226.      +                  call errore('bad stride: ', err)
    3227. 

  3227.                 endif
    3228. 

  3228.                 stride(j) = 1
    3229. 

  3229. 3           continue
    3230. 

  3230. C               Choose a random point dividing each dim into 2 parts
    3231. 

  3231. C               get 2^rank (nslabs) slabs so defined
    3232. 

  3232.             nslabs = 1
    3233. 

  3233.             do 4, j = 1, var_rank(i)
    3234. 

  3234.                 mid(j) = roll( var_shape(j,i) )
    3235. 

  3235.                 nslabs = nslabs * 2
    3236. 

  3236. 4           continue
    3237. 

  3237. C               bits of k determine whether to get lower or upper part of dim
    3238. 

  3238. C               choose random stride from 1 to edge
    3239. 

  3239.             do 5, k = 1, nslabs
    3240. 

  3240.                 nstarts = 1
    3241. 

  3241.                 do 6, j = 1, var_rank(i)
    3242. 

  3242.                     if (mod(udshift(k-1, j-1), 2) .eq. 1) then
    3243. 

  3243.                         start(j) = 1
    3244. 

  3244.                         edge(j) = mid(j)
    3245. 

  3245.                     else
    3246. 

  3246.                         start(j) = 1 + mid(j)
    3247. 

  3247.                         edge(j) = var_shape(j,i) - mid(j)
    3248. 

  3248.                     end if
    3249. 

  3249.                     if (edge(j) .gt. 0) then
    3250. 

  3250.                         sstride(j) = 1 + roll(edge(j))
    3251. 

  3251.                     else
    3252. 

  3252.                         sstride(j) = 1
    3253. 

  3253.                     end if
    3254. 

  3254.                     nstarts = nstarts * stride(j)
    3255. 

  3255. 6               continue
    3256. 

  3256.                 do 7, m = 1, nstarts
    3257. 

  3257.                     err = index2indexes(m, var_rank(i), sstride, 
    3258. 

  3258.      +                                  index)
    3259. 

  3259.                     if (err .ne. 0)
    3260. 

  3260.      +                  call error('error in index2indexes')
    3261. 

  3261.                     nels = 1
    3262. 

  3262.                     do 8, j = 1, var_rank(i)
    3263. 

  3263.                         count(j) = 1 + (edge(j) - index(j)) / 
    3264. 

  3264.      +                                  stride(j)
    3265. 

  3265.                         nels = nels * count(j)
    3266. 

  3266.                         index(j) = index(j) + start(j) - 1
    3267. 

  3267. 8                   continue
    3268. 

  3268. C                           Random choice of forward or backward 
    3269. 

  3269. C    /* TODO
    3270. 

  3270. C                   if ( roll(2) ) then
    3271. 

  3271. C                       for (j = 0 j < var_rank(i) j++) {
    3272. 

  3272. C                           index(j) += (count(j) - 1) * stride(j)
    3273. 

  3273. C                           stride(j) = -stride(j)
    3274. 

  3274. C                       }
    3275. 

  3275. C                   end if
    3276. 

  3276. C    */
    3277. 

  3277.                     allInIntRange = .true.
    3278. 

  3278.                     allInExtRange = .true.
    3279. 

  3279.                     do 9, j = 1, nels
    3280. 

  3280.                         err = index2indexes(j, var_rank(i), count, 
    3281. 

  3281.      +                                      index2)
    3282. 

  3282.                         if (err .ne. 0)
    3283. 

  3283.      +                      call error('error in index2indexes() 1')
    3284. 

  3284.                         do 10, d = 1, var_rank(i)
    3285. 

  3285.                             index2(d) = index(d) + (index2(d)-1) * 
    3286. 

  3286.      +                                  stride(d)
    3287. 

  3287. 10                      continue
    3288. 

  3288.                         expect(j) = hash4(var_type(i), var_rank(i), 
    3289. 

  3289.      +                                    index2, NFT_REAL)
    3290. 

  3290.                         if (inRange3(expect(j),var_type(i),
    3291. 

  3291.      +                               NFT_REAL)) then
    3292. 

  3292.                             allInIntRange = 
    3293. 

  3293.      +                          allInIntRange .and.
    3294. 

  3294.      +                          in_internal_range(NFT_REAL, 
    3295. 

  3295.      +                                            expect(j))
    3296. 

  3296.                         else
    3297. 

  3297.                             allInExtRange = .false.
    3298. 

  3298.                         end if
    3299. 

  3299. 9                   continue
    3300. 

  3300.                     err = nf_get_vars_real(ncid, i, index,
    3301. 

  3301.      +                                   count, stride,
    3302. 

  3302.      +                                   value)
    3303. 

  3303.                     if (canConvert) then
    3304. 

  3304.                         if (allInExtRange) then
    3305. 

  3305.                             if (allInIntRange) then
    3306. 

  3306.                                 if (err .ne. 0)
    3307. 

  3307.      +                              call error(nf_strerror(err))
    3308. 

  3308.                             else
    3309. 

  3309.                                 if (err .ne. NF_ERANGE)
    3310. 

  3310.      +                              call errore('Range error: ', err)
    3311. 

  3311.                             end if
    3312. 

  3312.                         else
    3313. 

  3313.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    3314. 

  3314.      +                          call errore('OK or Range error: ', err)
    3315. 

  3315.                         end if
    3316. 

  3316.                         do 11, j = 1, nels
    3317. 

  3317.                             if (inRange3(expect(j),var_type(i),
    3318. 

  3318.      +                          NFT_REAL) .and.
    3319. 

  3319.      +                          in_internal_range(NFT_REAL, 
    3320. 

  3320.      +                                            expect(j))) then
    3321. 

  3321.                                 val = value(j)
    3322. 

  3322.                                 if (.not.equal(val, expect(j),
    3323. 

  3323.      +                              var_type(i), NFT_REAL)) then
    3324. 

  3324.                                     call error(
    3325. 

  3325.      +                                  'value read not that expected')
    3326. 

  3326.                                     if (verbose) then
    3327. 

  3327.                                         call error(' ')
    3328. 

  3328.                                         call errori('varid: ', i)
    3329. 

  3329.                                         call errorc('var_name: ', 
    3330. 

  3330.      +                                              var_name(i))
    3331. 

  3331.                                         call errori('element number: ',
    3332. 

  3332.      +                                              j)
    3333. 

  3333.                                         call errord('expect: ', 
    3334. 

  3334.      +                                              expect(j))
    3335. 

  3335.                                         call errord('got: ', val)
    3336. 

  3336.                                     end if
    3337. 

  3337.                                 else
    3338. 

  3338.                                     nok = nok + 1
    3339. 

  3339.                                 end if
    3340. 

  3340.                             end if
    3341. 

  3341. 11                      continue
    3342. 

  3342.                     else
    3343. 

  3343.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    3344. 

  3344.      +                      call errore('wrong type: ', err)
    3345. 

  3345.                     end if
    3346. 

  3346. 7               continue
    3347. 

  3347. 5           continue
    3348. 

  3348. 

  3349. 1       continue
    3350. 

  3350.         err = nf_close(ncid)
    3351. 

  3351.         if (err .ne. 0)
    3352. 

  3352.      +      call errore('nf_close: ', err)
    3353. 

  3353.         call print_nok(nok)
    3354. 

  3354.         end
    3355. 

  3355. 

  3356.         subroutine test_nf_get_vars_double()
    3357. 

  3357.         implicit        none
    3358. 

  3358. #include "tests.inc"
    3359. 

  3359.         integer ncid
    3360. 

  3360.         integer d
    3361. 

  3361.         integer i
    3362. 

  3362.         integer j
    3363. 

  3363.         integer k
    3364. 

  3364.         integer m
    3365. 

  3365.         integer err
    3366. 

  3366.         logical allInExtRange   
    3367. 

  3367.         logical allInIntRange   
    3368. 

  3368.         integer nels
    3369. 

  3369.         integer nslabs
    3370. 

  3370.         integer nstarts         
    3371. 

  3371.         integer nok             
    3372. 

  3372.         integer start(MAX_RANK)
    3373. 

  3373.         integer edge(MAX_RANK)
    3374. 

  3374.         integer index(MAX_RANK)
    3375. 

  3375.         integer index2(MAX_RANK)
    3376. 

  3376.         integer mid(MAX_RANK)
    3377. 

  3377.         integer count(MAX_RANK)
    3378. 

  3378.         integer sstride(MAX_RANK)
    3379. 

  3379.         integer stride(MAX_RANK)
    3380. 

  3380.         logical canConvert     
    3381. 

  3381.         doubleprecision    value(MAX_NELS)
    3382. 

  3382.         doubleprecision expect(MAX_NELS)
    3383. 

  3383.         doubleprecision val
    3384. 

  3384.         integer udshift
    3385. 

  3385. 

  3386.         nok = 0
    3387. 

  3387. 

  3388.         err = nf_open(testfile, NF_NOWRITE, ncid)
    3389. 

  3389.         if (err .ne. 0)
    3390. 

  3390.      +      call errore('nf_open: ', err)
    3391. 

  3391.         do 1, i = 1, NVARS
    3392. 

  3392.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    3393. 

  3393.      +                   (NFT_DOUBLE .eq. NFT_TEXT)
    3394. 

  3394.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assert'
    3395. 

  3395.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assert'
    3396. 

  3396.             do 2, j = 1, var_rank(i)
    3397. 

  3397.                 start(j) = 1
    3398. 

  3398.                 edge(j) = 1
    3399. 

  3399.                 stride(j) = 1
    3400. 

  3400. 2           continue
    3401. 

  3401.             err = nf_get_vars_double(BAD_ID, i, start,
    3402. 

  3402.      +                  edge, stride, value)
    3403. 

  3403.             if (err .ne. NF_EBADID)
    3404. 

  3404.      +          call errore('bad ncid: ', err)
    3405. 

  3405.             err = nf_get_vars_double(ncid, BAD_VARID,
    3406. 

  3406.      +                  start, edge, stride, 
    3407. 

  3407.      +                           value)
    3408. 

  3408.             if (err .ne. NF_ENOTVAR)
    3409. 

  3409.      +          call errore('bad var id: ', err)
    3410. 

  3410.             do 3, j = 1, var_rank(i)
    3411. 

  3411.                 start(j) = var_shape(j,i) + 1
    3412. 

  3412.                 err = nf_get_vars_double(ncid, i, start,
    3413. 

  3413.      +                               edge, stride, 
    3414. 

  3414.      +                               value)
    3415. 

  3415.                 if (.not. canConvert) then
    3416. 

  3416.                     if (err .ne. NF_ECHAR)
    3417. 

  3417.      +                  call errore('conversion: ', err)
    3418. 

  3418.                 else
    3419. 

  3419.                     if (err .ne. NF_EINVALCOORDS)
    3420. 

  3420.      +                  call errore('bad index: ', err)
    3421. 

  3421.                 endif
    3422. 

  3422.                 start(j) = 1
    3423. 

  3423.                 edge(j) = var_shape(j,i) + 1
    3424. 

  3424.                 err = nf_get_vars_double(ncid, i, start,
    3425. 

  3425.      +                               edge, stride, 
    3426. 

  3426.      +                               value)
    3427. 

  3427.                 if (.not. canConvert) then
    3428. 

  3428.                     if (err .ne. NF_ECHAR)
    3429. 

  3429.      +                  call errore('conversion: ', err)
    3430. 

  3430.                 else
    3431. 

  3431.                     if (err .ne. NF_EEDGE)
    3432. 

  3432.      +                  call errore('bad edge: ', err)
    3433. 

  3433.                 endif
    3434. 

  3434.                 edge(j) = 1
    3435. 

  3435.                 stride(j) = 0
    3436. 

  3436.                 err = nf_get_vars_double(ncid, i, start,
    3437. 

  3437.      +                               edge, stride, 
    3438. 

  3438.      +                               value)
    3439. 

  3439.                 if (.not. canConvert) then
    3440. 

  3440.                     if (err .ne. NF_ECHAR)
    3441. 

  3441.      +                  call errore('conversion: ', err)
    3442. 

  3442.                 else
    3443. 

  3443.                     if (err .ne. NF_ESTRIDE)
    3444. 

  3444.      +                  call errore('bad stride: ', err)
    3445. 

  3445.                 endif
    3446. 

  3446.                 stride(j) = 1
    3447. 

  3447. 3           continue
    3448. 

  3448. C               Choose a random point dividing each dim into 2 parts
    3449. 

  3449. C               get 2^rank (nslabs) slabs so defined
    3450. 

  3450.             nslabs = 1
    3451. 

  3451.             do 4, j = 1, var_rank(i)
    3452. 

  3452.                 mid(j) = roll( var_shape(j,i) )
    3453. 

  3453.                 nslabs = nslabs * 2
    3454. 

  3454. 4           continue
    3455. 

  3455. C               bits of k determine whether to get lower or upper part of dim
    3456. 

  3456. C               choose random stride from 1 to edge
    3457. 

  3457.             do 5, k = 1, nslabs
    3458. 

  3458.                 nstarts = 1
    3459. 

  3459.                 do 6, j = 1, var_rank(i)
    3460. 

  3460.                     if (mod(udshift(k-1, j-1), 2) .eq. 1) then
    3461. 

  3461.                         start(j) = 1
    3462. 

  3462.                         edge(j) = mid(j)
    3463. 

  3463.                     else
    3464. 

  3464.                         start(j) = 1 + mid(j)
    3465. 

  3465.                         edge(j) = var_shape(j,i) - mid(j)
    3466. 

  3466.                     end if
    3467. 

  3467.                     if (edge(j) .gt. 0) then
    3468. 

  3468.                         sstride(j) = 1 + roll(edge(j))
    3469. 

  3469.                     else
    3470. 

  3470.                         sstride(j) = 1
    3471. 

  3471.                     end if
    3472. 

  3472.                     nstarts = nstarts * stride(j)
    3473. 

  3473. 6               continue
    3474. 

  3474.                 do 7, m = 1, nstarts
    3475. 

  3475.                     err = index2indexes(m, var_rank(i), sstride, 
    3476. 

  3476.      +                                  index)
    3477. 

  3477.                     if (err .ne. 0)
    3478. 

  3478.      +                  call error('error in index2indexes')
    3479. 

  3479.                     nels = 1
    3480. 

  3480.                     do 8, j = 1, var_rank(i)
    3481. 

  3481.                         count(j) = 1 + (edge(j) - index(j)) / 
    3482. 

  3482.      +                                  stride(j)
    3483. 

  3483.                         nels = nels * count(j)
    3484. 

  3484.                         index(j) = index(j) + start(j) - 1
    3485. 

  3485. 8                   continue
    3486. 

  3486. C                           Random choice of forward or backward 
    3487. 

  3487. C    /* TODO
    3488. 

  3488. C                   if ( roll(2) ) then
    3489. 

  3489. C                       for (j = 0 j < var_rank(i) j++) {
    3490. 

  3490. C                           index(j) += (count(j) - 1) * stride(j)
    3491. 

  3491. C                           stride(j) = -stride(j)
    3492. 

  3492. C                       }
    3493. 

  3493. C                   end if
    3494. 

  3494. C    */
    3495. 

  3495.                     allInIntRange = .true.
    3496. 

  3496.                     allInExtRange = .true.
    3497. 

  3497.                     do 9, j = 1, nels
    3498. 

  3498.                         err = index2indexes(j, var_rank(i), count, 
    3499. 

  3499.      +                                      index2)
    3500. 

  3500.                         if (err .ne. 0)
    3501. 

  3501.      +                      call error('error in index2indexes() 1')
    3502. 

  3502.                         do 10, d = 1, var_rank(i)
    3503. 

  3503.                             index2(d) = index(d) + (index2(d)-1) * 
    3504. 

  3504.      +                                  stride(d)
    3505. 

  3505. 10                      continue
    3506. 

  3506.                         expect(j) = hash4(var_type(i), var_rank(i), 
    3507. 

  3507.      +                                    index2, NFT_DOUBLE)
    3508. 

  3508.                         if (inRange3(expect(j),var_type(i),
    3509. 

  3509.      +                               NFT_DOUBLE)) then
    3510. 

  3510.                             allInIntRange = 
    3511. 

  3511.      +                          allInIntRange .and.
    3512. 

  3512.      +                          in_internal_range(NFT_DOUBLE, 
    3513. 

  3513.      +                                            expect(j))
    3514. 

  3514.                         else
    3515. 

  3515.                             allInExtRange = .false.
    3516. 

  3516.                         end if
    3517. 

  3517. 9                   continue
    3518. 

  3518.                     err = nf_get_vars_double(ncid, i, index,
    3519. 

  3519.      +                                   count, stride,
    3520. 

  3520.      +                                   value)
    3521. 

  3521.                     if (canConvert) then
    3522. 

  3522.                         if (allInExtRange) then
    3523. 

  3523.                             if (allInIntRange) then
    3524. 

  3524.                                 if (err .ne. 0)
    3525. 

  3525.      +                              call error(nf_strerror(err))
    3526. 

  3526.                             else
    3527. 

  3527.                                 if (err .ne. NF_ERANGE)
    3528. 

  3528.      +                              call errore('Range error: ', err)
    3529. 

  3529.                             end if
    3530. 

  3530.                         else
    3531. 

  3531.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    3532. 

  3532.      +                          call errore('OK or Range error: ', err)
    3533. 

  3533.                         end if
    3534. 

  3534.                         do 11, j = 1, nels
    3535. 

  3535.                             if (inRange3(expect(j),var_type(i),
    3536. 

  3536.      +                          NFT_DOUBLE) .and.
    3537. 

  3537.      +                          in_internal_range(NFT_DOUBLE, 
    3538. 

  3538.      +                                            expect(j))) then
    3539. 

  3539.                                 val = value(j)
    3540. 

  3540.                                 if (.not.equal(val, expect(j),
    3541. 

  3541.      +                              var_type(i), NFT_DOUBLE)) then
    3542. 

  3542.                                     call error(
    3543. 

  3543.      +                                  'value read not that expected')
    3544. 

  3544.                                     if (verbose) then
    3545. 

  3545.                                         call error(' ')
    3546. 

  3546.                                         call errori('varid: ', i)
    3547. 

  3547.                                         call errorc('var_name: ', 
    3548. 

  3548.      +                                              var_name(i))
    3549. 

  3549.                                         call errori('element number: ',
    3550. 

  3550.      +                                              j)
    3551. 

  3551.                                         call errord('expect: ', 
    3552. 

  3552.      +                                              expect(j))
    3553. 

  3553.                                         call errord('got: ', val)
    3554. 

  3554.                                     end if
    3555. 

  3555.                                 else
    3556. 

  3556.                                     nok = nok + 1
    3557. 

  3557.                                 end if
    3558. 

  3558.                             end if
    3559. 

  3559. 11                      continue
    3560. 

  3560.                     else
    3561. 

  3561.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    3562. 

  3562.      +                      call errore('wrong type: ', err)
    3563. 

  3563.                     end if
    3564. 

  3564. 7               continue
    3565. 

  3565. 5           continue
    3566. 

  3566. 

  3567. 1       continue
    3568. 

  3568.         err = nf_close(ncid)
    3569. 

  3569.         if (err .ne. 0)
    3570. 

  3570.      +      call errore('nf_close: ', err)
    3571. 

  3571.         call print_nok(nok)
    3572. 

  3572.         end
    3573. 

  3573. 

  3574. 

  3575.         subroutine test_nf_get_varm_text()
    3576. 

  3576.         implicit        none
    3577. 

  3577. #include "tests.inc"
    3578. 

  3578.         integer ncid
    3579. 

  3579.         integer d
    3580. 

  3580.         integer i
    3581. 

  3581.         integer j
    3582. 

  3582.         integer k
    3583. 

  3583.         integer m
    3584. 

  3584.         integer err
    3585. 

  3585.         logical allInExtRange   
    3586. 

  3586.         logical allInIntRange   
    3587. 

  3587.         integer nels
    3588. 

  3588.         integer nslabs
    3589. 

  3589.         integer nstarts         
    3590. 

  3590.         integer nok             
    3591. 

  3591.         integer start(MAX_RANK)
    3592. 

  3592.         integer edge(MAX_RANK)
    3593. 

  3593.         integer index(MAX_RANK)
    3594. 

  3594.         integer index2(MAX_RANK)
    3595. 

  3595.         integer mid(MAX_RANK)
    3596. 

  3596.         integer count(MAX_RANK)
    3597. 

  3597.         integer sstride(MAX_RANK)
    3598. 

  3598.         integer stride(MAX_RANK)
    3599. 

  3599.         integer imap(MAX_RANK)
    3600. 

  3600.         logical canConvert     
    3601. 

  3601.         character    value(MAX_NELS)
    3602. 

  3602.         doubleprecision expect(MAX_NELS)
    3603. 

  3603.         doubleprecision val
    3604. 

  3604.         integer udshift
    3605. 

  3605. 

  3606.         nok = 0
    3607. 

  3607. 

  3608.         err = nf_open(testfile, NF_NOWRITE, ncid)
    3609. 

  3609.         if (err .ne. 0)
    3610. 

  3610.      +      call errore('nf_open: ', err)
    3611. 

  3611.         do 1, i = 1, NVARS
    3612. 

  3612.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    3613. 

  3613.      +                   (NFT_TEXT .eq. NFT_TEXT)
    3614. 

  3614.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assertion'
    3615. 

  3615.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assertion'
    3616. 

  3616.             do 2, j = 1, var_rank(i)
    3617. 

  3617.                 start(j) = 1
    3618. 

  3618.                 edge(j) = 1
    3619. 

  3619.                 stride(j) = 1
    3620. 

  3620.                 imap(j) = 1
    3621. 

  3621. 2           continue
    3622. 

  3622.             err = nf_get_varm_text(BAD_ID, i, start, edge,
    3623. 

  3623.      +                           stride, imap, 
    3624. 

  3624.      +                           value)
    3625. 

  3625.             if (err .ne. NF_EBADID)
    3626. 

  3626.      +          call errore('bad ncid: ', err)
    3627. 

  3627.             err = nf_get_varm_text(ncid, BAD_VARID, start,
    3628. 

  3628.      +                           edge, stride, 
    3629. 

  3629.      +                           imap, value)
    3630. 

  3630.             if (err .ne. NF_ENOTVAR)
    3631. 

  3631.      +          call errore('bad var id: ', err)
    3632. 

  3632.             do 3, j = 1, var_rank(i)
    3633. 

  3633.                 start(j) = var_shape(j,i) + 1
    3634. 

  3634.                 err = nf_get_varm_text(ncid, i, start,
    3635. 

  3635.      +                               edge, stride, 
    3636. 

  3636.      +                               imap, value)
    3637. 

  3637.                 if (.not. canConvert) then
    3638. 

  3638.                     if (err .ne. NF_ECHAR)
    3639. 

  3639.      +                  call errore('conversion: ', err)
    3640. 

  3640.                 else
    3641. 

  3641.                     if (err .ne. NF_EINVALCOORDS)
    3642. 

  3642.      +                  call errore('bad index: ', err)
    3643. 

  3643.                 endif
    3644. 

  3644.                 start(j) = 1
    3645. 

  3645.                 edge(j) = var_shape(j,i) + 1
    3646. 

  3646.                 err = nf_get_varm_text(ncid, i, start,
    3647. 

  3647.      +                               edge, stride, 
    3648. 

  3648.      +                               imap, value)
    3649. 

  3649.                 if (.not. canConvert) then
    3650. 

  3650.                     if (err .ne. NF_ECHAR)
    3651. 

  3651.      +                  call errore('conversion: ', err)
    3652. 

  3652.                 else
    3653. 

  3653.                     if (err .ne. NF_EEDGE)
    3654. 

  3654.      +                  call errore('bad edge: ', err)
    3655. 

  3655.                 endif
    3656. 

  3656.                 edge(j) = 1
    3657. 

  3657.                 stride(j) = 0
    3658. 

  3658.                 err = nf_get_varm_text(ncid, i, start,
    3659. 

  3659.      +                               edge, stride, 
    3660. 

  3660.      +                               imap, value)
    3661. 

  3661.                 if (.not. canConvert) then
    3662. 

  3662.                     if (err .ne. NF_ECHAR)
    3663. 

  3663.      +                  call errore('conversion: ', err)
    3664. 

  3664.                 else
    3665. 

  3665.                     if (err .ne. NF_ESTRIDE)
    3666. 

  3666.      +                  call errore('bad stride: ', err)
    3667. 

  3667.                 endif
    3668. 

  3668.                 stride(j) = 1
    3669. 

  3669. 3           continue
    3670. 

  3670. C               Choose a random point dividing each dim into 2 parts 
    3671. 

  3671. C               get 2^rank (nslabs) slabs so defined 
    3672. 

  3672.             nslabs = 1
    3673. 

  3673.             do 4, j = 1, var_rank(i)
    3674. 

  3674.                 mid(j) = roll( var_shape(j,i) )
    3675. 

  3675.                 nslabs = nslabs * 2
    3676. 

  3676. 4           continue
    3677. 

  3677. C               /* bits of k determine whether to get lower or upper part 
    3678. 

  3678. C                * of dim
    3679. 

  3679. C                * choose random stride from 1 to edge */
    3680. 

  3680.             do 5, k = 1, nslabs
    3681. 

  3681.                 nstarts = 1
    3682. 

  3682.                 do 6, j = 1, var_rank(i)
    3683. 

  3683.                     if (mod(udshift((k-1), -(j-1)), 2) .ne. 0) then
    3684. 

  3684.                         start(j) = 1
    3685. 

  3685.                         edge(j) = mid(j)
    3686. 

  3686.                     else
    3687. 

  3687.                         start(j) = 1 + mid(j)
    3688. 

  3688.                         edge(j) = var_shape(j,i) - mid(j)
    3689. 

  3689.                     end if
    3690. 

  3690.                     if (edge(j) .gt. 0) then
    3691. 

  3691.                         stride(j) = 1+roll(edge(j))
    3692. 

  3692.                     else
    3693. 

  3693.                         stride(j) = 1
    3694. 

  3694.                     end if
    3695. 

  3695.                     sstride(j) = stride(j)
    3696. 

  3696.                     nstarts = nstarts * stride(j)
    3697. 

  3697. 6               continue
    3698. 

  3698.                 do 7, m = 1, nstarts
    3699. 

  3699.                     err = index2indexes(m, var_rank(i), sstride, index)
    3700. 

  3700.                     if (err .ne. 0)
    3701. 

  3701.      +                  call error('error in index2indexes')
    3702. 

  3702.                     nels = 1
    3703. 

  3703.                     do 8, j = 1, var_rank(i)
    3704. 

  3704.                         count(j) = 1 + (edge(j) - index(j)) / 
    3705. 

  3705.      +                                  stride(j)
    3706. 

  3706.                         nels = nels * count(j)
    3707. 

  3707.                         index(j) = index(j) + start(j) - 1
    3708. 

  3708. 8                   continue
    3709. 

  3709. C                       Random choice of forward or backward 
    3710. 

  3710. C    /* TODO
    3711. 

  3711. C                   if ( roll(2) ) then
    3712. 

  3712. C                       for (j = 0 j < var_rank(i) j++) {
    3713. 

  3713. C                           index(j) += (count(j) - 1) * stride(j)
    3714. 

  3714. C                           stride(j) = -stride(j)
    3715. 

  3715. C                       }
    3716. 

  3716. C                   end if
    3717. 

  3717. C     */
    3718. 

  3718.                     if (var_rank(i) .gt. 0) then
    3719. 

  3719.                         imap(1) = 1
    3720. 

  3720.                         do 9, j = 2, var_rank(i)
    3721. 

  3721.                             imap(j) = imap(j-1) * count(j-1)
    3722. 

  3722. 9                       continue
    3723. 

  3723.                     end if
    3724. 

  3724.                     allInIntRange = .true.
    3725. 

  3725.                     allInExtRange = .true.
    3726. 

  3726.                     do 10, j = 1, nels
    3727. 

  3727.                         err = index2indexes(j, var_rank(i), count, 
    3728. 

  3728.      +                                      index2)
    3729. 

  3729.                         if (err .ne. 0)
    3730. 

  3730.      +                      call error('error in index2indexes 1')
    3731. 

  3731.                         do 11, d = 1, var_rank(i)
    3732. 

  3732.                             index2(d) = index(d) + (index2(d)-1) * 
    3733. 

  3733.      +                                  stride(d)
    3734. 

  3734. 11                      continue
    3735. 

  3735.                         expect(j) = hash4(var_type(i), var_rank(i), 
    3736. 

  3736.      +                                    index2, NFT_TEXT)
    3737. 

  3737.                         if (inRange3(expect(j),var_type(i),
    3738. 

  3738.      +                               NFT_TEXT)) then
    3739. 

  3739.                             allInIntRange = 
    3740. 

  3740.      +                          allInIntRange .and.
    3741. 

  3741.      +                          in_internal_range(NFT_TEXT,
    3742. 

  3742.      +                                            expect(j))
    3743. 

  3743.                         else
    3744. 

  3744.                             allInExtRange = .false.
    3745. 

  3745.                         end if
    3746. 

  3746. 10                  continue
    3747. 

  3747.                     err = nf_get_varm_text(ncid,i,index,count,
    3748. 

  3748.      +                                   stride,imap,
    3749. 

  3749.      +                                   value)
    3750. 

  3750.                     if (canConvert) then
    3751. 

  3751.                         if (allInExtRange) then
    3752. 

  3752.                             if (allInIntRange) then
    3753. 

  3753.                                 if (err .ne. 0)
    3754. 

  3754.      +                              call error(nf_strerror(err))
    3755. 

  3755.                             else
    3756. 

  3756.                                 if (err .ne. NF_ERANGE)
    3757. 

  3757.      +                              call errore('Range error: ', err)
    3758. 

  3758.                             end if
    3759. 

  3759.                         else
    3760. 

  3760.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    3761. 

  3761.      +                          call errore('OK or Range error: ', err)
    3762. 

  3762.                         end if
    3763. 

  3763.                         do 12, j = 1, nels
    3764. 

  3764.                             if (inRange3(expect(j),var_type(i),
    3765. 

  3765.      +                                   NFT_TEXT) .and.
    3766. 

  3766.      +                          in_internal_range(NFT_TEXT,
    3767. 

  3767.      +                                            expect(j))) then
    3768. 

  3768.                                 val = ichar(value(j))
    3769. 

  3769.                                 if (.not.equal(val, expect(j),
    3770. 

  3770.      +                                         var_type(i), 
    3771. 

  3771.      +                                         NFT_TEXT)) then
    3772. 

  3772.                                     call error(
    3773. 

  3773.      +                                  'value read not that expected')
    3774. 

  3774.                                     if (verbose) then
    3775. 

  3775.                                         call error(' ')
    3776. 

  3776.                                         call errori('varid: ', i)
    3777. 

  3777.                                         call errorc('var_name: ', 
    3778. 

  3778.      +                                          var_name(i))
    3779. 

  3779.                                         call errori('element number: ',
    3780. 

  3780.      +                                              j)
    3781. 

  3781.                                         call errord('expect: ', 
    3782. 

  3782.      +                                              expect(j))
    3783. 

  3783.                                         call errord('got: ', val)
    3784. 

  3784.                                     end if
    3785. 

  3785.                                 else
    3786. 

  3786.                                     nok = nok + 1
    3787. 

  3787.                                 end if
    3788. 

  3788.                             end if
    3789. 

  3789. 12                      continue
    3790. 

  3790.                     else
    3791. 

  3791.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    3792. 

  3792.      +                      call errore('wrong type: ', err)
    3793. 

  3793.                     end if
    3794. 

  3794. 7               continue
    3795. 

  3795. 5           continue
    3796. 

  3796. 1       continue
    3797. 

  3797.         err = nf_close(ncid)
    3798. 

  3798.         if (err .ne. 0)
    3799. 

  3799.      +      call errore('nf_close: ',  err)
    3800. 

  3800.         call print_nok(nok)
    3801. 

  3801.         end
    3802. 

  3802. 

  3803. #ifdef NF_INT1_T
    3804. 

  3804.         subroutine test_nf_get_varm_int1()
    3805. 

  3805.         implicit        none
    3806. 

  3806. #include "tests.inc"
    3807. 

  3807.         integer ncid
    3808. 

  3808.         integer d
    3809. 

  3809.         integer i
    3810. 

  3810.         integer j
    3811. 

  3811.         integer k
    3812. 

  3812.         integer m
    3813. 

  3813.         integer err
    3814. 

  3814.         logical allInExtRange   
    3815. 

  3815.         logical allInIntRange   
    3816. 

  3816.         integer nels
    3817. 

  3817.         integer nslabs
    3818. 

  3818.         integer nstarts         
    3819. 

  3819.         integer nok             
    3820. 

  3820.         integer start(MAX_RANK)
    3821. 

  3821.         integer edge(MAX_RANK)
    3822. 

  3822.         integer index(MAX_RANK)
    3823. 

  3823.         integer index2(MAX_RANK)
    3824. 

  3824.         integer mid(MAX_RANK)
    3825. 

  3825.         integer count(MAX_RANK)
    3826. 

  3826.         integer sstride(MAX_RANK)
    3827. 

  3827.         integer stride(MAX_RANK)
    3828. 

  3828.         integer imap(MAX_RANK)
    3829. 

  3829.         logical canConvert     
    3830. 

  3830.         NF_INT1_T    value(MAX_NELS)
    3831. 

  3831.         doubleprecision expect(MAX_NELS)
    3832. 

  3832.         doubleprecision val
    3833. 

  3833.         integer udshift
    3834. 

  3834. 

  3835.         nok = 0
    3836. 

  3836. 

  3837.         err = nf_open(testfile, NF_NOWRITE, ncid)
    3838. 

  3838.         if (err .ne. 0)
    3839. 

  3839.      +      call errore('nf_open: ', err)
    3840. 

  3840.         do 1, i = 1, NVARS
    3841. 

  3841.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    3842. 

  3842.      +                   (NFT_INT1 .eq. NFT_TEXT)
    3843. 

  3843.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assertion'
    3844. 

  3844.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assertion'
    3845. 

  3845.             do 2, j = 1, var_rank(i)
    3846. 

  3846.                 start(j) = 1
    3847. 

  3847.                 edge(j) = 1
    3848. 

  3848.                 stride(j) = 1
    3849. 

  3849.                 imap(j) = 1
    3850. 

  3850. 2           continue
    3851. 

  3851.             err = nf_get_varm_int1(BAD_ID, i, start, edge,
    3852. 

  3852.      +                           stride, imap, 
    3853. 

  3853.      +                           value)
    3854. 

  3854.             if (err .ne. NF_EBADID)
    3855. 

  3855.      +          call errore('bad ncid: ', err)
    3856. 

  3856.             err = nf_get_varm_int1(ncid, BAD_VARID, start,
    3857. 

  3857.      +                           edge, stride, 
    3858. 

  3858.      +                           imap, value)
    3859. 

  3859.             if (err .ne. NF_ENOTVAR)
    3860. 

  3860.      +          call errore('bad var id: ', err)
    3861. 

  3861.             do 3, j = 1, var_rank(i)
    3862. 

  3862.                 start(j) = var_shape(j,i) + 1
    3863. 

  3863.                 err = nf_get_varm_int1(ncid, i, start,
    3864. 

  3864.      +                               edge, stride, 
    3865. 

  3865.      +                               imap, value)
    3866. 

  3866.                 if (.not. canConvert) then
    3867. 

  3867.                     if (err .ne. NF_ECHAR)
    3868. 

  3868.      +                  call errore('conversion: ', err)
    3869. 

  3869.                 else
    3870. 

  3870.                     if (err .ne. NF_EINVALCOORDS)
    3871. 

  3871.      +                  call errore('bad index: ', err)
    3872. 

  3872.                 endif
    3873. 

  3873.                 start(j) = 1
    3874. 

  3874.                 edge(j) = var_shape(j,i) + 1
    3875. 

  3875.                 err = nf_get_varm_int1(ncid, i, start,
    3876. 

  3876.      +                               edge, stride, 
    3877. 

  3877.      +                               imap, value)
    3878. 

  3878.                 if (.not. canConvert) then
    3879. 

  3879.                     if (err .ne. NF_ECHAR)
    3880. 

  3880.      +                  call errore('conversion: ', err)
    3881. 

  3881.                 else
    3882. 

  3882.                     if (err .ne. NF_EEDGE)
    3883. 

  3883.      +                  call errore('bad edge: ', err)
    3884. 

  3884.                 endif
    3885. 

  3885.                 edge(j) = 1
    3886. 

  3886.                 stride(j) = 0
    3887. 

  3887.                 err = nf_get_varm_int1(ncid, i, start,
    3888. 

  3888.      +                               edge, stride, 
    3889. 

  3889.      +                               imap, value)
    3890. 

  3890.                 if (.not. canConvert) then
    3891. 

  3891.                     if (err .ne. NF_ECHAR)
    3892. 

  3892.      +                  call errore('conversion: ', err)
    3893. 

  3893.                 else
    3894. 

  3894.                     if (err .ne. NF_ESTRIDE)
    3895. 

  3895.      +                  call errore('bad stride: ', err)
    3896. 

  3896.                 endif
    3897. 

  3897.                 stride(j) = 1
    3898. 

  3898. 3           continue
    3899. 

  3899. C               Choose a random point dividing each dim into 2 parts 
    3900. 

  3900. C               get 2^rank (nslabs) slabs so defined 
    3901. 

  3901.             nslabs = 1
    3902. 

  3902.             do 4, j = 1, var_rank(i)
    3903. 

  3903.                 mid(j) = roll( var_shape(j,i) )
    3904. 

  3904.                 nslabs = nslabs * 2
    3905. 

  3905. 4           continue
    3906. 

  3906. C               /* bits of k determine whether to get lower or upper part 
    3907. 

  3907. C                * of dim
    3908. 

  3908. C                * choose random stride from 1 to edge */
    3909. 

  3909.             do 5, k = 1, nslabs
    3910. 

  3910.                 nstarts = 1
    3911. 

  3911.                 do 6, j = 1, var_rank(i)
    3912. 

  3912.                     if (mod(udshift((k-1), -(j-1)), 2) .ne. 0) then
    3913. 

  3913.                         start(j) = 1
    3914. 

  3914.                         edge(j) = mid(j)
    3915. 

  3915.                     else
    3916. 

  3916.                         start(j) = 1 + mid(j)
    3917. 

  3917.                         edge(j) = var_shape(j,i) - mid(j)
    3918. 

  3918.                     end if
    3919. 

  3919.                     if (edge(j) .gt. 0) then
    3920. 

  3920.                         stride(j) = 1+roll(edge(j))
    3921. 

  3921.                     else
    3922. 

  3922.                         stride(j) = 1
    3923. 

  3923.                     end if
    3924. 

  3924.                     sstride(j) = stride(j)
    3925. 

  3925.                     nstarts = nstarts * stride(j)
    3926. 

  3926. 6               continue
    3927. 

  3927.                 do 7, m = 1, nstarts
    3928. 

  3928.                     err = index2indexes(m, var_rank(i), sstride, index)
    3929. 

  3929.                     if (err .ne. 0)
    3930. 

  3930.      +                  call error('error in index2indexes')
    3931. 

  3931.                     nels = 1
    3932. 

  3932.                     do 8, j = 1, var_rank(i)
    3933. 

  3933.                         count(j) = 1 + (edge(j) - index(j)) / 
    3934. 

  3934.      +                                  stride(j)
    3935. 

  3935.                         nels = nels * count(j)
    3936. 

  3936.                         index(j) = index(j) + start(j) - 1
    3937. 

  3937. 8                   continue
    3938. 

  3938. C                       Random choice of forward or backward 
    3939. 

  3939. C    /* TODO
    3940. 

  3940. C                   if ( roll(2) ) then
    3941. 

  3941. C                       for (j = 0 j < var_rank(i) j++) {
    3942. 

  3942. C                           index(j) += (count(j) - 1) * stride(j)
    3943. 

  3943. C                           stride(j) = -stride(j)
    3944. 

  3944. C                       }
    3945. 

  3945. C                   end if
    3946. 

  3946. C     */
    3947. 

  3947.                     if (var_rank(i) .gt. 0) then
    3948. 

  3948.                         imap(1) = 1
    3949. 

  3949.                         do 9, j = 2, var_rank(i)
    3950. 

  3950.                             imap(j) = imap(j-1) * count(j-1)
    3951. 

  3951. 9                       continue
    3952. 

  3952.                     end if
    3953. 

  3953.                     allInIntRange = .true.
    3954. 

  3954.                     allInExtRange = .true.
    3955. 

  3955.                     do 10, j = 1, nels
    3956. 

  3956.                         err = index2indexes(j, var_rank(i), count, 
    3957. 

  3957.      +                                      index2)
    3958. 

  3958.                         if (err .ne. 0)
    3959. 

  3959.      +                      call error('error in index2indexes 1')
    3960. 

  3960.                         do 11, d = 1, var_rank(i)
    3961. 

  3961.                             index2(d) = index(d) + (index2(d)-1) * 
    3962. 

  3962.      +                                  stride(d)
    3963. 

  3963. 11                      continue
    3964. 

  3964.                         expect(j) = hash4(var_type(i), var_rank(i), 
    3965. 

  3965.      +                                    index2, NFT_INT1)
    3966. 

  3966.                         if (inRange3(expect(j),var_type(i),
    3967. 

  3967.      +                               NFT_INT1)) then
    3968. 

  3968.                             allInIntRange = 
    3969. 

  3969.      +                          allInIntRange .and.
    3970. 

  3970.      +                          in_internal_range(NFT_INT1,
    3971. 

  3971.      +                                            expect(j))
    3972. 

  3972.                         else
    3973. 

  3973.                             allInExtRange = .false.
    3974. 

  3974.                         end if
    3975. 

  3975. 10                  continue
    3976. 

  3976.                     err = nf_get_varm_int1(ncid,i,index,count,
    3977. 

  3977.      +                                   stride,imap,
    3978. 

  3978.      +                                   value)
    3979. 

  3979.                     if (canConvert) then
    3980. 

  3980.                         if (allInExtRange) then
    3981. 

  3981.                             if (allInIntRange) then
    3982. 

  3982.                                 if (err .ne. 0)
    3983. 

  3983.      +                              call error(nf_strerror(err))
    3984. 

  3984.                             else
    3985. 

  3985.                                 if (err .ne. NF_ERANGE)
    3986. 

  3986.      +                              call errore('Range error: ', err)
    3987. 

  3987.                             end if
    3988. 

  3988.                         else
    3989. 

  3989.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    3990. 

  3990.      +                          call errore('OK or Range error: ', err)
    3991. 

  3991.                         end if
    3992. 

  3992.                         do 12, j = 1, nels
    3993. 

  3993.                             if (inRange3(expect(j),var_type(i),
    3994. 

  3994.      +                                   NFT_INT1) .and.
    3995. 

  3995.      +                          in_internal_range(NFT_INT1,
    3996. 

  3996.      +                                            expect(j))) then
    3997. 

  3997.                                 val = value(j)
    3998. 

  3998.                                 if (.not.equal(val, expect(j),
    3999. 

  3999.      +                                         var_type(i), 
    4000. 

  4000.      +                                         NFT_INT1)) then
    4001. 

  4001.                                     call error(
    4002. 

  4002.      +                                  'value read not that expected')
    4003. 

  4003.                                     if (verbose) then
    4004. 

  4004.                                         call error(' ')
    4005. 

  4005.                                         call errori('varid: ', i)
    4006. 

  4006.                                         call errorc('var_name: ', 
    4007. 

  4007.      +                                          var_name(i))
    4008. 

  4008.                                         call errori('element number: ',
    4009. 

  4009.      +                                              j)
    4010. 

  4010.                                         call errord('expect: ', 
    4011. 

  4011.      +                                              expect(j))
    4012. 

  4012.                                         call errord('got: ', val)
    4013. 

  4013.                                     end if
    4014. 

  4014.                                 else
    4015. 

  4015.                                     nok = nok + 1
    4016. 

  4016.                                 end if
    4017. 

  4017.                             end if
    4018. 

  4018. 12                      continue
    4019. 

  4019.                     else
    4020. 

  4020.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    4021. 

  4021.      +                      call errore('wrong type: ', err)
    4022. 

  4022.                     end if
    4023. 

  4023. 7               continue
    4024. 

  4024. 5           continue
    4025. 

  4025. 1       continue
    4026. 

  4026.         err = nf_close(ncid)
    4027. 

  4027.         if (err .ne. 0)
    4028. 

  4028.      +      call errore('nf_close: ',  err)
    4029. 

  4029.         call print_nok(nok)
    4030. 

  4030.         end
    4031. 

  4031. 

  4032. #endif
    4033. 

  4033. #ifdef NF_INT2_T
    4034. 

  4034.         subroutine test_nf_get_varm_int2()
    4035. 

  4035.         implicit        none
    4036. 

  4036. #include "tests.inc"
    4037. 

  4037.         integer ncid
    4038. 

  4038.         integer d
    4039. 

  4039.         integer i
    4040. 

  4040.         integer j
    4041. 

  4041.         integer k
    4042. 

  4042.         integer m
    4043. 

  4043.         integer err
    4044. 

  4044.         logical allInExtRange   
    4045. 

  4045.         logical allInIntRange   
    4046. 

  4046.         integer nels
    4047. 

  4047.         integer nslabs
    4048. 

  4048.         integer nstarts         
    4049. 

  4049.         integer nok             
    4050. 

  4050.         integer start(MAX_RANK)
    4051. 

  4051.         integer edge(MAX_RANK)
    4052. 

  4052.         integer index(MAX_RANK)
    4053. 

  4053.         integer index2(MAX_RANK)
    4054. 

  4054.         integer mid(MAX_RANK)
    4055. 

  4055.         integer count(MAX_RANK)
    4056. 

  4056.         integer sstride(MAX_RANK)
    4057. 

  4057.         integer stride(MAX_RANK)
    4058. 

  4058.         integer imap(MAX_RANK)
    4059. 

  4059.         logical canConvert     
    4060. 

  4060.         NF_INT2_T    value(MAX_NELS)
    4061. 

  4061.         doubleprecision expect(MAX_NELS)
    4062. 

  4062.         doubleprecision val
    4063. 

  4063.         integer udshift
    4064. 

  4064. 

  4065.         nok = 0
    4066. 

  4066. 

  4067.         err = nf_open(testfile, NF_NOWRITE, ncid)
    4068. 

  4068.         if (err .ne. 0)
    4069. 

  4069.      +      call errore('nf_open: ', err)
    4070. 

  4070.         do 1, i = 1, NVARS
    4071. 

  4071.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    4072. 

  4072.      +                   (NFT_INT2 .eq. NFT_TEXT)
    4073. 

  4073.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assertion'
    4074. 

  4074.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assertion'
    4075. 

  4075.             do 2, j = 1, var_rank(i)
    4076. 

  4076.                 start(j) = 1
    4077. 

  4077.                 edge(j) = 1
    4078. 

  4078.                 stride(j) = 1
    4079. 

  4079.                 imap(j) = 1
    4080. 

  4080. 2           continue
    4081. 

  4081.             err = nf_get_varm_int2(BAD_ID, i, start, edge,
    4082. 

  4082.      +                           stride, imap, 
    4083. 

  4083.      +                           value)
    4084. 

  4084.             if (err .ne. NF_EBADID)
    4085. 

  4085.      +          call errore('bad ncid: ', err)
    4086. 

  4086.             err = nf_get_varm_int2(ncid, BAD_VARID, start,
    4087. 

  4087.      +                           edge, stride, 
    4088. 

  4088.      +                           imap, value)
    4089. 

  4089.             if (err .ne. NF_ENOTVAR)
    4090. 

  4090.      +          call errore('bad var id: ', err)
    4091. 

  4091.             do 3, j = 1, var_rank(i)
    4092. 

  4092.                 start(j) = var_shape(j,i) + 1
    4093. 

  4093.                 err = nf_get_varm_int2(ncid, i, start,
    4094. 

  4094.      +                               edge, stride, 
    4095. 

  4095.      +                               imap, value)
    4096. 

  4096.                 if (.not. canConvert) then
    4097. 

  4097.                     if (err .ne. NF_ECHAR)
    4098. 

  4098.      +                  call errore('conversion: ', err)
    4099. 

  4099.                 else
    4100. 

  4100.                     if (err .ne. NF_EINVALCOORDS)
    4101. 

  4101.      +                  call errore('bad index: ', err)
    4102. 

  4102.                 endif
    4103. 

  4103.                 start(j) = 1
    4104. 

  4104.                 edge(j) = var_shape(j,i) + 1
    4105. 

  4105.                 err = nf_get_varm_int2(ncid, i, start,
    4106. 

  4106.      +                               edge, stride, 
    4107. 

  4107.      +                               imap, value)
    4108. 

  4108.                 if (.not. canConvert) then
    4109. 

  4109.                     if (err .ne. NF_ECHAR)
    4110. 

  4110.      +                  call errore('conversion: ', err)
    4111. 

  4111.                 else
    4112. 

  4112.                     if (err .ne. NF_EEDGE)
    4113. 

  4113.      +                  call errore('bad edge: ', err)
    4114. 

  4114.                 endif
    4115. 

  4115.                 edge(j) = 1
    4116. 

  4116.                 stride(j) = 0
    4117. 

  4117.                 err = nf_get_varm_int2(ncid, i, start,
    4118. 

  4118.      +                               edge, stride, 
    4119. 

  4119.      +                               imap, value)
    4120. 

  4120.                 if (.not. canConvert) then
    4121. 

  4121.                     if (err .ne. NF_ECHAR)
    4122. 

  4122.      +                  call errore('conversion: ', err)
    4123. 

  4123.                 else
    4124. 

  4124.                     if (err .ne. NF_ESTRIDE)
    4125. 

  4125.      +                  call errore('bad stride: ', err)
    4126. 

  4126.                 endif
    4127. 

  4127.                 stride(j) = 1
    4128. 

  4128. 3           continue
    4129. 

  4129. C               Choose a random point dividing each dim into 2 parts 
    4130. 

  4130. C               get 2^rank (nslabs) slabs so defined 
    4131. 

  4131.             nslabs = 1
    4132. 

  4132.             do 4, j = 1, var_rank(i)
    4133. 

  4133.                 mid(j) = roll( var_shape(j,i) )
    4134. 

  4134.                 nslabs = nslabs * 2
    4135. 

  4135. 4           continue
    4136. 

  4136. C               /* bits of k determine whether to get lower or upper part 
    4137. 

  4137. C                * of dim
    4138. 

  4138. C                * choose random stride from 1 to edge */
    4139. 

  4139.             do 5, k = 1, nslabs
    4140. 

  4140.                 nstarts = 1
    4141. 

  4141.                 do 6, j = 1, var_rank(i)
    4142. 

  4142.                     if (mod(udshift((k-1), -(j-1)), 2) .ne. 0) then
    4143. 

  4143.                         start(j) = 1
    4144. 

  4144.                         edge(j) = mid(j)
    4145. 

  4145.                     else
    4146. 

  4146.                         start(j) = 1 + mid(j)
    4147. 

  4147.                         edge(j) = var_shape(j,i) - mid(j)
    4148. 

  4148.                     end if
    4149. 

  4149.                     if (edge(j) .gt. 0) then
    4150. 

  4150.                         stride(j) = 1+roll(edge(j))
    4151. 

  4151.                     else
    4152. 

  4152.                         stride(j) = 1
    4153. 

  4153.                     end if
    4154. 

  4154.                     sstride(j) = stride(j)
    4155. 

  4155.                     nstarts = nstarts * stride(j)
    4156. 

  4156. 6               continue
    4157. 

  4157.                 do 7, m = 1, nstarts
    4158. 

  4158.                     err = index2indexes(m, var_rank(i), sstride, index)
    4159. 

  4159.                     if (err .ne. 0)
    4160. 

  4160.      +                  call error('error in index2indexes')
    4161. 

  4161.                     nels = 1
    4162. 

  4162.                     do 8, j = 1, var_rank(i)
    4163. 

  4163.                         count(j) = 1 + (edge(j) - index(j)) / 
    4164. 

  4164.      +                                  stride(j)
    4165. 

  4165.                         nels = nels * count(j)
    4166. 

  4166.                         index(j) = index(j) + start(j) - 1
    4167. 

  4167. 8                   continue
    4168. 

  4168. C                       Random choice of forward or backward 
    4169. 

  4169. C    /* TODO
    4170. 

  4170. C                   if ( roll(2) ) then
    4171. 

  4171. C                       for (j = 0 j < var_rank(i) j++) {
    4172. 

  4172. C                           index(j) += (count(j) - 1) * stride(j)
    4173. 

  4173. C                           stride(j) = -stride(j)
    4174. 

  4174. C                       }
    4175. 

  4175. C                   end if
    4176. 

  4176. C     */
    4177. 

  4177.                     if (var_rank(i) .gt. 0) then
    4178. 

  4178.                         imap(1) = 1
    4179. 

  4179.                         do 9, j = 2, var_rank(i)
    4180. 

  4180.                             imap(j) = imap(j-1) * count(j-1)
    4181. 

  4181. 9                       continue
    4182. 

  4182.                     end if
    4183. 

  4183.                     allInIntRange = .true.
    4184. 

  4184.                     allInExtRange = .true.
    4185. 

  4185.                     do 10, j = 1, nels
    4186. 

  4186.                         err = index2indexes(j, var_rank(i), count, 
    4187. 

  4187.      +                                      index2)
    4188. 

  4188.                         if (err .ne. 0)
    4189. 

  4189.      +                      call error('error in index2indexes 1')
    4190. 

  4190.                         do 11, d = 1, var_rank(i)
    4191. 

  4191.                             index2(d) = index(d) + (index2(d)-1) * 
    4192. 

  4192.      +                                  stride(d)
    4193. 

  4193. 11                      continue
    4194. 

  4194.                         expect(j) = hash4(var_type(i), var_rank(i), 
    4195. 

  4195.      +                                    index2, NFT_INT2)
    4196. 

  4196.                         if (inRange3(expect(j),var_type(i),
    4197. 

  4197.      +                               NFT_INT2)) then
    4198. 

  4198.                             allInIntRange = 
    4199. 

  4199.      +                          allInIntRange .and.
    4200. 

  4200.      +                          in_internal_range(NFT_INT2,
    4201. 

  4201.      +                                            expect(j))
    4202. 

  4202.                         else
    4203. 

  4203.                             allInExtRange = .false.
    4204. 

  4204.                         end if
    4205. 

  4205. 10                  continue
    4206. 

  4206.                     err = nf_get_varm_int2(ncid,i,index,count,
    4207. 

  4207.      +                                   stride,imap,
    4208. 

  4208.      +                                   value)
    4209. 

  4209.                     if (canConvert) then
    4210. 

  4210.                         if (allInExtRange) then
    4211. 

  4211.                             if (allInIntRange) then
    4212. 

  4212.                                 if (err .ne. 0)
    4213. 

  4213.      +                              call error(nf_strerror(err))
    4214. 

  4214.                             else
    4215. 

  4215.                                 if (err .ne. NF_ERANGE)
    4216. 

  4216.      +                              call errore('Range error: ', err)
    4217. 

  4217.                             end if
    4218. 

  4218.                         else
    4219. 

  4219.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    4220. 

  4220.      +                          call errore('OK or Range error: ', err)
    4221. 

  4221.                         end if
    4222. 

  4222.                         do 12, j = 1, nels
    4223. 

  4223.                             if (inRange3(expect(j),var_type(i),
    4224. 

  4224.      +                                   NFT_INT2) .and.
    4225. 

  4225.      +                          in_internal_range(NFT_INT2,
    4226. 

  4226.      +                                            expect(j))) then
    4227. 

  4227.                                 val = value(j)
    4228. 

  4228.                                 if (.not.equal(val, expect(j),
    4229. 

  4229.      +                                         var_type(i), 
    4230. 

  4230.      +                                         NFT_INT2)) then
    4231. 

  4231.                                     call error(
    4232. 

  4232.      +                                  'value read not that expected')
    4233. 

  4233.                                     if (verbose) then
    4234. 

  4234.                                         call error(' ')
    4235. 

  4235.                                         call errori('varid: ', i)
    4236. 

  4236.                                         call errorc('var_name: ', 
    4237. 

  4237.      +                                          var_name(i))
    4238. 

  4238.                                         call errori('element number: ',
    4239. 

  4239.      +                                              j)
    4240. 

  4240.                                         call errord('expect: ', 
    4241. 

  4241.      +                                              expect(j))
    4242. 

  4242.                                         call errord('got: ', val)
    4243. 

  4243.                                     end if
    4244. 

  4244.                                 else
    4245. 

  4245.                                     nok = nok + 1
    4246. 

  4246.                                 end if
    4247. 

  4247.                             end if
    4248. 

  4248. 12                      continue
    4249. 

  4249.                     else
    4250. 

  4250.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    4251. 

  4251.      +                      call errore('wrong type: ', err)
    4252. 

  4252.                     end if
    4253. 

  4253. 7               continue
    4254. 

  4254. 5           continue
    4255. 

  4255. 1       continue
    4256. 

  4256.         err = nf_close(ncid)
    4257. 

  4257.         if (err .ne. 0)
    4258. 

  4258.      +      call errore('nf_close: ',  err)
    4259. 

  4259.         call print_nok(nok)
    4260. 

  4260.         end
    4261. 

  4261. 

  4262. #endif
    4263. 

  4263.         subroutine test_nf_get_varm_int()
    4264. 

  4264.         implicit        none
    4265. 

  4265. #include "tests.inc"
    4266. 

  4266.         integer ncid
    4267. 

  4267.         integer d
    4268. 

  4268.         integer i
    4269. 

  4269.         integer j
    4270. 

  4270.         integer k
    4271. 

  4271.         integer m
    4272. 

  4272.         integer err
    4273. 

  4273.         logical allInExtRange   
    4274. 

  4274.         logical allInIntRange   
    4275. 

  4275.         integer nels
    4276. 

  4276.         integer nslabs
    4277. 

  4277.         integer nstarts         
    4278. 

  4278.         integer nok             
    4279. 

  4279.         integer start(MAX_RANK)
    4280. 

  4280.         integer edge(MAX_RANK)
    4281. 

  4281.         integer index(MAX_RANK)
    4282. 

  4282.         integer index2(MAX_RANK)
    4283. 

  4283.         integer mid(MAX_RANK)
    4284. 

  4284.         integer count(MAX_RANK)
    4285. 

  4285.         integer sstride(MAX_RANK)
    4286. 

  4286.         integer stride(MAX_RANK)
    4287. 

  4287.         integer imap(MAX_RANK)
    4288. 

  4288.         logical canConvert     
    4289. 

  4289.         integer    value(MAX_NELS)
    4290. 

  4290.         doubleprecision expect(MAX_NELS)
    4291. 

  4291.         doubleprecision val
    4292. 

  4292.         integer udshift
    4293. 

  4293. 

  4294.         nok = 0
    4295. 

  4295. 

  4296.         err = nf_open(testfile, NF_NOWRITE, ncid)
    4297. 

  4297.         if (err .ne. 0)
    4298. 

  4298.      +      call errore('nf_open: ', err)
    4299. 

  4299.         do 1, i = 1, NVARS
    4300. 

  4300.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    4301. 

  4301.      +                   (NFT_INT .eq. NFT_TEXT)
    4302. 

  4302.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assertion'
    4303. 

  4303.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assertion'
    4304. 

  4304.             do 2, j = 1, var_rank(i)
    4305. 

  4305.                 start(j) = 1
    4306. 

  4306.                 edge(j) = 1
    4307. 

  4307.                 stride(j) = 1
    4308. 

  4308.                 imap(j) = 1
    4309. 

  4309. 2           continue
    4310. 

  4310.             err = nf_get_varm_int(BAD_ID, i, start, edge,
    4311. 

  4311.      +                           stride, imap, 
    4312. 

  4312.      +                           value)
    4313. 

  4313.             if (err .ne. NF_EBADID)
    4314. 

  4314.      +          call errore('bad ncid: ', err)
    4315. 

  4315.             err = nf_get_varm_int(ncid, BAD_VARID, start,
    4316. 

  4316.      +                           edge, stride, 
    4317. 

  4317.      +                           imap, value)
    4318. 

  4318.             if (err .ne. NF_ENOTVAR)
    4319. 

  4319.      +          call errore('bad var id: ', err)
    4320. 

  4320.             do 3, j = 1, var_rank(i)
    4321. 

  4321.                 start(j) = var_shape(j,i) + 1
    4322. 

  4322.                 err = nf_get_varm_int(ncid, i, start,
    4323. 

  4323.      +                               edge, stride, 
    4324. 

  4324.      +                               imap, value)
    4325. 

  4325.                 if (.not. canConvert) then
    4326. 

  4326.                     if (err .ne. NF_ECHAR)
    4327. 

  4327.      +                  call errore('conversion: ', err)
    4328. 

  4328.                 else
    4329. 

  4329.                     if (err .ne. NF_EINVALCOORDS)
    4330. 

  4330.      +                  call errore('bad index: ', err)
    4331. 

  4331.                 endif
    4332. 

  4332.                 start(j) = 1
    4333. 

  4333.                 edge(j) = var_shape(j,i) + 1
    4334. 

  4334.                 err = nf_get_varm_int(ncid, i, start,
    4335. 

  4335.      +                               edge, stride, 
    4336. 

  4336.      +                               imap, value)
    4337. 

  4337.                 if (.not. canConvert) then
    4338. 

  4338.                     if (err .ne. NF_ECHAR)
    4339. 

  4339.      +                  call errore('conversion: ', err)
    4340. 

  4340.                 else
    4341. 

  4341.                     if (err .ne. NF_EEDGE)
    4342. 

  4342.      +                  call errore('bad edge: ', err)
    4343. 

  4343.                 endif
    4344. 

  4344.                 edge(j) = 1
    4345. 

  4345.                 stride(j) = 0
    4346. 

  4346.                 err = nf_get_varm_int(ncid, i, start,
    4347. 

  4347.      +                               edge, stride, 
    4348. 

  4348.      +                               imap, value)
    4349. 

  4349.                 if (.not. canConvert) then
    4350. 

  4350.                     if (err .ne. NF_ECHAR)
    4351. 

  4351.      +                  call errore('conversion: ', err)
    4352. 

  4352.                 else
    4353. 

  4353.                     if (err .ne. NF_ESTRIDE)
    4354. 

  4354.      +                  call errore('bad stride: ', err)
    4355. 

  4355.                 endif
    4356. 

  4356.                 stride(j) = 1
    4357. 

  4357. 3           continue
    4358. 

  4358. C               Choose a random point dividing each dim into 2 parts 
    4359. 

  4359. C               get 2^rank (nslabs) slabs so defined 
    4360. 

  4360.             nslabs = 1
    4361. 

  4361.             do 4, j = 1, var_rank(i)
    4362. 

  4362.                 mid(j) = roll( var_shape(j,i) )
    4363. 

  4363.                 nslabs = nslabs * 2
    4364. 

  4364. 4           continue
    4365. 

  4365. C               /* bits of k determine whether to get lower or upper part 
    4366. 

  4366. C                * of dim
    4367. 

  4367. C                * choose random stride from 1 to edge */
    4368. 

  4368.             do 5, k = 1, nslabs
    4369. 

  4369.                 nstarts = 1
    4370. 

  4370.                 do 6, j = 1, var_rank(i)
    4371. 

  4371.                     if (mod(udshift((k-1), -(j-1)), 2) .ne. 0) then
    4372. 

  4372.                         start(j) = 1
    4373. 

  4373.                         edge(j) = mid(j)
    4374. 

  4374.                     else
    4375. 

  4375.                         start(j) = 1 + mid(j)
    4376. 

  4376.                         edge(j) = var_shape(j,i) - mid(j)
    4377. 

  4377.                     end if
    4378. 

  4378.                     if (edge(j) .gt. 0) then
    4379. 

  4379.                         stride(j) = 1+roll(edge(j))
    4380. 

  4380.                     else
    4381. 

  4381.                         stride(j) = 1
    4382. 

  4382.                     end if
    4383. 

  4383.                     sstride(j) = stride(j)
    4384. 

  4384.                     nstarts = nstarts * stride(j)
    4385. 

  4385. 6               continue
    4386. 

  4386.                 do 7, m = 1, nstarts
    4387. 

  4387.                     err = index2indexes(m, var_rank(i), sstride, index)
    4388. 

  4388.                     if (err .ne. 0)
    4389. 

  4389.      +                  call error('error in index2indexes')
    4390. 

  4390.                     nels = 1
    4391. 

  4391.                     do 8, j = 1, var_rank(i)
    4392. 

  4392.                         count(j) = 1 + (edge(j) - index(j)) / 
    4393. 

  4393.      +                                  stride(j)
    4394. 

  4394.                         nels = nels * count(j)
    4395. 

  4395.                         index(j) = index(j) + start(j) - 1
    4396. 

  4396. 8                   continue
    4397. 

  4397. C                       Random choice of forward or backward 
    4398. 

  4398. C    /* TODO
    4399. 

  4399. C                   if ( roll(2) ) then
    4400. 

  4400. C                       for (j = 0 j < var_rank(i) j++) {
    4401. 

  4401. C                           index(j) += (count(j) - 1) * stride(j)
    4402. 

  4402. C                           stride(j) = -stride(j)
    4403. 

  4403. C                       }
    4404. 

  4404. C                   end if
    4405. 

  4405. C     */
    4406. 

  4406.                     if (var_rank(i) .gt. 0) then
    4407. 

  4407.                         imap(1) = 1
    4408. 

  4408.                         do 9, j = 2, var_rank(i)
    4409. 

  4409.                             imap(j) = imap(j-1) * count(j-1)
    4410. 

  4410. 9                       continue
    4411. 

  4411.                     end if
    4412. 

  4412.                     allInIntRange = .true.
    4413. 

  4413.                     allInExtRange = .true.
    4414. 

  4414.                     do 10, j = 1, nels
    4415. 

  4415.                         err = index2indexes(j, var_rank(i), count, 
    4416. 

  4416.      +                                      index2)
    4417. 

  4417.                         if (err .ne. 0)
    4418. 

  4418.      +                      call error('error in index2indexes 1')
    4419. 

  4419.                         do 11, d = 1, var_rank(i)
    4420. 

  4420.                             index2(d) = index(d) + (index2(d)-1) * 
    4421. 

  4421.      +                                  stride(d)
    4422. 

  4422. 11                      continue
    4423. 

  4423.                         expect(j) = hash4(var_type(i), var_rank(i), 
    4424. 

  4424.      +                                    index2, NFT_INT)
    4425. 

  4425.                         if (inRange3(expect(j),var_type(i),
    4426. 

  4426.      +                               NFT_INT)) then
    4427. 

  4427.                             allInIntRange = 
    4428. 

  4428.      +                          allInIntRange .and.
    4429. 

  4429.      +                          in_internal_range(NFT_INT,
    4430. 

  4430.      +                                            expect(j))
    4431. 

  4431.                         else
    4432. 

  4432.                             allInExtRange = .false.
    4433. 

  4433.                         end if
    4434. 

  4434. 10                  continue
    4435. 

  4435.                     err = nf_get_varm_int(ncid,i,index,count,
    4436. 

  4436.      +                                   stride,imap,
    4437. 

  4437.      +                                   value)
    4438. 

  4438.                     if (canConvert) then
    4439. 

  4439.                         if (allInExtRange) then
    4440. 

  4440.                             if (allInIntRange) then
    4441. 

  4441.                                 if (err .ne. 0)
    4442. 

  4442.      +                              call error(nf_strerror(err))
    4443. 

  4443.                             else
    4444. 

  4444.                                 if (err .ne. NF_ERANGE)
    4445. 

  4445.      +                              call errore('Range error: ', err)
    4446. 

  4446.                             end if
    4447. 

  4447.                         else
    4448. 

  4448.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    4449. 

  4449.      +                          call errore('OK or Range error: ', err)
    4450. 

  4450.                         end if
    4451. 

  4451.                         do 12, j = 1, nels
    4452. 

  4452.                             if (inRange3(expect(j),var_type(i),
    4453. 

  4453.      +                                   NFT_INT) .and.
    4454. 

  4454.      +                          in_internal_range(NFT_INT,
    4455. 

  4455.      +                                            expect(j))) then
    4456. 

  4456.                                 val = value(j)
    4457. 

  4457.                                 if (.not.equal(val, expect(j),
    4458. 

  4458.      +                                         var_type(i), 
    4459. 

  4459.      +                                         NFT_INT)) then
    4460. 

  4460.                                     call error(
    4461. 

  4461.      +                                  'value read not that expected')
    4462. 

  4462.                                     if (verbose) then
    4463. 

  4463.                                         call error(' ')
    4464. 

  4464.                                         call errori('varid: ', i)
    4465. 

  4465.                                         call errorc('var_name: ', 
    4466. 

  4466.      +                                          var_name(i))
    4467. 

  4467.                                         call errori('element number: ',
    4468. 

  4468.      +                                              j)
    4469. 

  4469.                                         call errord('expect: ', 
    4470. 

  4470.      +                                              expect(j))
    4471. 

  4471.                                         call errord('got: ', val)
    4472. 

  4472.                                     end if
    4473. 

  4473.                                 else
    4474. 

  4474.                                     nok = nok + 1
    4475. 

  4475.                                 end if
    4476. 

  4476.                             end if
    4477. 

  4477. 12                      continue
    4478. 

  4478.                     else
    4479. 

  4479.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    4480. 

  4480.      +                      call errore('wrong type: ', err)
    4481. 

  4481.                     end if
    4482. 

  4482. 7               continue
    4483. 

  4483. 5           continue
    4484. 

  4484. 1       continue
    4485. 

  4485.         err = nf_close(ncid)
    4486. 

  4486.         if (err .ne. 0)
    4487. 

  4487.      +      call errore('nf_close: ',  err)
    4488. 

  4488.         call print_nok(nok)
    4489. 

  4489.         end
    4490. 

  4490. 

  4491.         subroutine test_nf_get_varm_real()
    4492. 

  4492.         implicit        none
    4493. 

  4493. #include "tests.inc"
    4494. 

  4494.         integer ncid
    4495. 

  4495.         integer d
    4496. 

  4496.         integer i
    4497. 

  4497.         integer j
    4498. 

  4498.         integer k
    4499. 

  4499.         integer m
    4500. 

  4500.         integer err
    4501. 

  4501.         logical allInExtRange   
    4502. 

  4502.         logical allInIntRange   
    4503. 

  4503.         integer nels
    4504. 

  4504.         integer nslabs
    4505. 

  4505.         integer nstarts         
    4506. 

  4506.         integer nok             
    4507. 

  4507.         integer start(MAX_RANK)
    4508. 

  4508.         integer edge(MAX_RANK)
    4509. 

  4509.         integer index(MAX_RANK)
    4510. 

  4510.         integer index2(MAX_RANK)
    4511. 

  4511.         integer mid(MAX_RANK)
    4512. 

  4512.         integer count(MAX_RANK)
    4513. 

  4513.         integer sstride(MAX_RANK)
    4514. 

  4514.         integer stride(MAX_RANK)
    4515. 

  4515.         integer imap(MAX_RANK)
    4516. 

  4516.         logical canConvert     
    4517. 

  4517.         real    value(MAX_NELS)
    4518. 

  4518.         doubleprecision expect(MAX_NELS)
    4519. 

  4519.         doubleprecision val
    4520. 

  4520.         integer udshift
    4521. 

  4521. 

  4522.         nok = 0
    4523. 

  4523. 

  4524.         err = nf_open(testfile, NF_NOWRITE, ncid)
    4525. 

  4525.         if (err .ne. 0)
    4526. 

  4526.      +      call errore('nf_open: ', err)
    4527. 

  4527.         do 1, i = 1, NVARS
    4528. 

  4528.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    4529. 

  4529.      +                   (NFT_REAL .eq. NFT_TEXT)
    4530. 

  4530.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assertion'
    4531. 

  4531.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assertion'
    4532. 

  4532.             do 2, j = 1, var_rank(i)
    4533. 

  4533.                 start(j) = 1
    4534. 

  4534.                 edge(j) = 1
    4535. 

  4535.                 stride(j) = 1
    4536. 

  4536.                 imap(j) = 1
    4537. 

  4537. 2           continue
    4538. 

  4538.             err = nf_get_varm_real(BAD_ID, i, start, edge,
    4539. 

  4539.      +                           stride, imap, 
    4540. 

  4540.      +                           value)
    4541. 

  4541.             if (err .ne. NF_EBADID)
    4542. 

  4542.      +          call errore('bad ncid: ', err)
    4543. 

  4543.             err = nf_get_varm_real(ncid, BAD_VARID, start,
    4544. 

  4544.      +                           edge, stride, 
    4545. 

  4545.      +                           imap, value)
    4546. 

  4546.             if (err .ne. NF_ENOTVAR)
    4547. 

  4547.      +          call errore('bad var id: ', err)
    4548. 

  4548.             do 3, j = 1, var_rank(i)
    4549. 

  4549.                 start(j) = var_shape(j,i) + 1
    4550. 

  4550.                 err = nf_get_varm_real(ncid, i, start,
    4551. 

  4551.      +                               edge, stride, 
    4552. 

  4552.      +                               imap, value)
    4553. 

  4553.                 if (.not. canConvert) then
    4554. 

  4554.                     if (err .ne. NF_ECHAR)
    4555. 

  4555.      +                  call errore('conversion: ', err)
    4556. 

  4556.                 else
    4557. 

  4557.                     if (err .ne. NF_EINVALCOORDS)
    4558. 

  4558.      +                  call errore('bad index: ', err)
    4559. 

  4559.                 endif
    4560. 

  4560.                 start(j) = 1
    4561. 

  4561.                 edge(j) = var_shape(j,i) + 1
    4562. 

  4562.                 err = nf_get_varm_real(ncid, i, start,
    4563. 

  4563.      +                               edge, stride, 
    4564. 

  4564.      +                               imap, value)
    4565. 

  4565.                 if (.not. canConvert) then
    4566. 

  4566.                     if (err .ne. NF_ECHAR)
    4567. 

  4567.      +                  call errore('conversion: ', err)
    4568. 

  4568.                 else
    4569. 

  4569.                     if (err .ne. NF_EEDGE)
    4570. 

  4570.      +                  call errore('bad edge: ', err)
    4571. 

  4571.                 endif
    4572. 

  4572.                 edge(j) = 1
    4573. 

  4573.                 stride(j) = 0
    4574. 

  4574.                 err = nf_get_varm_real(ncid, i, start,
    4575. 

  4575.      +                               edge, stride, 
    4576. 

  4576.      +                               imap, value)
    4577. 

  4577.                 if (.not. canConvert) then
    4578. 

  4578.                     if (err .ne. NF_ECHAR)
    4579. 

  4579.      +                  call errore('conversion: ', err)
    4580. 

  4580.                 else
    4581. 

  4581.                     if (err .ne. NF_ESTRIDE)
    4582. 

  4582.      +                  call errore('bad stride: ', err)
    4583. 

  4583.                 endif
    4584. 

  4584.                 stride(j) = 1
    4585. 

  4585. 3           continue
    4586. 

  4586. C               Choose a random point dividing each dim into 2 parts 
    4587. 

  4587. C               get 2^rank (nslabs) slabs so defined 
    4588. 

  4588.             nslabs = 1
    4589. 

  4589.             do 4, j = 1, var_rank(i)
    4590. 

  4590.                 mid(j) = roll( var_shape(j,i) )
    4591. 

  4591.                 nslabs = nslabs * 2
    4592. 

  4592. 4           continue
    4593. 

  4593. C               /* bits of k determine whether to get lower or upper part 
    4594. 

  4594. C                * of dim
    4595. 

  4595. C                * choose random stride from 1 to edge */
    4596. 

  4596.             do 5, k = 1, nslabs
    4597. 

  4597.                 nstarts = 1
    4598. 

  4598.                 do 6, j = 1, var_rank(i)
    4599. 

  4599.                     if (mod(udshift((k-1), -(j-1)), 2) .ne. 0) then
    4600. 

  4600.                         start(j) = 1
    4601. 

  4601.                         edge(j) = mid(j)
    4602. 

  4602.                     else
    4603. 

  4603.                         start(j) = 1 + mid(j)
    4604. 

  4604.                         edge(j) = var_shape(j,i) - mid(j)
    4605. 

  4605.                     end if
    4606. 

  4606.                     if (edge(j) .gt. 0) then
    4607. 

  4607.                         stride(j) = 1+roll(edge(j))
    4608. 

  4608.                     else
    4609. 

  4609.                         stride(j) = 1
    4610. 

  4610.                     end if
    4611. 

  4611.                     sstride(j) = stride(j)
    4612. 

  4612.                     nstarts = nstarts * stride(j)
    4613. 

  4613. 6               continue
    4614. 

  4614.                 do 7, m = 1, nstarts
    4615. 

  4615.                     err = index2indexes(m, var_rank(i), sstride, index)
    4616. 

  4616.                     if (err .ne. 0)
    4617. 

  4617.      +                  call error('error in index2indexes')
    4618. 

  4618.                     nels = 1
    4619. 

  4619.                     do 8, j = 1, var_rank(i)
    4620. 

  4620.                         count(j) = 1 + (edge(j) - index(j)) / 
    4621. 

  4621.      +                                  stride(j)
    4622. 

  4622.                         nels = nels * count(j)
    4623. 

  4623.                         index(j) = index(j) + start(j) - 1
    4624. 

  4624. 8                   continue
    4625. 

  4625. C                       Random choice of forward or backward 
    4626. 

  4626. C    /* TODO
    4627. 

  4627. C                   if ( roll(2) ) then
    4628. 

  4628. C                       for (j = 0 j < var_rank(i) j++) {
    4629. 

  4629. C                           index(j) += (count(j) - 1) * stride(j)
    4630. 

  4630. C                           stride(j) = -stride(j)
    4631. 

  4631. C                       }
    4632. 

  4632. C                   end if
    4633. 

  4633. C     */
    4634. 

  4634.                     if (var_rank(i) .gt. 0) then
    4635. 

  4635.                         imap(1) = 1
    4636. 

  4636.                         do 9, j = 2, var_rank(i)
    4637. 

  4637.                             imap(j) = imap(j-1) * count(j-1)
    4638. 

  4638. 9                       continue
    4639. 

  4639.                     end if
    4640. 

  4640.                     allInIntRange = .true.
    4641. 

  4641.                     allInExtRange = .true.
    4642. 

  4642.                     do 10, j = 1, nels
    4643. 

  4643.                         err = index2indexes(j, var_rank(i), count, 
    4644. 

  4644.      +                                      index2)
    4645. 

  4645.                         if (err .ne. 0)
    4646. 

  4646.      +                      call error('error in index2indexes 1')
    4647. 

  4647.                         do 11, d = 1, var_rank(i)
    4648. 

  4648.                             index2(d) = index(d) + (index2(d)-1) * 
    4649. 

  4649.      +                                  stride(d)
    4650. 

  4650. 11                      continue
    4651. 

  4651.                         expect(j) = hash4(var_type(i), var_rank(i), 
    4652. 

  4652.      +                                    index2, NFT_REAL)
    4653. 

  4653.                         if (inRange3(expect(j),var_type(i),
    4654. 

  4654.      +                               NFT_REAL)) then
    4655. 

  4655.                             allInIntRange = 
    4656. 

  4656.      +                          allInIntRange .and.
    4657. 

  4657.      +                          in_internal_range(NFT_REAL,
    4658. 

  4658.      +                                            expect(j))
    4659. 

  4659.                         else
    4660. 

  4660.                             allInExtRange = .false.
    4661. 

  4661.                         end if
    4662. 

  4662. 10                  continue
    4663. 

  4663.                     err = nf_get_varm_real(ncid,i,index,count,
    4664. 

  4664.      +                                   stride,imap,
    4665. 

  4665.      +                                   value)
    4666. 

  4666.                     if (canConvert) then
    4667. 

  4667.                         if (allInExtRange) then
    4668. 

  4668.                             if (allInIntRange) then
    4669. 

  4669.                                 if (err .ne. 0)
    4670. 

  4670.      +                              call error(nf_strerror(err))
    4671. 

  4671.                             else
    4672. 

  4672.                                 if (err .ne. NF_ERANGE)
    4673. 

  4673.      +                              call errore('Range error: ', err)
    4674. 

  4674.                             end if
    4675. 

  4675.                         else
    4676. 

  4676.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    4677. 

  4677.      +                          call errore('OK or Range error: ', err)
    4678. 

  4678.                         end if
    4679. 

  4679.                         do 12, j = 1, nels
    4680. 

  4680.                             if (inRange3(expect(j),var_type(i),
    4681. 

  4681.      +                                   NFT_REAL) .and.
    4682. 

  4682.      +                          in_internal_range(NFT_REAL,
    4683. 

  4683.      +                                            expect(j))) then
    4684. 

  4684.                                 val = value(j)
    4685. 

  4685.                                 if (.not.equal(val, expect(j),
    4686. 

  4686.      +                                         var_type(i), 
    4687. 

  4687.      +                                         NFT_REAL)) then
    4688. 

  4688.                                     call error(
    4689. 

  4689.      +                                  'value read not that expected')
    4690. 

  4690.                                     if (verbose) then
    4691. 

  4691.                                         call error(' ')
    4692. 

  4692.                                         call errori('varid: ', i)
    4693. 

  4693.                                         call errorc('var_name: ', 
    4694. 

  4694.      +                                          var_name(i))
    4695. 

  4695.                                         call errori('element number: ',
    4696. 

  4696.      +                                              j)
    4697. 

  4697.                                         call errord('expect: ', 
    4698. 

  4698.      +                                              expect(j))
    4699. 

  4699.                                         call errord('got: ', val)
    4700. 

  4700.                                     end if
    4701. 

  4701.                                 else
    4702. 

  4702.                                     nok = nok + 1
    4703. 

  4703.                                 end if
    4704. 

  4704.                             end if
    4705. 

  4705. 12                      continue
    4706. 

  4706.                     else
    4707. 

  4707.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    4708. 

  4708.      +                      call errore('wrong type: ', err)
    4709. 

  4709.                     end if
    4710. 

  4710. 7               continue
    4711. 

  4711. 5           continue
    4712. 

  4712. 1       continue
    4713. 

  4713.         err = nf_close(ncid)
    4714. 

  4714.         if (err .ne. 0)
    4715. 

  4715.      +      call errore('nf_close: ',  err)
    4716. 

  4716.         call print_nok(nok)
    4717. 

  4717.         end
    4718. 

  4718. 

  4719.         subroutine test_nf_get_varm_double()
    4720. 

  4720.         implicit        none
    4721. 

  4721. #include "tests.inc"
    4722. 

  4722.         integer ncid
    4723. 

  4723.         integer d
    4724. 

  4724.         integer i
    4725. 

  4725.         integer j
    4726. 

  4726.         integer k
    4727. 

  4727.         integer m
    4728. 

  4728.         integer err
    4729. 

  4729.         logical allInExtRange   
    4730. 

  4730.         logical allInIntRange   
    4731. 

  4731.         integer nels
    4732. 

  4732.         integer nslabs
    4733. 

  4733.         integer nstarts         
    4734. 

  4734.         integer nok             
    4735. 

  4735.         integer start(MAX_RANK)
    4736. 

  4736.         integer edge(MAX_RANK)
    4737. 

  4737.         integer index(MAX_RANK)
    4738. 

  4738.         integer index2(MAX_RANK)
    4739. 

  4739.         integer mid(MAX_RANK)
    4740. 

  4740.         integer count(MAX_RANK)
    4741. 

  4741.         integer sstride(MAX_RANK)
    4742. 

  4742.         integer stride(MAX_RANK)
    4743. 

  4743.         integer imap(MAX_RANK)
    4744. 

  4744.         logical canConvert     
    4745. 

  4745.         doubleprecision    value(MAX_NELS)
    4746. 

  4746.         doubleprecision expect(MAX_NELS)
    4747. 

  4747.         doubleprecision val
    4748. 

  4748.         integer udshift
    4749. 

  4749. 

  4750.         nok = 0
    4751. 

  4751. 

  4752.         err = nf_open(testfile, NF_NOWRITE, ncid)
    4753. 

  4753.         if (err .ne. 0)
    4754. 

  4754.      +      call errore('nf_open: ', err)
    4755. 

  4755.         do 1, i = 1, NVARS
    4756. 

  4756.             canConvert = (var_type(i) .eq. NF_CHAR) .eqv. 
    4757. 

  4757.      +                   (NFT_DOUBLE .eq. NFT_TEXT)
    4758. 

  4758.             if (.not.(var_rank(i) .le. MAX_RANK)) stop 'assertion'
    4759. 

  4759.             if (.not.(var_nels(i) .le. MAX_NELS)) stop 'assertion'
    4760. 

  4760.             do 2, j = 1, var_rank(i)
    4761. 

  4761.                 start(j) = 1
    4762. 

  4762.                 edge(j) = 1
    4763. 

  4763.                 stride(j) = 1
    4764. 

  4764.                 imap(j) = 1
    4765. 

  4765. 2           continue
    4766. 

  4766.             err = nf_get_varm_double(BAD_ID, i, start, edge,
    4767. 

  4767.      +                           stride, imap, 
    4768. 

  4768.      +                           value)
    4769. 

  4769.             if (err .ne. NF_EBADID)
    4770. 

  4770.      +          call errore('bad ncid: ', err)
    4771. 

  4771.             err = nf_get_varm_double(ncid, BAD_VARID, start,
    4772. 

  4772.      +                           edge, stride, 
    4773. 

  4773.      +                           imap, value)
    4774. 

  4774.             if (err .ne. NF_ENOTVAR)
    4775. 

  4775.      +          call errore('bad var id: ', err)
    4776. 

  4776.             do 3, j = 1, var_rank(i)
    4777. 

  4777.                 start(j) = var_shape(j,i) + 1
    4778. 

  4778.                 err = nf_get_varm_double(ncid, i, start,
    4779. 

  4779.      +                               edge, stride, 
    4780. 

  4780.      +                               imap, value)
    4781. 

  4781.                 if (.not. canConvert) then
    4782. 

  4782.                     if (err .ne. NF_ECHAR)
    4783. 

  4783.      +                  call errore('conversion: ', err)
    4784. 

  4784.                 else
    4785. 

  4785.                     if (err .ne. NF_EINVALCOORDS)
    4786. 

  4786.      +                  call errore('bad index: ', err)
    4787. 

  4787.                 endif
    4788. 

  4788.                 start(j) = 1
    4789. 

  4789.                 edge(j) = var_shape(j,i) + 1
    4790. 

  4790.                 err = nf_get_varm_double(ncid, i, start,
    4791. 

  4791.      +                               edge, stride, 
    4792. 

  4792.      +                               imap, value)
    4793. 

  4793.                 if (.not. canConvert) then
    4794. 

  4794.                     if (err .ne. NF_ECHAR)
    4795. 

  4795.      +                  call errore('conversion: ', err)
    4796. 

  4796.                 else
    4797. 

  4797.                     if (err .ne. NF_EEDGE)
    4798. 

  4798.      +                  call errore('bad edge: ', err)
    4799. 

  4799.                 endif
    4800. 

  4800.                 edge(j) = 1
    4801. 

  4801.                 stride(j) = 0
    4802. 

  4802.                 err = nf_get_varm_double(ncid, i, start,
    4803. 

  4803.      +                               edge, stride, 
    4804. 

  4804.      +                               imap, value)
    4805. 

  4805.                 if (.not. canConvert) then
    4806. 

  4806.                     if (err .ne. NF_ECHAR)
    4807. 

  4807.      +                  call errore('conversion: ', err)
    4808. 

  4808.                 else
    4809. 

  4809.                     if (err .ne. NF_ESTRIDE)
    4810. 

  4810.      +                  call errore('bad stride: ', err)
    4811. 

  4811.                 endif
    4812. 

  4812.                 stride(j) = 1
    4813. 

  4813. 3           continue
    4814. 

  4814. C               Choose a random point dividing each dim into 2 parts 
    4815. 

  4815. C               get 2^rank (nslabs) slabs so defined 
    4816. 

  4816.             nslabs = 1
    4817. 

  4817.             do 4, j = 1, var_rank(i)
    4818. 

  4818.                 mid(j) = roll( var_shape(j,i) )
    4819. 

  4819.                 nslabs = nslabs * 2
    4820. 

  4820. 4           continue
    4821. 

  4821. C               /* bits of k determine whether to get lower or upper part 
    4822. 

  4822. C                * of dim
    4823. 

  4823. C                * choose random stride from 1 to edge */
    4824. 

  4824.             do 5, k = 1, nslabs
    4825. 

  4825.                 nstarts = 1
    4826. 

  4826.                 do 6, j = 1, var_rank(i)
    4827. 

  4827.                     if (mod(udshift((k-1), -(j-1)), 2) .ne. 0) then
    4828. 

  4828.                         start(j) = 1
    4829. 

  4829.                         edge(j) = mid(j)
    4830. 

  4830.                     else
    4831. 

  4831.                         start(j) = 1 + mid(j)
    4832. 

  4832.                         edge(j) = var_shape(j,i) - mid(j)
    4833. 

  4833.                     end if
    4834. 

  4834.                     if (edge(j) .gt. 0) then
    4835. 

  4835.                         stride(j) = 1+roll(edge(j))
    4836. 

  4836.                     else
    4837. 

  4837.                         stride(j) = 1
    4838. 

  4838.                     end if
    4839. 

  4839.                     sstride(j) = stride(j)
    4840. 

  4840.                     nstarts = nstarts * stride(j)
    4841. 

  4841. 6               continue
    4842. 

  4842.                 do 7, m = 1, nstarts
    4843. 

  4843.                     err = index2indexes(m, var_rank(i), sstride, index)
    4844. 

  4844.                     if (err .ne. 0)
    4845. 

  4845.      +                  call error('error in index2indexes')
    4846. 

  4846.                     nels = 1
    4847. 

  4847.                     do 8, j = 1, var_rank(i)
    4848. 

  4848.                         count(j) = 1 + (edge(j) - index(j)) / 
    4849. 

  4849.      +                                  stride(j)
    4850. 

  4850.                         nels = nels * count(j)
    4851. 

  4851.                         index(j) = index(j) + start(j) - 1
    4852. 

  4852. 8                   continue
    4853. 

  4853. C                       Random choice of forward or backward 
    4854. 

  4854. C    /* TODO
    4855. 

  4855. C                   if ( roll(2) ) then
    4856. 

  4856. C                       for (j = 0 j < var_rank(i) j++) {
    4857. 

  4857. C                           index(j) += (count(j) - 1) * stride(j)
    4858. 

  4858. C                           stride(j) = -stride(j)
    4859. 

  4859. C                       }
    4860. 

  4860. C                   end if
    4861. 

  4861. C     */
    4862. 

  4862.                     if (var_rank(i) .gt. 0) then
    4863. 

  4863.                         imap(1) = 1
    4864. 

  4864.                         do 9, j = 2, var_rank(i)
    4865. 

  4865.                             imap(j) = imap(j-1) * count(j-1)
    4866. 

  4866. 9                       continue
    4867. 

  4867.                     end if
    4868. 

  4868.                     allInIntRange = .true.
    4869. 

  4869.                     allInExtRange = .true.
    4870. 

  4870.                     do 10, j = 1, nels
    4871. 

  4871.                         err = index2indexes(j, var_rank(i), count, 
    4872. 

  4872.      +                                      index2)
    4873. 

  4873.                         if (err .ne. 0)
    4874. 

  4874.      +                      call error('error in index2indexes 1')
    4875. 

  4875.                         do 11, d = 1, var_rank(i)
    4876. 

  4876.                             index2(d) = index(d) + (index2(d)-1) * 
    4877. 

  4877.      +                                  stride(d)
    4878. 

  4878. 11                      continue
    4879. 

  4879.                         expect(j) = hash4(var_type(i), var_rank(i), 
    4880. 

  4880.      +                                    index2, NFT_DOUBLE)
    4881. 

  4881.                         if (inRange3(expect(j),var_type(i),
    4882. 

  4882.      +                               NFT_DOUBLE)) then
    4883. 

  4883.                             allInIntRange = 
    4884. 

  4884.      +                          allInIntRange .and.
    4885. 

  4885.      +                          in_internal_range(NFT_DOUBLE,
    4886. 

  4886.      +                                            expect(j))
    4887. 

  4887.                         else
    4888. 

  4888.                             allInExtRange = .false.
    4889. 

  4889.                         end if
    4890. 

  4890. 10                  continue
    4891. 

  4891.                     err = nf_get_varm_double(ncid,i,index,count,
    4892. 

  4892.      +                                   stride,imap,
    4893. 

  4893.      +                                   value)
    4894. 

  4894.                     if (canConvert) then
    4895. 

  4895.                         if (allInExtRange) then
    4896. 

  4896.                             if (allInIntRange) then
    4897. 

  4897.                                 if (err .ne. 0)
    4898. 

  4898.      +                              call error(nf_strerror(err))
    4899. 

  4899.                             else
    4900. 

  4900.                                 if (err .ne. NF_ERANGE)
    4901. 

  4901.      +                              call errore('Range error: ', err)
    4902. 

  4902.                             end if
    4903. 

  4903.                         else
    4904. 

  4904.                             if (err .ne. 0 .and. err .ne. NF_ERANGE)
    4905. 

  4905.      +                          call errore('OK or Range error: ', err)
    4906. 

  4906.                         end if
    4907. 

  4907.                         do 12, j = 1, nels
    4908. 

  4908.                             if (inRange3(expect(j),var_type(i),
    4909. 

  4909.      +                                   NFT_DOUBLE) .and.
    4910. 

  4910.      +                          in_internal_range(NFT_DOUBLE,
    4911. 

  4911.      +                                            expect(j))) then
    4912. 

  4912.                                 val = value(j)
    4913. 

  4913.                                 if (.not.equal(val, expect(j),
    4914. 

  4914.      +                                         var_type(i), 
    4915. 

  4915.      +                                         NFT_DOUBLE)) then
    4916. 

  4916.                                     call error(
    4917. 

  4917.      +                                  'value read not that expected')
    4918. 

  4918.                                     if (verbose) then
    4919. 

  4919.                                         call error(' ')
    4920. 

  4920.                                         call errori('varid: ', i)
    4921. 

  4921.                                         call errorc('var_name: ', 
    4922. 

  4922.      +                                          var_name(i))
    4923. 

  4923.                                         call errori('element number: ',
    4924. 

  4924.      +                                              j)
    4925. 

  4925.                                         call errord('expect: ', 
    4926. 

  4926.      +                                              expect(j))
    4927. 

  4927.                                         call errord('got: ', val)
    4928. 

  4928.                                     end if
    4929. 

  4929.                                 else
    4930. 

  4930.                                     nok = nok + 1
    4931. 

  4931.                                 end if
    4932. 

  4932.                             end if
    4933. 

  4933. 12                      continue
    4934. 

  4934.                     else
    4935. 

  4935.                         if (nels .gt. 0 .and. err .ne. NF_ECHAR)
    4936. 

  4936.      +                      call errore('wrong type: ', err)
    4937. 

  4937.                     end if
    4938. 

  4938. 7               continue
    4939. 

  4939. 5           continue
    4940. 

  4940. 1       continue
    4941. 

  4941.         err = nf_close(ncid)
    4942. 

  4942.         if (err .ne. 0)
    4943. 

  4943.      +      call errore('nf_close: ',  err)
    4944. 

  4944.         call print_nok(nok)
    4945. 

  4945.         end
    4946. 

  4946. 

  4947. 

  4948.         subroutine test_nf_get_att_text()
    4949. 

  4949.         implicit        none
    4950. 

  4950. #include "tests.inc"
    4951. 

  4951.         integer ncid
    4952. 

  4952.         integer i
    4953. 

  4953.         integer j
    4954. 

  4954.         integer k
    4955. 

  4955.         integer err
    4956. 

  4956.         integer ndx(1)
    4957. 

  4957.         logical allInExtRange
    4958. 

  4958.         logical allInIntRange
    4959. 

  4959.         logical canConvert     
    4960. 

  4960.         character    value(MAX_NELS)
    4961. 

  4961.         doubleprecision expect(MAX_NELS)
    4962. 

  4962.         integer nok             
    4963. 

  4963.         doubleprecision val
    4964. 

  4964. 

  4965.         nok = 0
    4966. 

  4966. 

  4967.         err = nf_open(testfile, NF_NOWRITE, ncid)
    4968. 

  4968.         if (err .ne. 0) 
    4969. 

  4969.      +      call errore('nf_open: ', err)
    4970. 

  4970. 

  4971.         do 1, i = 0, NVARS
    4972. 

  4972.             do 2, j = 1, NATTS(i)
    4973. 

  4973.                 canConvert = (ATT_TYPE(j,i) .eq. NF_CHAR) .eqv.
    4974. 

  4974.      +                       (NFT_TEXT .eq. NFT_TEXT)
    4975. 

  4975.                 err = nf_get_att_text(BAD_ID, i,
    4976. 

  4976.      +                  ATT_NAME(j,i), 
    4977. 

  4977.      +                  value)
    4978. 

  4978.                 if (err .ne. NF_EBADID) 
    4979. 

  4979.      +              call errore('bad ncid: ', err)
    4980. 

  4980.                 err = nf_get_att_text(ncid, BAD_VARID, 
    4981. 

  4981.      +                              ATT_NAME(j,i), 
    4982. 

  4982.      +                              value)
    4983. 

  4983.                 if (err .ne. NF_ENOTVAR) 
    4984. 

  4984.      +              call errore('bad var id: ', err)
    4985. 

  4985.                 err = nf_get_att_text(ncid, i, 'noSuch', value)
    4986. 

  4986.                 if (err .ne. NF_ENOTATT) 
    4987. 

  4987.      +              call errore('Bad attribute name: ', err)
    4988. 

  4988.                 allInIntRange = .true.
    4989. 

  4989.                 allInExtRange = .true.
    4990. 

  4990.                 do 3, k = 1, ATT_LEN(j,i)
    4991. 

  4991.                     ndx(1) = k
    4992. 

  4992.                     expect(k) = hash4(ATT_TYPE(j,i), -1, ndx, 
    4993. 

  4993.      +                                NFT_TEXT)
    4994. 

  4994.                     if (inRange3(expect(k),ATT_TYPE(j,i),
    4995. 

  4995.      +                           NFT_TEXT)) then
    4996. 

  4996.                         allInIntRange = 
    4997. 

  4997.      +                      allInIntRange .and.
    4998. 

  4998.      +                      in_internal_range(NFT_TEXT, expect(k))
    4999. 

  4999.                     else
    5000. 

  5000.                         allInExtRange = .false.
    5001. 

  5001.                     end if
    5002. 

  5002. 3               continue
    5003. 

  5003.                 err = nf_get_att_text(ncid, i, ATT_NAME(j,i), value)
    5004. 

  5004.                 if (canConvert .or. ATT_LEN(j,i) .eq. 0) then
    5005. 

  5005.                     if (allInExtRange) then
    5006. 

  5006.                         if (allInIntRange) then
    5007. 

  5007.                             if (err .ne. 0)
    5008. 

  5008.      +                          call errore('nf_get_att_text: ', err)
    5009. 

  5009.                         else
    5010. 

  5010.                             if (err .ne. NF_ERANGE)
    5011. 

  5011.      +                          call errore('Range error: ', err)
    5012. 

  5012.                         end if
    5013. 

  5013.                     else
    5014. 

  5014.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    5015. 

  5015.      +                      call errore('OK or Range error: ',
    5016. 

  5016.      +                                  err)
    5017. 

  5017.                     end if
    5018. 

  5018.                     do 4, k = 1, ATT_LEN(j,i)
    5019. 

  5019.                         if (inRange3(expect(k),ATT_TYPE(j,i),
    5020. 

  5020.      +                               NFT_TEXT) .and.
    5021. 

  5021.      +                      in_internal_range(NFT_TEXT,
    5022. 

  5022.      +                                        expect(k))) then
    5023. 

  5023.                             val = ichar(value(k))
    5024. 

  5024.                             if (.not.equal(val, expect(k),
    5025. 

  5025.      +                                     ATT_TYPE(j,i), 
    5026. 

  5026.      +                                     NFT_TEXT))then
    5027. 

  5027.                                 call error(
    5028. 

  5028.      +                              'value read not that expected')
    5029. 

  5029.                                 if (verbose) then
    5030. 

  5030.                                     call error(' ')
    5031. 

  5031.                                     call errori('varid: ', i)
    5032. 

  5032.                                     call errorc('att_name: ', 
    5033. 

  5033.      +                                  ATT_NAME(j,i))
    5034. 

  5034.                                     call errori('element number: ', k)
    5035. 

  5035.                                     call errord('expect: ', expect(k))
    5036. 

  5036.                                     call errord('got: ', val)
    5037. 

  5037.                                 end if
    5038. 

  5038.                             else
    5039. 

  5039.                                 nok = nok + 1
    5040. 

  5040.                             end if
    5041. 

  5041.                         end if
    5042. 

  5042. 4                   continue
    5043. 

  5043.                 else
    5044. 

  5044.                     if (err .ne. NF_ECHAR)
    5045. 

  5045.      +                  call errore('wrong type: ', err)
    5046. 

  5046.                 end if
    5047. 

  5047. 2           continue
    5048. 

  5048. 1       continue
    5049. 

  5049. 

  5050.         err = nf_close(ncid)
    5051. 

  5051.         if (err .ne. 0)
    5052. 

  5052.      +      call errore('nf_close: ', err)
    5053. 

  5053.         call print_nok(nok)
    5054. 

  5054.         end
    5055. 

  5055. 

  5056. #ifdef NF_INT1_T
    5057. 

  5057.         subroutine test_nf_get_att_int1()
    5058. 

  5058.         implicit        none
    5059. 

  5059. #include "tests.inc"
    5060. 

  5060.         integer ncid
    5061. 

  5061.         integer i
    5062. 

  5062.         integer j
    5063. 

  5063.         integer k
    5064. 

  5064.         integer err
    5065. 

  5065.         integer ndx(1)
    5066. 

  5066.         logical allInExtRange
    5067. 

  5067.         logical allInIntRange
    5068. 

  5068.         logical canConvert     
    5069. 

  5069.         NF_INT1_T    value(MAX_NELS)
    5070. 

  5070.         doubleprecision expect(MAX_NELS)
    5071. 

  5071.         integer nok             
    5072. 

  5072.         doubleprecision val
    5073. 

  5073. 

  5074.         nok = 0
    5075. 

  5075. 

  5076.         err = nf_open(testfile, NF_NOWRITE, ncid)
    5077. 

  5077.         if (err .ne. 0) 
    5078. 

  5078.      +      call errore('nf_open: ', err)
    5079. 

  5079. 

  5080.         do 1, i = 0, NVARS
    5081. 

  5081.             do 2, j = 1, NATTS(i)
    5082. 

  5082.                 canConvert = (ATT_TYPE(j,i) .eq. NF_CHAR) .eqv.
    5083. 

  5083.      +                       (NFT_INT1 .eq. NFT_TEXT)
    5084. 

  5084.                 err = nf_get_att_int1(BAD_ID, i,
    5085. 

  5085.      +                  ATT_NAME(j,i), 
    5086. 

  5086.      +                  value)
    5087. 

  5087.                 if (err .ne. NF_EBADID) 
    5088. 

  5088.      +              call errore('bad ncid: ', err)
    5089. 

  5089.                 err = nf_get_att_int1(ncid, BAD_VARID, 
    5090. 

  5090.      +                              ATT_NAME(j,i), 
    5091. 

  5091.      +                              value)
    5092. 

  5092.                 if (err .ne. NF_ENOTVAR) 
    5093. 

  5093.      +              call errore('bad var id: ', err)
    5094. 

  5094.                 err = nf_get_att_int1(ncid, i, 'noSuch', value)
    5095. 

  5095.                 if (err .ne. NF_ENOTATT) 
    5096. 

  5096.      +              call errore('Bad attribute name: ', err)
    5097. 

  5097.                 allInIntRange = .true.
    5098. 

  5098.                 allInExtRange = .true.
    5099. 

  5099.                 do 3, k = 1, ATT_LEN(j,i)
    5100. 

  5100.                     ndx(1) = k
    5101. 

  5101.                     expect(k) = hash4(ATT_TYPE(j,i), -1, ndx, 
    5102. 

  5102.      +                                NFT_INT1)
    5103. 

  5103.                     if (inRange3(expect(k),ATT_TYPE(j,i),
    5104. 

  5104.      +                           NFT_INT1)) then
    5105. 

  5105.                         allInIntRange = 
    5106. 

  5106.      +                      allInIntRange .and.
    5107. 

  5107.      +                      in_internal_range(NFT_INT1, expect(k))
    5108. 

  5108.                     else
    5109. 

  5109.                         allInExtRange = .false.
    5110. 

  5110.                     end if
    5111. 

  5111. 3               continue
    5112. 

  5112.                 err = nf_get_att_int1(ncid, i, ATT_NAME(j,i), value)
    5113. 

  5113.                 if (canConvert .or. ATT_LEN(j,i) .eq. 0) then
    5114. 

  5114.                     if (allInExtRange) then
    5115. 

  5115.                         if (allInIntRange) then
    5116. 

  5116.                             if (err .ne. 0)
    5117. 

  5117.      +                          call errore('nf_get_att_int1: ', err)
    5118. 

  5118.                         else
    5119. 

  5119.                             if (err .ne. NF_ERANGE)
    5120. 

  5120.      +                          call errore('Range error: ', err)
    5121. 

  5121.                         end if
    5122. 

  5122.                     else
    5123. 

  5123.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    5124. 

  5124.      +                      call errore('OK or Range error: ',
    5125. 

  5125.      +                                  err)
    5126. 

  5126.                     end if
    5127. 

  5127.                     do 4, k = 1, ATT_LEN(j,i)
    5128. 

  5128.                         if (inRange3(expect(k),ATT_TYPE(j,i),
    5129. 

  5129.      +                               NFT_INT1) .and.
    5130. 

  5130.      +                      in_internal_range(NFT_INT1,
    5131. 

  5131.      +                                        expect(k))) then
    5132. 

  5132.                             val = value(k)
    5133. 

  5133.                             if (.not.equal(val, expect(k),
    5134. 

  5134.      +                                     ATT_TYPE(j,i), 
    5135. 

  5135.      +                                     NFT_INT1))then
    5136. 

  5136.                                 call error(
    5137. 

  5137.      +                              'value read not that expected')
    5138. 

  5138.                                 if (verbose) then
    5139. 

  5139.                                     call error(' ')
    5140. 

  5140.                                     call errori('varid: ', i)
    5141. 

  5141.                                     call errorc('att_name: ', 
    5142. 

  5142.      +                                  ATT_NAME(j,i))
    5143. 

  5143.                                     call errori('element number: ', k)
    5144. 

  5144.                                     call errord('expect: ', expect(k))
    5145. 

  5145.                                     call errord('got: ', val)
    5146. 

  5146.                                 end if
    5147. 

  5147.                             else
    5148. 

  5148.                                 nok = nok + 1
    5149. 

  5149.                             end if
    5150. 

  5150.                         end if
    5151. 

  5151. 4                   continue
    5152. 

  5152.                 else
    5153. 

  5153.                     if (err .ne. NF_ECHAR)
    5154. 

  5154.      +                  call errore('wrong type: ', err)
    5155. 

  5155.                 end if
    5156. 

  5156. 2           continue
    5157. 

  5157. 1       continue
    5158. 

  5158. 

  5159.         err = nf_close(ncid)
    5160. 

  5160.         if (err .ne. 0)
    5161. 

  5161.      +      call errore('nf_close: ', err)
    5162. 

  5162.         call print_nok(nok)
    5163. 

  5163.         end
    5164. 

  5164. 

  5165. #endif
    5166. 

  5166. #ifdef NF_INT2_T
    5167. 

  5167.         subroutine test_nf_get_att_int2()
    5168. 

  5168.         implicit        none
    5169. 

  5169. #include "tests.inc"
    5170. 

  5170.         integer ncid
    5171. 

  5171.         integer i
    5172. 

  5172.         integer j
    5173. 

  5173.         integer k
    5174. 

  5174.         integer err
    5175. 

  5175.         integer ndx(1)
    5176. 

  5176.         logical allInExtRange
    5177. 

  5177.         logical allInIntRange
    5178. 

  5178.         logical canConvert     
    5179. 

  5179.         NF_INT2_T    value(MAX_NELS)
    5180. 

  5180.         doubleprecision expect(MAX_NELS)
    5181. 

  5181.         integer nok             
    5182. 

  5182.         doubleprecision val
    5183. 

  5183. 

  5184.         nok = 0
    5185. 

  5185. 

  5186.         err = nf_open(testfile, NF_NOWRITE, ncid)
    5187. 

  5187.         if (err .ne. 0) 
    5188. 

  5188.      +      call errore('nf_open: ', err)
    5189. 

  5189. 

  5190.         do 1, i = 0, NVARS
    5191. 

  5191.             do 2, j = 1, NATTS(i)
    5192. 

  5192.                 canConvert = (ATT_TYPE(j,i) .eq. NF_CHAR) .eqv.
    5193. 

  5193.      +                       (NFT_INT2 .eq. NFT_TEXT)
    5194. 

  5194.                 err = nf_get_att_int2(BAD_ID, i,
    5195. 

  5195.      +                  ATT_NAME(j,i), 
    5196. 

  5196.      +                  value)
    5197. 

  5197.                 if (err .ne. NF_EBADID) 
    5198. 

  5198.      +              call errore('bad ncid: ', err)
    5199. 

  5199.                 err = nf_get_att_int2(ncid, BAD_VARID, 
    5200. 

  5200.      +                              ATT_NAME(j,i), 
    5201. 

  5201.      +                              value)
    5202. 

  5202.                 if (err .ne. NF_ENOTVAR) 
    5203. 

  5203.      +              call errore('bad var id: ', err)
    5204. 

  5204.                 err = nf_get_att_int2(ncid, i, 'noSuch', value)
    5205. 

  5205.                 if (err .ne. NF_ENOTATT) 
    5206. 

  5206.      +              call errore('Bad attribute name: ', err)
    5207. 

  5207.                 allInIntRange = .true.
    5208. 

  5208.                 allInExtRange = .true.
    5209. 

  5209.                 do 3, k = 1, ATT_LEN(j,i)
    5210. 

  5210.                     ndx(1) = k
    5211. 

  5211.                     expect(k) = hash4(ATT_TYPE(j,i), -1, ndx, 
    5212. 

  5212.      +                                NFT_INT2)
    5213. 

  5213.                     if (inRange3(expect(k),ATT_TYPE(j,i),
    5214. 

  5214.      +                           NFT_INT2)) then
    5215. 

  5215.                         allInIntRange = 
    5216. 

  5216.      +                      allInIntRange .and.
    5217. 

  5217.      +                      in_internal_range(NFT_INT2, expect(k))
    5218. 

  5218.                     else
    5219. 

  5219.                         allInExtRange = .false.
    5220. 

  5220.                     end if
    5221. 

  5221. 3               continue
    5222. 

  5222.                 err = nf_get_att_int2(ncid, i, ATT_NAME(j,i), value)
    5223. 

  5223.                 if (canConvert .or. ATT_LEN(j,i) .eq. 0) then
    5224. 

  5224.                     if (allInExtRange) then
    5225. 

  5225.                         if (allInIntRange) then
    5226. 

  5226.                             if (err .ne. 0)
    5227. 

  5227.      +                          call errore('nf_get_att_int2: ', err)
    5228. 

  5228.                         else
    5229. 

  5229.                             if (err .ne. NF_ERANGE)
    5230. 

  5230.      +                          call errore('Range error: ', err)
    5231. 

  5231.                         end if
    5232. 

  5232.                     else
    5233. 

  5233.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    5234. 

  5234.      +                      call errore('OK or Range error: ',
    5235. 

  5235.      +                                  err)
    5236. 

  5236.                     end if
    5237. 

  5237.                     do 4, k = 1, ATT_LEN(j,i)
    5238. 

  5238.                         if (inRange3(expect(k),ATT_TYPE(j,i),
    5239. 

  5239.      +                               NFT_INT2) .and.
    5240. 

  5240.      +                      in_internal_range(NFT_INT2,
    5241. 

  5241.      +                                        expect(k))) then
    5242. 

  5242.                             val = value(k)
    5243. 

  5243.                             if (.not.equal(val, expect(k),
    5244. 

  5244.      +                                     ATT_TYPE(j,i), 
    5245. 

  5245.      +                                     NFT_INT2))then
    5246. 

  5246.                                 call error(
    5247. 

  5247.      +                              'value read not that expected')
    5248. 

  5248.                                 if (verbose) then
    5249. 

  5249.                                     call error(' ')
    5250. 

  5250.                                     call errori('varid: ', i)
    5251. 

  5251.                                     call errorc('att_name: ', 
    5252. 

  5252.      +                                  ATT_NAME(j,i))
    5253. 

  5253.                                     call errori('element number: ', k)
    5254. 

  5254.                                     call errord('expect: ', expect(k))
    5255. 

  5255.                                     call errord('got: ', val)
    5256. 

  5256.                                 end if
    5257. 

  5257.                             else
    5258. 

  5258.                                 nok = nok + 1
    5259. 

  5259.                             end if
    5260. 

  5260.                         end if
    5261. 

  5261. 4                   continue
    5262. 

  5262.                 else
    5263. 

  5263.                     if (err .ne. NF_ECHAR)
    5264. 

  5264.      +                  call errore('wrong type: ', err)
    5265. 

  5265.                 end if
    5266. 

  5266. 2           continue
    5267. 

  5267. 1       continue
    5268. 

  5268. 

  5269.         err = nf_close(ncid)
    5270. 

  5270.         if (err .ne. 0)
    5271. 

  5271.      +      call errore('nf_close: ', err)
    5272. 

  5272.         call print_nok(nok)
    5273. 

  5273.         end
    5274. 

  5274. 

  5275. #endif
    5276. 

  5276.         subroutine test_nf_get_att_int()
    5277. 

  5277.         implicit        none
    5278. 

  5278. #include "tests.inc"
    5279. 

  5279.         integer ncid
    5280. 

  5280.         integer i
    5281. 

  5281.         integer j
    5282. 

  5282.         integer k
    5283. 

  5283.         integer err
    5284. 

  5284.         integer ndx(1)
    5285. 

  5285.         logical allInExtRange
    5286. 

  5286.         logical allInIntRange
    5287. 

  5287.         logical canConvert     
    5288. 

  5288.         integer    value(MAX_NELS)
    5289. 

  5289.         doubleprecision expect(MAX_NELS)
    5290. 

  5290.         integer nok             
    5291. 

  5291.         doubleprecision val
    5292. 

  5292. 

  5293.         nok = 0
    5294. 

  5294. 

  5295.         err = nf_open(testfile, NF_NOWRITE, ncid)
    5296. 

  5296.         if (err .ne. 0) 
    5297. 

  5297.      +      call errore('nf_open: ', err)
    5298. 

  5298. 

  5299.         do 1, i = 0, NVARS
    5300. 

  5300.             do 2, j = 1, NATTS(i)
    5301. 

  5301.                 canConvert = (ATT_TYPE(j,i) .eq. NF_CHAR) .eqv.
    5302. 

  5302.      +                       (NFT_INT .eq. NFT_TEXT)
    5303. 

  5303.                 err = nf_get_att_int(BAD_ID, i,
    5304. 

  5304.      +                  ATT_NAME(j,i), 
    5305. 

  5305.      +                  value)
    5306. 

  5306.                 if (err .ne. NF_EBADID) 
    5307. 

  5307.      +              call errore('bad ncid: ', err)
    5308. 

  5308.                 err = nf_get_att_int(ncid, BAD_VARID, 
    5309. 

  5309.      +                              ATT_NAME(j,i), 
    5310. 

  5310.      +                              value)
    5311. 

  5311.                 if (err .ne. NF_ENOTVAR) 
    5312. 

  5312.      +              call errore('bad var id: ', err)
    5313. 

  5313.                 err = nf_get_att_int(ncid, i, 'noSuch', value)
    5314. 

  5314.                 if (err .ne. NF_ENOTATT) 
    5315. 

  5315.      +              call errore('Bad attribute name: ', err)
    5316. 

  5316.                 allInIntRange = .true.
    5317. 

  5317.                 allInExtRange = .true.
    5318. 

  5318.                 do 3, k = 1, ATT_LEN(j,i)
    5319. 

  5319.                     ndx(1) = k
    5320. 

  5320.                     expect(k) = hash4(ATT_TYPE(j,i), -1, ndx, 
    5321. 

  5321.      +                                NFT_INT)
    5322. 

  5322.                     if (inRange3(expect(k),ATT_TYPE(j,i),
    5323. 

  5323.      +                           NFT_INT)) then
    5324. 

  5324.                         allInIntRange = 
    5325. 

  5325.      +                      allInIntRange .and.
    5326. 

  5326.      +                      in_internal_range(NFT_INT, expect(k))
    5327. 

  5327.                     else
    5328. 

  5328.                         allInExtRange = .false.
    5329. 

  5329.                     end if
    5330. 

  5330. 3               continue
    5331. 

  5331.                 err = nf_get_att_int(ncid, i, ATT_NAME(j,i), value)
    5332. 

  5332.                 if (canConvert .or. ATT_LEN(j,i) .eq. 0) then
    5333. 

  5333.                     if (allInExtRange) then
    5334. 

  5334.                         if (allInIntRange) then
    5335. 

  5335.                             if (err .ne. 0)
    5336. 

  5336.      +                          call errore('nf_get_att_int: ', err)
    5337. 

  5337.                         else
    5338. 

  5338.                             if (err .ne. NF_ERANGE)
    5339. 

  5339.      +                          call errore('Range error: ', err)
    5340. 

  5340.                         end if
    5341. 

  5341.                     else
    5342. 

  5342.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    5343. 

  5343.      +                      call errore('OK or Range error: ',
    5344. 

  5344.      +                                  err)
    5345. 

  5345.                     end if
    5346. 

  5346.                     do 4, k = 1, ATT_LEN(j,i)
    5347. 

  5347.                         if (inRange3(expect(k),ATT_TYPE(j,i),
    5348. 

  5348.      +                               NFT_INT) .and.
    5349. 

  5349.      +                      in_internal_range(NFT_INT,
    5350. 

  5350.      +                                        expect(k))) then
    5351. 

  5351.                             val = value(k)
    5352. 

  5352.                             if (.not.equal(val, expect(k),
    5353. 

  5353.      +                                     ATT_TYPE(j,i), 
    5354. 

  5354.      +                                     NFT_INT))then
    5355. 

  5355.                                 call error(
    5356. 

  5356.      +                              'value read not that expected')
    5357. 

  5357.                                 if (verbose) then
    5358. 

  5358.                                     call error(' ')
    5359. 

  5359.                                     call errori('varid: ', i)
    5360. 

  5360.                                     call errorc('att_name: ', 
    5361. 

  5361.      +                                  ATT_NAME(j,i))
    5362. 

  5362.                                     call errori('element number: ', k)
    5363. 

  5363.                                     call errord('expect: ', expect(k))
    5364. 

  5364.                                     call errord('got: ', val)
    5365. 

  5365.                                 end if
    5366. 

  5366.                             else
    5367. 

  5367.                                 nok = nok + 1
    5368. 

  5368.                             end if
    5369. 

  5369.                         end if
    5370. 

  5370. 4                   continue
    5371. 

  5371.                 else
    5372. 

  5372.                     if (err .ne. NF_ECHAR)
    5373. 

  5373.      +                  call errore('wrong type: ', err)
    5374. 

  5374.                 end if
    5375. 

  5375. 2           continue
    5376. 

  5376. 1       continue
    5377. 

  5377. 

  5378.         err = nf_close(ncid)
    5379. 

  5379.         if (err .ne. 0)
    5380. 

  5380.      +      call errore('nf_close: ', err)
    5381. 

  5381.         call print_nok(nok)
    5382. 

  5382.         end
    5383. 

  5383. 

  5384.         subroutine test_nf_get_att_real()
    5385. 

  5385.         implicit        none
    5386. 

  5386. #include "tests.inc"
    5387. 

  5387.         integer ncid
    5388. 

  5388.         integer i
    5389. 

  5389.         integer j
    5390. 

  5390.         integer k
    5391. 

  5391.         integer err
    5392. 

  5392.         integer ndx(1)
    5393. 

  5393.         logical allInExtRange
    5394. 

  5394.         logical allInIntRange
    5395. 

  5395.         logical canConvert     
    5396. 

  5396.         real    value(MAX_NELS)
    5397. 

  5397.         doubleprecision expect(MAX_NELS)
    5398. 

  5398.         integer nok             
    5399. 

  5399.         doubleprecision val
    5400. 

  5400. 

  5401.         nok = 0
    5402. 

  5402. 

  5403.         err = nf_open(testfile, NF_NOWRITE, ncid)
    5404. 

  5404.         if (err .ne. 0) 
    5405. 

  5405.      +      call errore('nf_open: ', err)
    5406. 

  5406. 

  5407.         do 1, i = 0, NVARS
    5408. 

  5408.             do 2, j = 1, NATTS(i)
    5409. 

  5409.                 canConvert = (ATT_TYPE(j,i) .eq. NF_CHAR) .eqv.
    5410. 

  5410.      +                       (NFT_REAL .eq. NFT_TEXT)
    5411. 

  5411.                 err = nf_get_att_real(BAD_ID, i,
    5412. 

  5412.      +                  ATT_NAME(j,i), 
    5413. 

  5413.      +                  value)
    5414. 

  5414.                 if (err .ne. NF_EBADID) 
    5415. 

  5415.      +              call errore('bad ncid: ', err)
    5416. 

  5416.                 err = nf_get_att_real(ncid, BAD_VARID, 
    5417. 

  5417.      +                              ATT_NAME(j,i), 
    5418. 

  5418.      +                              value)
    5419. 

  5419.                 if (err .ne. NF_ENOTVAR) 
    5420. 

  5420.      +              call errore('bad var id: ', err)
    5421. 

  5421.                 err = nf_get_att_real(ncid, i, 'noSuch', value)
    5422. 

  5422.                 if (err .ne. NF_ENOTATT) 
    5423. 

  5423.      +              call errore('Bad attribute name: ', err)
    5424. 

  5424.                 allInIntRange = .true.
    5425. 

  5425.                 allInExtRange = .true.
    5426. 

  5426.                 do 3, k = 1, ATT_LEN(j,i)
    5427. 

  5427.                     ndx(1) = k
    5428. 

  5428.                     expect(k) = hash4(ATT_TYPE(j,i), -1, ndx, 
    5429. 

  5429.      +                                NFT_REAL)
    5430. 

  5430.                     if (inRange3(expect(k),ATT_TYPE(j,i),
    5431. 

  5431.      +                           NFT_REAL)) then
    5432. 

  5432.                         allInIntRange = 
    5433. 

  5433.      +                      allInIntRange .and.
    5434. 

  5434.      +                      in_internal_range(NFT_REAL, expect(k))
    5435. 

  5435.                     else
    5436. 

  5436.                         allInExtRange = .false.
    5437. 

  5437.                     end if
    5438. 

  5438. 3               continue
    5439. 

  5439.                 err = nf_get_att_real(ncid, i, ATT_NAME(j,i), value)
    5440. 

  5440.                 if (canConvert .or. ATT_LEN(j,i) .eq. 0) then
    5441. 

  5441.                     if (allInExtRange) then
    5442. 

  5442.                         if (allInIntRange) then
    5443. 

  5443.                             if (err .ne. 0)
    5444. 

  5444.      +                          call errore('nf_get_att_real: ', err)
    5445. 

  5445.                         else
    5446. 

  5446.                             if (err .ne. NF_ERANGE)
    5447. 

  5447.      +                          call errore('Range error: ', err)
    5448. 

  5448.                         end if
    5449. 

  5449.                     else
    5450. 

  5450.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    5451. 

  5451.      +                      call errore('OK or Range error: ',
    5452. 

  5452.      +                                  err)
    5453. 

  5453.                     end if
    5454. 

  5454.                     do 4, k = 1, ATT_LEN(j,i)
    5455. 

  5455.                         if (inRange3(expect(k),ATT_TYPE(j,i),
    5456. 

  5456.      +                               NFT_REAL) .and.
    5457. 

  5457.      +                      in_internal_range(NFT_REAL,
    5458. 

  5458.      +                                        expect(k))) then
    5459. 

  5459.                             val = value(k)
    5460. 

  5460.                             if (.not.equal(val, expect(k),
    5461. 

  5461.      +                                     ATT_TYPE(j,i), 
    5462. 

  5462.      +                                     NFT_REAL))then
    5463. 

  5463.                                 call error(
    5464. 

  5464.      +                              'value read not that expected')
    5465. 

  5465.                                 if (verbose) then
    5466. 

  5466.                                     call error(' ')
    5467. 

  5467.                                     call errori('varid: ', i)
    5468. 

  5468.                                     call errorc('att_name: ', 
    5469. 

  5469.      +                                  ATT_NAME(j,i))
    5470. 

  5470.                                     call errori('element number: ', k)
    5471. 

  5471.                                     call errord('expect: ', expect(k))
    5472. 

  5472.                                     call errord('got: ', val)
    5473. 

  5473.                                 end if
    5474. 

  5474.                             else
    5475. 

  5475.                                 nok = nok + 1
    5476. 

  5476.                             end if
    5477. 

  5477.                         end if
    5478. 

  5478. 4                   continue
    5479. 

  5479.                 else
    5480. 

  5480.                     if (err .ne. NF_ECHAR)
    5481. 

  5481.      +                  call errore('wrong type: ', err)
    5482. 

  5482.                 end if
    5483. 

  5483. 2           continue
    5484. 

  5484. 1       continue
    5485. 

  5485. 

  5486.         err = nf_close(ncid)
    5487. 

  5487.         if (err .ne. 0)
    5488. 

  5488.      +      call errore('nf_close: ', err)
    5489. 

  5489.         call print_nok(nok)
    5490. 

  5490.         end
    5491. 

  5491. 

  5492.         subroutine test_nf_get_att_double()
    5493. 

  5493.         implicit        none
    5494. 

  5494. #include "tests.inc"
    5495. 

  5495.         integer ncid
    5496. 

  5496.         integer i
    5497. 

  5497.         integer j
    5498. 

  5498.         integer k
    5499. 

  5499.         integer err
    5500. 

  5500.         integer ndx(1)
    5501. 

  5501.         logical allInExtRange
    5502. 

  5502.         logical allInIntRange
    5503. 

  5503.         logical canConvert     
    5504. 

  5504.         doubleprecision    value(MAX_NELS)
    5505. 

  5505.         doubleprecision expect(MAX_NELS)
    5506. 

  5506.         integer nok             
    5507. 

  5507.         doubleprecision val
    5508. 

  5508. 

  5509.         nok = 0
    5510. 

  5510. 

  5511.         err = nf_open(testfile, NF_NOWRITE, ncid)
    5512. 

  5512.         if (err .ne. 0) 
    5513. 

  5513.      +      call errore('nf_open: ', err)
    5514. 

  5514. 

  5515.         do 1, i = 0, NVARS
    5516. 

  5516.             do 2, j = 1, NATTS(i)
    5517. 

  5517.                 canConvert = (ATT_TYPE(j,i) .eq. NF_CHAR) .eqv.
    5518. 

  5518.      +                       (NFT_DOUBLE .eq. NFT_TEXT)
    5519. 

  5519.                 err = nf_get_att_double(BAD_ID, i,
    5520. 

  5520.      +                  ATT_NAME(j,i), 
    5521. 

  5521.      +                  value)
    5522. 

  5522.                 if (err .ne. NF_EBADID) 
    5523. 

  5523.      +              call errore('bad ncid: ', err)
    5524. 

  5524.                 err = nf_get_att_double(ncid, BAD_VARID, 
    5525. 

  5525.      +                              ATT_NAME(j,i), 
    5526. 

  5526.      +                              value)
    5527. 

  5527.                 if (err .ne. NF_ENOTVAR) 
    5528. 

  5528.      +              call errore('bad var id: ', err)
    5529. 

  5529.                 err = nf_get_att_double(ncid, i, 'noSuch', value)
    5530. 

  5530.                 if (err .ne. NF_ENOTATT) 
    5531. 

  5531.      +              call errore('Bad attribute name: ', err)
    5532. 

  5532.                 allInIntRange = .true.
    5533. 

  5533.                 allInExtRange = .true.
    5534. 

  5534.                 do 3, k = 1, ATT_LEN(j,i)
    5535. 

  5535.                     ndx(1) = k
    5536. 

  5536.                     expect(k) = hash4(ATT_TYPE(j,i), -1, ndx, 
    5537. 

  5537.      +                                NFT_DOUBLE)
    5538. 

  5538.                     if (inRange3(expect(k),ATT_TYPE(j,i),
    5539. 

  5539.      +                           NFT_DOUBLE)) then
    5540. 

  5540.                         allInIntRange = 
    5541. 

  5541.      +                      allInIntRange .and.
    5542. 

  5542.      +                      in_internal_range(NFT_DOUBLE, expect(k))
    5543. 

  5543.                     else
    5544. 

  5544.                         allInExtRange = .false.
    5545. 

  5545.                     end if
    5546. 

  5546. 3               continue
    5547. 

  5547.                 err = nf_get_att_double(ncid, i, ATT_NAME(j,i), value)
    5548. 

  5548.                 if (canConvert .or. ATT_LEN(j,i) .eq. 0) then
    5549. 

  5549.                     if (allInExtRange) then
    5550. 

  5550.                         if (allInIntRange) then
    5551. 

  5551.                             if (err .ne. 0)
    5552. 

  5552.      +                          call errore('nf_get_att_double: ', err)
    5553. 

  5553.                         else
    5554. 

  5554.                             if (err .ne. NF_ERANGE)
    5555. 

  5555.      +                          call errore('Range error: ', err)
    5556. 

  5556.                         end if
    5557. 

  5557.                     else
    5558. 

  5558.                         if (err .ne. 0 .and. err .ne. NF_ERANGE)
    5559. 

  5559.      +                      call errore('OK or Range error: ',
    5560. 

  5560.      +                                  err)
    5561. 

  5561.                     end if
    5562. 

  5562.                     do 4, k = 1, ATT_LEN(j,i)
    5563. 

  5563.                         if (inRange3(expect(k),ATT_TYPE(j,i),
    5564. 

  5564.      +                               NFT_DOUBLE) .and.
    5565. 

  5565.      +                      in_internal_range(NFT_DOUBLE,
    5566. 

  5566.      +                                        expect(k))) then
    5567. 

  5567.                             val = value(k)
    5568. 

  5568.                             if (.not.equal(val, expect(k),
    5569. 

  5569.      +                                     ATT_TYPE(j,i), 
    5570. 

  5570.      +                                     NFT_DOUBLE))then
    5571. 

  5571.                                 call error(
    5572. 

  5572.      +                              'value read not that expected')
    5573. 

  5573.                                 if (verbose) then
    5574. 

  5574.                                     call error(' ')
    5575. 

  5575.                                     call errori('varid: ', i)
    5576. 

  5576.                                     call errorc('att_name: ', 
    5577. 

  5577.      +                                  ATT_NAME(j,i))
    5578. 

  5578.                                     call errori('element number: ', k)
    5579. 

  5579.                                     call errord('expect: ', expect(k))
    5580. 

  5580.                                     call errord('got: ', val)
    5581. 

  5581.                                 end if
    5582. 

  5582.                             else
    5583. 

  5583.                                 nok = nok + 1
    5584. 

  5584.                             end if
    5585. 

  5585.                         end if
    5586. 

  5586. 4                   continue
    5587. 

  5587.                 else
    5588. 

  5588.                     if (err .ne. NF_ECHAR)
    5589. 

  5589.      +                  call errore('wrong type: ', err)
    5590. 

  5590.                 end if
    5591. 

  5591. 2           continue
    5592. 

  5592. 1       continue
    5593. 

  5593. 

  5594.         err = nf_close(ncid)
    5595. 

  5595.         if (err .ne. 0)
    5596. 

  5596.      +      call errore('nf_close: ', err)
    5597. 

  5597.         call print_nok(nok)
    5598. 

  5598.         end
    5599. 

  5599. 

  5600.