home *** CD-ROM | disk | FTP | other *** search
/ Photo CD Demo 1 / Demo.bin / hdf / unix / hdf3_2r2 / test / tanf.f < prev    next >
Encoding:
Text File  |  1992-10-29  |  10.0 KB  |  328 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/tanf.f,v 1.6 1992/05/29 18:29:36 chouck beta koziol $
  26. C
  27. C $Log: tanf.f,v $
  28. c Revision 1.6  1992/05/29  18:29:36  chouck
  29. c Fixed int16 / int32 problems.  Made buffer size 500 for RS/6000
  30. c
  31. c Revision 1.5  1992/05/29  15:20:58  sxu
  32. c declare tag's ref's and rank as int16
  33. c
  34. c Revision 1.4  1992/05/04  16:56:44  dilg
  35. c Added a call to INT() within call to CHAR() to make Cray compiler happy.
  36. c Changed calls to non-standard function JMOD() to calls to standard function
  37. c MOD().
  38. c
  39. c Revision 1.2  1992/04/27  17:20:31  sxu
  40. c Changed output file name.
  41. c
  42. c Revision 1.1  1992/03/23  22:55:42  mfolk
  43. c Initial revision
  44. c
  45. C
  46.  
  47.  
  48.       program tdfanF
  49. C
  50. C
  51. C  Test program: stores annotations in a file.
  52. C                Writes several SDSs and corresponding RISs to a file.
  53. C                Writes labels and descriptions for all but the first 
  54. C                   three SDSs.
  55. C                Writes labels and descriptions for all RISs.
  56. C
  57. C  Input file:  none
  58. C  Output files: tdfanF.hdf
  59. C
  60. C  Possible bug:  When reading in a label, we have to give it a 
  61. C                 length that is one greater than MAXLEN_LAB. This
  62. C                 may be due to a bug in dfan.c in DFANIgetann().
  63. C
  64.  
  65.       integer daplab, dapdesc  
  66.       integer dssdims, dsadata, dslref, dsgdims
  67.       integer d8aimg, DFR8lastref, d8gimg
  68.  
  69.       integer number_failed, ISFIRST, NOTFIRST, MAXLEN_LAB
  70.       integer MAXLEN_DESC, ROWS, COLS, REPS
  71.       integer DFTAG_SDG, DFTAG_RIG
  72.  
  73.       parameter ( ISFIRST =        1, 
  74.      *            NOTFIRST =       0, 
  75.      *            MAXLEN_LAB =    30,
  76.      *            MAXLEN_DESC =  500, 
  77.      *            DFTAG_SDG   =  700,
  78.      *            DFTAG_RIG   =  306,
  79.      *            ROWS =          10, 
  80.      *            COLS =          10,
  81.      *            REPS =           2 )
  82.  
  83.       integer refnum
  84.       integer ret
  85.       integer rank
  86.       integer j, dimsizes(2)
  87.  
  88.       character*30 labsds, labris
  89.       character*500 descsds, descris
  90.       character pal(768)
  91.       character*64 TESTFILE
  92.  
  93.       character*1 CR
  94.       character image(ROWS, COLS), newimage(ROWS, COLS)
  95.       real      data(ROWS, COLS)
  96.  
  97.       number_failed =  0
  98.       CR = char(10)
  99.       TESTFILE = 'tdfanF.hdf'
  100.  
  101. C *** set up object labels and descriptions ***
  102.  
  103.       labsds = 'Object label #1: sds'
  104.       labris = 'Object label #2: image'
  105.       descsds = 'Object Descr #1: 1  2  3  4  5  6  7  8  9 10 11 12 ' 
  106.      *          // CR // '                13 14 15 16 17 18 19 20 '
  107.      *          // ' **END SDS DESCR**'
  108.       descris = 'Object Descr #2: A B C D E F G H I J K L '
  109.      *          // CR // '                M N O **END IMAGE DESCR **'
  110.  
  111. C  *** generate float array and image ***
  112.  
  113.       rank = 2
  114.       dimsizes(1)=ROWS 
  115.       dimsizes(2)=COLS
  116.  
  117.       call gen2Dfloat(ROWS, COLS, data)
  118.       call genimage(ROWS, COLS, data, image)
  119.  
  120.       ret = dssdims(rank,dimsizes)
  121.       call RESULT(ret, 'dssdims')
  122.  
  123. C  ***  Write labels and descriptions ***
  124.  
  125.       print *,'***  Writing labels & descriptions with SDS and RIS ***'
  126.  
  127.       do 100 j=1,REPS
  128. C         write out scientific data set 
  129.           ret = dsadata(TESTFILE, rank,dimsizes, data)
  130.           call RESULT(ret, 'dsadata')
  131.  
  132. C         write out annotations for 2 out of every 3 
  133.           if (mod(j,3) .ne. 0) then 
  134.               refnum = dslref()
  135.               ret = daplab(TESTFILE, DFTAG_SDG, refnum, labsds)
  136.               call RESULT(ret, 'daplab')
  137.               ret = dapdesc(TESTFILE, DFTAG_SDG, refnum, 
  138.      *                                     descsds, len(descsds))
  139.               call RESULT(ret, 'dapdesc')
  140.           endif
  141.  
  142.           ret = d8aimg(TESTFILE, image, COLS, ROWS, NULL)
  143.           call RESULT(ret, 'd8aimg')
  144.           refnum = DFR8lastref()
  145.           ret = daplab(TESTFILE, DFTAG_RIG, refnum, labris)
  146.           call RESULT(ret, 'daplab')
  147.           ret = dapdesc(TESTFILE,DFTAG_RIG,refnum, descris, 
  148.      *                                                 len(descris))
  149.           call RESULT(ret, 'dapdesc')
  150.   100 continue
  151.  
  152.  
  153. C********  Read labels and descriptions *********
  154.  
  155.       print *, CR, CR
  156.       print *,'*** Reading labels and descriptions for SDS and RIS ***'
  157.  
  158.       do 200 j=1,REPS
  159.  
  160.           ret = dsgdims(TESTFILE, rank,dimsizes,3)
  161.           call RESULT(ret, 'dsgdims')
  162.           refnum = dslref()
  163.  
  164. C         read in annotations for 2 out of every 3 
  165.           if (mod(j,3) .ne. 0) then
  166.               call check_lab_desc(TESTFILE, DFTAG_SDG, refnum, 
  167.      *                                  labsds, descsds, number_failed)
  168.           endif
  169.  
  170.           ret = d8gimg(TESTFILE, newimage, COLS, ROWS, pal)
  171.           call RESULT(ret, 'd8gimg')
  172.           refnum = DFR8lastref()
  173.           call check_lab_desc(TESTFILE, DFTAG_RIG, refnum, 
  174.      *                                labris, descris, number_failed)
  175.       
  176.   200 continue
  177.  
  178.       if ( number_failed .eq. 0 ) then
  179.           print *, CR, CR
  180.           print *,'***** ALL TESTS SUCCESSFUL ***** '
  181.       else
  182.           print *, CR, CR
  183.           print *,'***** ',number_failed,' TESTS FAILED ***** '
  184.       endif
  185.  
  186.       stop
  187.       end
  188.  
  189.  
  190. C***************************************************************
  191. C
  192. C  gen2Dfloat:  generate 2-D data array 
  193. C
  194. C***************************************************************
  195.       subroutine gen2Dfloat(height, width, data)
  196.       integer   height, width
  197.       real data(height,width)
  198.  
  199.       integer i, j
  200.  
  201. C     store one value per row, increasing by one for each row 
  202.       do 110 i=1, height
  203.           do 100 j=1, width
  204.              data(height, width) = float(i)
  205.   100     continue
  206.   110 continue
  207.       return
  208.       end
  209.  
  210.  
  211. C***************************************************************
  212. C
  213. C  genimage:  generate image from 2-D float array
  214. C
  215. C***************************************************************
  216.       subroutine genimage(height, width, data, image)
  217.       integer   height, width
  218.       real      data(height, width)
  219.       character image(height, width)
  220.  
  221.       integer i
  222.       real   max, min, multiplier
  223.  
  224.       max = data(1,1)
  225.       min = data(1,1)
  226.       do 110 i=1, height
  227.           do 100 j=1, width
  228.              if (max .gt. data(i,j)) max = data(i,j)
  229.              if (min .lt. data(i,j)) min = data(i,j)
  230.   100     continue
  231.   110 continue
  232.  
  233. C     store one value per row, increasing by one for each row 
  234.       multiplier = 255.0 /(max-min)
  235.       do 210 i=1, height
  236.           do 200 j=1, width
  237.              image(i,j) = char( int((data(i,j)-min) * multiplier) )
  238.   200     continue
  239.   210 continue
  240.       return 
  241.       end
  242.  
  243.  
  244. C**************************************************************
  245. C
  246. C  check_lab_desc:  read and compare label and description
  247. C                   with expected ones
  248. C
  249. C**************************************************************
  250.       subroutine check_lab_desc(filename, tag, ref, label, desc, 
  251.      *                                                   num_failed)
  252.       character*(*) filename, label, desc
  253.       integer tag, ref, num_failed
  254.  
  255.       parameter ( MAXLEN_LAB =    30,
  256.      *            MAXLEN_DESC =  500 )
  257.  
  258.       integer daglab, dagllen, dagdlen, dagdesc
  259.       integer  inlablen, indesclen, ret
  260.       character*30   inlabel
  261.       character*500 indesc
  262.  
  263.       inlablen =  dagllen(filename, tag, ref)
  264.       call RESULT(inlablen, 'dagllen')
  265.  
  266.       if (inlablen .ne. len(label)) then
  267.           print *,'   >>>BAD LABEL LENGTH.'
  268.           print *,'                        IS: ', inlablen
  269.           print *,'                 SHOULD BE: ', len(label)
  270.           num_failed = num_failed + 1
  271.       endif
  272.  
  273.       ret = daglab(filename, tag, ref, inlabel, MAXLEN_LAB+1)
  274.       call RESULT(ret, 'daglab')
  275.       if (inlabel .ne. label) then
  276.           print *,'   >>>BAD LABEL.'
  277.           print *,'                        IS: ', inlabel
  278.           print *,'                 SHOULD BE: ', label
  279.           num_failed = num_failed + 1
  280.       endif
  281.  
  282.       indesclen = dagdlen(filename, tag, ref)
  283.       call RESULT(indesclen, 'dagdlen')
  284.       if (indesclen .ne. len(desc)) then
  285.           print *,'   >>>BAD DESCRIPTION LENGTH.' 
  286.           print *,'                        IS: ', indesclen 
  287.           print *,'                 SHOULD BE: ', len(desc) 
  288.           num_failed = num_failed + 1 
  289.       else 
  290.           ret = dagdesc(filename, tag, ref, indesc, MAXLEN_DESC)
  291.           call RESULT(ret, 'dagdesc')
  292.           if (indesc .ne. desc) then
  293.               print *,'   >>>BAD DESCRIPTION.' 
  294.               print *,'                        IS: ', indesc 
  295.               print *,'                 SHOULD BE: ', desc 
  296.               num_failed = num_failed + 1 
  297.           endif
  298.       endif
  299.  
  300.       return
  301.       end
  302.  
  303. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  304. C
  305. C     SUBROUTINE RESULT
  306. C
  307. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  308.         subroutine RESULT(errval, routine)
  309.         integer errval
  310.         character*(*)  routine
  311.  
  312.         integer FAIL
  313.  
  314.         FAIL = -1
  315.  
  316.         if (errval.eq.FAIL) then
  317.             num_fail = num_fail + 1
  318.             print *,'   >>> ', routine, ' FAILED: ret = ', 
  319.      *                                                  errval, ' <<<'
  320.         else
  321.             print *, routine, ' SUCCESSFUL'
  322.         endif
  323.  
  324.         return
  325.         end
  326.  
  327.  
  328.