home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / general / hdf / unix / hdf3_2r2.lha / HDF3.2r2 / test / tsdstrf.f < prev    next >
Encoding:
Text File  |  1992-10-28  |  4.6 KB  |  146 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/tsdstrf.f,v 1.3 1992/08/09 19:47:09 chouck beta koziol $
  26. C
  27. C $Log: tsdstrf.f,v $
  28. c Revision 1.3  1992/08/09  19:47:09  chouck
  29. c Changed add-data to put-data.  Increased size of arrays strings are
  30. c returned in to avoid memory over-writes.
  31. c
  32. c Revision 1.2  1992/07/09  19:39:35  chouck
  33. c rank was declared twice
  34. c
  35. c Revision 1.1  1992/07/08  22:15:59  sxu
  36. c Initial revision
  37. c
  38. C
  39.       program tsdstrf
  40. C
  41. C This program tests correctness of writing and read datastrings
  42. C and dimension strings.
  43. C To avoid the '\0' inserted by HDstrncpy, compare the first 14
  44. C characters of output and input strings in subroutine compare()
  45.  
  46.       integer rank, i, j, ret, err, num_failed
  47.       integer dims(2)
  48.       integer dssnt, dssdims, dssdast, dssdist, dspdata
  49.       integer dsgdast, dsgdist, dsgdata, DFNT_NFLOAT32
  50.       real    f32(10,10), inf32(10,10)
  51.       character*15 datalabel, dataunit, datafmt, coordsys
  52.       character*15 dimlabels(2), dimunits(2), dimfmts(2)
  53.       character*16 indatalabel, indataunit, indatafmt, incoordsys
  54.       character*16 indimlabels(2), indimunits(2), indimfmts(2)
  55.       character*15 fn
  56.  
  57.       DFNT_NFLOAT32 = 4096+5
  58.       rank = 2
  59.       dims(1) = 10
  60.       dims(2) = 10
  61.       datalabel = 'Datalabel'
  62.       dataunit = 'Dataunit'
  63.       datafmt = 'Datafmt'
  64.       coordsys = 'Coordsys'
  65.       dimlabels(1) = 'f_dim1_label_b'
  66.       dimunits(1) =  'f_dim1_unit_b '
  67.       dimfmts(1) =   'f_dim1_fmt_b  '
  68.       dimlabels(2) = 'f_dim2_label_a'
  69.       dimunits(2) =  'f_dim2_unit_a '
  70.       dimfmts(2) =   'f_dim2_fmt_a  '
  71.       fn = 'sdstrsf.hdf'
  72.  
  73.       err = 0
  74.       num_failed = 0
  75.  
  76.       print *, 'Creating arrays...'
  77.  
  78.       do 110 i=1,dims(2)
  79.           do 100 j=1,dims(1) 
  80.              f32(j,i) = (i*10) + j
  81. 100       continue
  82. 110   continue
  83.  
  84.       ret = dssdims(rank, dims)
  85.       err = err + ret
  86.       ret = dssnt(DFNT_NFLOAT32)
  87.       err = err + ret
  88.       ret = dssdast(datalabel, dataunit, datafmt, coordsys)
  89.       err = err + ret
  90.       ret = dssdist(1, dimlabels(1), dimunits(1), dimfmts(1))
  91.       err = err + ret
  92.       ret = dssdist(2, dimlabels(2), dimunits(2), dimfmts(2))
  93.       err = err + ret
  94.       ret = dspdata(fn, rank,dims, f32)
  95.       err = err + ret
  96.  
  97.       print *, 'Test strings written so far'
  98.  
  99.       ret = dsgdata(fn, rank, dims, inf32)
  100.       err = err + ret
  101.       ret = dsgdast(indatalabel, indataunit, indatafmt, incoordsys)
  102.       err = err + ret
  103.       ret = dsgdist(1, indimlabels(1), indimunits(1), indimfmts(1))
  104.       err = err + ret
  105.       ret = dsgdist(2, indimlabels(2), indimunits(2), indimfmts(2))
  106.       err = err + ret
  107.  
  108.       call compare(datalabel, indatalabel, num_failed)
  109.       call compare(dataunit, indataunit, num_failed)
  110.       call compare(datafmt, indatafmt, num_failed)
  111.       call compare(coordsys, incoordsys, num_failed)
  112.       do 150 i=1,2
  113.           call compare(dimlabels(i), indimlabels(i), num_failed)
  114.           call compare(dimunits(i), indimunits(i), num_failed)
  115.           call compare(dimfmts(i), indimfmts(i), num_failed)
  116. 150   continue
  117.  
  118.       if ((err .eq. 0) .and. (num_failed .eq. 0)) then
  119.           print *, '>>>> All Tests Passed.  >>>>'
  120.       else
  121.           print *, abs(err),' calls returned -1'
  122.           print *, num_failed, ' values incorrect.'
  123.       endif
  124.  
  125.       stop
  126.       end
  127.  
  128.      
  129.  
  130.       subroutine compare(outstring, instring, num)
  131.       character*14 outstring, instring
  132.       integer      num
  133. C
  134. C Note, outstring and instring are of length 14 instead of 15.
  135. C
  136.  
  137.       if (outstring .ne. instring) then
  138.           print *, 'Test failed for <', outstring,'>'
  139.           print *, '      HDF says= <', instring,'>'
  140.           num= num+ 1
  141.       else
  142.           print *, 'Test passed for ', outstring
  143.       endif
  144.       return
  145.       end
  146.