home *** CD-ROM | disk | FTP | other *** search
/ Photo CD Demo 1 / Demo.bin / hdf / unix / hdf3_2r2 / test / t24f.f < prev    next >
Encoding:
Text File  |  1992-10-29  |  8.8 KB  |  297 lines
  1. C***************************************************************************
  2. C
  3. C
  4. C                         NCSA HDF version 3.2r2
  5. C                            October 30, 1992
  6. C
  7. C NCSA HDF Version 3.2 source code and documentation are in the public
  8. C domain.  Specifically, we give to the public domain all rights for future
  9. C licensing of the source code, all resale rights, and all publishing rights.
  10. C
  11. C We ask, but do not require, that the following message be included in all
  12. C derived works:
  13. C
  14. C Portions developed at the National Center for Supercomputing Applications at
  15. C the University of Illinois at Urbana-Champaign, in collaboration with the
  16. C Information Technology Institute of Singapore.
  17. C
  18. C THE UNIVERSITY OF ILLINOIS GIVES NO WARRANTY, EXPRESSED OR IMPLIED, FOR THE
  19. C SOFTWARE AND/OR DOCUMENTATION PROVIDED, INCLUDING, WITHOUT LIMITATION,
  20. C WARRANTY OF MERCHANTABILITY AND WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE
  21. C
  22. C***************************************************************************
  23.  
  24. C
  25. C $Header: /hdf/hdf/v3.2r2/test/RCS/t24f.f,v 1.2 1992/07/06 19:33:10 mlivin beta koziol $
  26. C
  27. C $Log: t24f.f,v $
  28. c Revision 1.2  1992/07/06  19:33:10  mlivin
  29. c removed declaration of variable that wasn't used
  30. c
  31. c Revision 1.1  1992/04/27  17:07:49  sxu
  32. c Initial revision
  33. c
  34. C
  35.       program tdf24F
  36.  
  37. C
  38. C Test Program: 
  39. C             Writes 24-bit raster images with specified interlace 
  40. C           code to a file.
  41. C        Reads the images and their dimensions from the file.
  42. C Input file: none
  43. C Output file: tdf24f.hdf
  44. C
  45. C
  46.       integer d2setil, d2reqil, d2pimg, d2aimg
  47.       integer d2gdims, d2gimg, d2first
  48.  
  49.       integer d1, d2, il
  50.       character*80 TESTFILE
  51.       character*1 CR
  52.       character buf(3, 2, 2), buf1(2, 3, 2), buf2(2, 2, 3)
  53.       character in(3,2,2), in1(2, 3, 2), in2(2, 2, 3)
  54.       integer i, j, k, ret, number_failed
  55.  
  56.       TESTFILE = 'tdf24f.hdf'
  57.       CR = char(10)
  58.       number_failed = 0
  59.  
  60.       do 150 i=1, 2
  61.           do 2 j=1, 2
  62.               buf(1, j, i) = char(i+j)
  63.               buf(2, j, i) = char(i+j)
  64.               buf(3, j, i) = char(i+j)
  65.               buf1(j, 1, i) = char(i-j)
  66.               buf1(j, 2, i) = char(i-j)
  67.               buf1(j, 3, i) = char(i-j)
  68.               buf2(j, i, 1) = char(2*i - j)
  69.               buf2(j, i, 2) = char(2*i - j)
  70.               buf2(j, i, 3) = char(2*i - j)
  71. 2       continue
  72. 150   continue
  73.       print *, 'Setting il to 0'
  74.       ret = d2setil(0)
  75.       call RESULT(ret, 'd2setil')
  76.       print *, ' Putting buffer 1'
  77.       ret = d2pimg(TESTFILE, buf, 2, 2)
  78.       call RESULT(ret, 'd2pimg')
  79.       print *, 'Setting il to 1'
  80.       ret = d2setil(1)
  81.       call RESULT(ret, 'd2setil')
  82.       print *, 'Adding buf1'
  83.       ret = d2aimg(TESTFILE, buf1, 2, 2)
  84.       call RESULT(ret, 'd2aimg')
  85.       print *, 'Setting il to 2'
  86.       ret = d2setil(2)
  87.       call RESULT(ret, 'd2setil')
  88.       print *, 'Adding buf2'
  89.       ret = d2aimg(TESTFILE, buf2, 2, 2)
  90.       call RESULT(ret, 'd2aimg')
  91.       print *, 'Restarting file'
  92.       ret = d2first()
  93.       call RESULT(ret, 'd2first')
  94.       print *, 'Req il 0'
  95.       ret = d2reqil(0)
  96.       call RESULT(ret, 'd2reqil')
  97.       print *, 'Getting dims'
  98.       ret = d2gdims(TESTFILE, d1, d2, il)
  99.       call RESULT(ret, 'd2gdims')
  100.       print *, 'd1:', d1,' d2:', d2, ' il:', il
  101.       print *, 'Getting image'
  102.       ret = d2gimg(TESTFILE, in, 2, 2)
  103.       call RESULT(ret, 'd2gimg')
  104.       do 200 i=1, 2
  105.           do 180 j=1, 2
  106.               do 160 k=1,3
  107.                   if (in(k,j,i) .ne. buf(k,j,i)) then
  108.                   print *, 'Error at  ', k, j, i
  109.                   endif
  110. 160           continue
  111. 180       continue
  112. 200   continue
  113.   
  114.       print *, 'Getting dimensions'
  115.       ret = d2gdims(TESTFILE, d1, d2, il)
  116.       call RESULT(ret, 'd2gdims')
  117.       print *,  'd1:', d1,' d2:', d2, ' il:', il
  118.       print *, 'Getting image'
  119.       ret = d2gimg(TESTFILE,  in, 2, 2)
  120.       call RESULT(ret, 'd2gimg')
  121.       do 250 i=1, 2
  122.           do 220 j=1, 2
  123.               do 210 k = 1, 3
  124.                   if (in(k,j,i) .ne. buf1(j,k,i) ) then
  125.                       print *, 'Error at  ', k, j, i
  126.                   endif
  127. 210           continue
  128. 220       continue
  129. 250   continue
  130.  
  131.       print *, 'Getting dimensions'
  132.       ret = d2gdims(TESTFILE, d1, d2, il)
  133.       call RESULT(ret, 'd2gdims')
  134.       print *,  'd1:', d1,' d2:', d2, ' il:', il
  135.       print *, 'Getting image'
  136.       ret = d2gimg(TESTFILE,  in, 2, 2)
  137.       call RESULT(ret, 'd2gimg')
  138.       do 300 i=1, 2
  139.           do 280 j=1, 2
  140.               do 260 k = 1, 3
  141.                   if (in(k,j,i) .ne. buf2(j,i,k)) then
  142.                       print *, 'Error at  ', k, j, i
  143.                   endif
  144. 260           continue
  145. 280       continue
  146. 300   continue
  147.  
  148.       print *, 'Restarting file'
  149.       ret = d2first()
  150.       call RESULT(ret, 'd2first')
  151.       print *, 'Req il 1'
  152.       ret = d2reqil(1)
  153.       call RESULT(ret, 'd2reqil')
  154.       print *, 'Getting dimensions'
  155.       ret = d2gdims(TESTFILE, d1, d2, il)
  156.       call RESULT(ret, 'd2gdims')
  157.       print *,  'd1:', d1,' d2:', d2, ' il:', il
  158.       print *, 'Getting image'
  159.       ret = d2gimg(TESTFILE,  in1, 2, 2)
  160.       call RESULT(ret, 'd2gimg')
  161.       do 350 i=1, 2
  162.           do 320 j=1, 2
  163.               do 310 k=1,3
  164.                  if (in1(j,k,i) .ne. buf(k,j,i)) then
  165.                      print *, 'Error at  ', k, j, i
  166.                  endif
  167. 310           continue
  168. 320       continue
  169. 350   continue
  170.  
  171.       print *, 'Getting dimensions'
  172.       ret = d2gdims(TESTFILE, d1, d2, il)
  173.       call RESULT(ret, 'd2gdims')
  174.       print *,  'd1:', d1,' d2:', d2, ' il:', il
  175.       print *, 'Getting image'
  176.       ret = d2gimg(TESTFILE,  in1, 2, 2)
  177.       call RESULT(ret, 'd2gimg')
  178.       do 400 i=1, 2
  179.           do 380 j=1, 2
  180.               do 360 k = 1, 3
  181.                   if (in1(j,k,i) .ne. buf1(j,k,i)) then
  182.                       print *, 'Error at  ', k,j,i
  183.                   endif
  184. 360           continue
  185. 380       continue
  186. 400   continue
  187.  
  188.       print *, 'Getting dimensions'
  189.       ret = d2gdims(TESTFILE, d1, d2, il)
  190.       call RESULT(ret, 'd2gdims')
  191.       print *,  'd1:', d1,' d2:', d2, ' il:', il
  192.       print *, 'Getting image'
  193.       ret = d2gimg(TESTFILE,  in1, 2, 2)
  194.       call RESULT(ret, 'd2gimg')
  195.       do 450 i=1, 2
  196.           do 420 j=1, 2
  197.               do 410 k =1, 3  
  198.                   if (in1(j,k,i) .ne. buf2(j,i,k)) then
  199.                       print *, 'Error at  ', k, j, i
  200.                   endif
  201. 410           continue
  202. 420       continue
  203. 450   continue
  204.  
  205.       print *, 'Restarting file'
  206.       ret = d2first()
  207.       call RESULT(ret, 'd2first')
  208.       print *, 'Req il 2'
  209.       ret = d2reqil(2)
  210.       call RESULT(ret, 'd2reqil')
  211.       print *, 'Getting dimensions'
  212.       ret = d2gdims(TESTFILE, d1, d2, il)
  213.       call RESULT(ret, 'd2gdims')
  214.       print *,  'd1:', d1,' d2:', d2, ' il:', il
  215.       print *, 'Getting image'
  216.       ret = d2gimg(TESTFILE,  in2, 2, 2)
  217.       call RESULT(ret, 'd2gimg')
  218.       do 500 i=1, 2
  219.           do 480 j=1, 2
  220.               do 460 k=1, 3
  221.                   if (in2(j,i,k) .ne. buf(k,j,i)) then
  222.                       print *, 'Error at  ', k, j, i 
  223.                   endif
  224. 460           continue
  225. 480       continue
  226. 500   continue
  227.  
  228.       print *, 'Getting dimensions'
  229.       ret = d2gdims(TESTFILE, d1, d2, il)
  230.       call RESULT(ret, 'd2gdims')
  231.       print *,  'd1:', d1,' d2:', d2, ' il:', il
  232.       print *, 'Getting image'
  233.       ret = d2gimg(TESTFILE,  in2, 2, 2)
  234.       call RESULT(ret, 'd2gimg')
  235.       do 550 i=1, 2
  236.           do 520 j=1, 2
  237.               do 510 k = 1,3
  238.                   if (in2(j,i,k) .ne. buf1(j,k,i)) then
  239.                       print *, 'Error at  ', k, j, i
  240.                   endif
  241. 510           continue
  242. 520       continue
  243. 550   continue
  244.  
  245.       print *, 'Getting dimensions'
  246.       ret = d2gdims(TESTFILE, d1, d2, il)
  247.       call RESULT(ret, 'd2gdims')
  248.       print *,  'd1:', d1,' d2:', d2, ' il:', il
  249.       print *, 'Getting image'
  250.       ret = d2gimg(TESTFILE,  in2, 2, 2)
  251.       call RESULT(ret, 'd2gimg')
  252.       do 600 i=1, 2
  253.           do 580 j=1, 2
  254.               do 560 k = 1, 3
  255.                   if (in2(k,j,i) .ne. buf2(k,j,i)) then
  256.                       print *, 'Error at  ', k, j, i
  257.                   endif
  258. 560           continue
  259. 580       continue
  260. 600   continue
  261.  
  262.       print *, CR, CR
  263.       if (number_failed .eq. 0) then 
  264.           print *, '****** ALL TESTS SUCCESSFUL ******'
  265.       else
  266.           print *, '****** ', number_failed, ' TESTS FAILES  ******'
  267.       endif
  268.  
  269.       stop 
  270.       end
  271.  
  272.  
  273. C*************************************************************
  274. C
  275. C  RESULT
  276. C
  277. C*************************************************************
  278.  
  279.       subroutine RESULT(errval, routine)
  280.       integer errval
  281.       character*(*)  routine
  282.  
  283.       integer FAIL
  284.  
  285.       FAIL = -1
  286.       if (errval .eq. FAIL) then
  287.           number_failed = number_failed + 1
  288.           print *, '    >>> ', routine, ' FAILED: ret = ',
  289.      *           errval, '    <<<'
  290.       else 
  291.       print *, routine, ' SUCCESSFUL'
  292.       endif
  293.       return
  294.       end
  295.  
  296.  
  297.