home *** CD-ROM | disk | FTP | other *** search
/ Photo CD Demo 1 / Demo.bin / hdf / unix / hdf3_2r2 / test / tpf.f < prev    next >
Encoding:
Text File  |  1992-10-29  |  6.0 KB  |  224 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/tpf.f,v 1.2 1992/06/25 19:16:20 chouck beta koziol $
  26. C
  27. C $Log: tpf.f,v $
  28. c Revision 1.2  1992/06/25  19:16:20  chouck
  29. c Changed double qutoes to single around string constants
  30. c
  31. c Revision 1.1  1992/04/27  17:07:49  sxu
  32. c Initial revision
  33. c
  34. C
  35.       program tdfpF
  36. C
  37. C
  38. C Test program: Writes palettes in a file.
  39. C               Reads palettes from the file.
  40. C               Writes palette with specified reference number.
  41. C               Reads palette with specified reference number.
  42. C
  43. C Input file: none
  44. C
  45. C Output file: tpalf.hdf
  46. C
  47. C
  48.  
  49.       integer dpppal, dpapal, dprest, dpgpal, dpnpals
  50.       integer dprref, dpwref
  51.       integer dplref
  52.  
  53.       character*64 TESTFILE
  54.       character*1 CR
  55.       character pal1(768), pal2(768), ipal(768)
  56.       integer ret 
  57.       integer*2  ref1, ref2
  58.       integer i, number_failed
  59.  
  60.  
  61.       TESTFILE = 'tpalf.hdf'
  62.       CR = char(10)
  63.       number_failed = 0
  64.  
  65.       do 100 i = 0, 255
  66.           pal1(3*i + 1) = char(i)
  67.           pal1(3*i + 2) = char(i) 
  68.           pal1(3*i + 3) = char(i)
  69.           pal2(i + 1) = char(i) 
  70.           pal2(i + 256 + 1) = char(i) 
  71.           pal2(i + 512 + 1) = char(i) 
  72. 100   continue
  73.  
  74.       Print *, 'Putting pal1 in new file.'
  75.       ret = dpppal(TESTFILE, pal1, 0, 'w')
  76.       call RESULT(ret, 'dpppal')
  77.  
  78.       print *, 'Getting ref1'
  79.       ref1 = dplref()
  80. C     call RESULT(ref1, 'dplref')
  81.       print *, 'ref1 is ', ref1
  82.  
  83.       print *, 'Putting pal2 in file'
  84.       ret = dpapal(TESTFILE, pal2)
  85.       call RESULT(ret, 'dpapal')
  86.  
  87.       print *, 'Getting ref2'
  88.       ref2 = dplref()
  89. C      call RESULT(ref2, 'dplref')
  90.       print *, 'ref2 is ', ref2
  91.      
  92.       print *, 'Restarting palette interface'
  93.       ret = dprest()
  94.       call RESULT(ret, 'dprest')
  95.  
  96.       print *, 'Reading pal1'
  97.       ret = dpgpal(TESTFILE, ipal)
  98.       call RESULT(ret, 'dpgpal')
  99.       do 200 i=1, 768
  100.           if (ipal(i) .ne. pal1(i))  then
  101.               print *, 'Error at ', i, ', ipal:', ipal(i), 
  102.      *                 '      pal1(i):', pal1(i)
  103.           endif
  104. 200   continue
  105.       
  106.       print *, 'Getting ref1'
  107.       ref1 =  dplref()
  108. C      call RESULT(ref1, 'dplref')
  109.       print *, 'Last ref is ', ref1
  110.  
  111.       print *, 'Reading pal2.'
  112.       ret = dpgpal(TESTFILE, ipal)
  113.       call RESULT(ret, 'dpgpal')
  114.       do 300 i=1, 768
  115.           if (ipal(i) .ne. pal2(i)) then
  116.               print *, 'Error at ', i, ', ipal:', ipal(i),
  117.      *                 '      pal2:', pal2(i)
  118.           endif
  119. 300   continue
  120.  
  121.       print *, 'Getting ref2'
  122.       ref2 = dplref()
  123. C      call RESULT(ref2, 'dplref')
  124.       print *, 'Last ref is ', ref2
  125.  
  126.       print *, 'Getting number of palettes'
  127.       ret = dpnpals(TESTFILE)
  128.       call RESULT(ret, 'dpnpals')
  129.       print *, 'Number of palettes is:', ret
  130.  
  131.       print *, 'Setting read ref to ref2.'
  132.       ret = dprref(TESTFILE, ref2)
  133.       call RESULT(ret, 'dprref')
  134.       
  135.       print *, 'Reading pal2'
  136.       ret = dpgpal(TESTFILE, ipal)
  137.       call RESULT(ret, 'dpgpal')
  138.       do 400 i=1, 768
  139.           if (ipal(i) .ne. pal2(i)) then
  140.               print *,  'Error at ', i, ', ipal:', ipal(i),
  141.      *                 '      pal2:', pal2(i)
  142.           endif
  143. 400   continue
  144.  
  145.       print *, 'Setting read ref to ref1.'
  146.          print *, 'ref1 is: ', ref1, ' ref2 is: ',ref2
  147.       ret = dprref(TESTFILE, ref1)
  148.  
  149.       call RESULT(ret, 'dprref')
  150.       
  151.       print *, 'Reading pal1'
  152.       ret = dpgpal(TESTFILE, ipal)
  153.       call RESULT(ret, 'dpgpal')
  154.  
  155.       do 500 i=1, 768
  156.           if (ipal(i) .ne. pal1(i)) then
  157.               print *,  'Error at ', i, ', ipal:', ipal(i),
  158.      *                 '      pal1:', pal1(i)
  159.           endif
  160. 500   continue
  161.  
  162.       print *, 'Modifying pal1'
  163.       do 600 i=1,256
  164.           pal1(i+256) = char(256-i)
  165. 600   continue
  166.  
  167.       print *, 'Setting write ref to ref1'
  168.       ret = dpwref(TESTFILE, ref1)
  169.       call RESULT(ret, 'dpwref')
  170.       print *, 'Writing pal1'
  171.       ret = dpppal(TESTFILE, pal1, 1, 'a')
  172.       call RESULT(ret, 'dpppal')
  173.       ret=dplref()
  174.       print *,'last ref is: ', ret
  175.       print *, 'setting read ref to ref1'
  176.       ret = dprref(TESTFILE, ref1)
  177.       call RESULT(ret, 'dprref')
  178.       print *, 'Reading pal1'
  179.       ret = dpgpal(TESTFILE, ipal)
  180.       call RESULT(ret, 'dpgpal')
  181.       do 700 i=1, 768
  182.           if (ipal(i) .ne. pal1(i)) then
  183.               print *,  'Error at ', i, ', ipal:', ipal(i),
  184.      *                 '      pal1:', pal1(i)
  185.           endif
  186. 700   continue
  187.  
  188.       print *, CR, CR
  189.       if (number_failed .ne. 0) then
  190.           print *, '***** ', number_failed, ' TEST FAILED '
  191.       else
  192.           print *, '***** ALL TESTS SUCCESSFUL *****'
  193.       endif
  194.  
  195.       stop
  196.       end
  197.  
  198.  
  199.  
  200.  
  201. C*******************************************
  202. C
  203. C   RESULT
  204. C
  205. C*******************************************
  206.  
  207.       subroutine RESULT(errval, routine)
  208.       integer errval
  209.       character*(*)  routine
  210.  
  211.       integer FAIL
  212.  
  213.       FAIL = -1
  214.       if (errval .eq. FAIL) then
  215.          number_failed = number_failed + 1
  216.          print *, '    >>>', routine, ' FAILED: ret = ',
  217.      *               errval, '   <<<'
  218.       else
  219.          print *, routine, '  SUCCESSFUL'
  220.       endif
  221.       return
  222.       end
  223.  
  224.