home *** CD-ROM | disk | FTP | other *** search
/ Graphics Plus / Graphics Plus.iso / general / hdf / unix / hdf3_2r2.lha / HDF3.2r2 / test / tsdnntf.f < prev    next >
Encoding:
Text File  |  1992-10-28  |  8.4 KB  |  307 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/tsdnntf.f,v 1.5 1992/07/09 16:09:49 chouck beta koziol $
  26. C
  27. C $Log: tsdnntf.f,v $
  28. c Revision 1.5  1992/07/09  16:09:49  chouck
  29. c Changed characters to bytes for VMS
  30. c
  31. c Revision 1.4  1992/06/29  15:41:39  chouck
  32. c Changed the OR() to an addition.  Removed bitwise assignment
  33. c to make VMS happy.
  34. c
  35. c Revision 1.3  1992/06/01  14:53:26  mfolk
  36. c Convex Fortran doesn't have the 'OR' function.  You have to
  37. c use 'JIOR' instead.  So I added these comments right before
  38. c the 'OR' is called:
  39. c   C Some Fortrans do not have the 'OR' function.  If this
  40. c   C causes an error, try substituting 'JIOR'.
  41. c
  42. c Revision 1.2  1992/05/29  18:54:51  chouck
  43. c Changed output file names
  44. c
  45. c Revision 1.1  1992/04/27  17:28:04  sxu
  46. c Initial revision
  47. c
  48. C
  49.       program tdfsd_nntF
  50. C
  51. C
  52. C  Program to test writing SDSs with different types of data.
  53. C
  54. C  Input file:  none
  55. C  Output files:  fo1.hdf, fo2.hdf, ...fo5.hdf, fo.hdf
  56. C
  57.  
  58. C  **** VMS users ****
  59. C
  60. C  VMS has a special way of handling the passsing of character
  61. C   strings between C and FORTRAN.  For these tests to work 
  62. C   correctly, you must change the definition of i8 and ti8
  63. C   to be 'byte' not 'character'  You will also need to remove
  64. C   a couple of calls to char().  If you search on the string 
  65. C   VMS you should be able to find all of the necessary changes.
  66. C
  67.  
  68.       integer dspdata, dsgdata, dsadata, dssdims, dssnt
  69.  
  70.       real*8 f64(10,10), tf64(10,10)
  71.       real*4 f32(10,10), tf32(10,10)
  72.       integer*2 i16(10,10), ti16(10,10)
  73.       integer*4 i32(10,10), ti32(10,10)
  74.  
  75. C  Change these to be of type 'byte' for VMS
  76. C      byte      i8(10,10), ti8(10,10)
  77.       character i8(10,10), ti8(10,10)
  78.       
  79.       integer i, j, err, err1, err2
  80.       integer rank
  81.       integer dims(2)
  82.       integer number_failed
  83.       integer DFNT_FLOAT64, DFNT_FLOAT32, DFNT_INT8, DFNT_INT16
  84.       integer DFNT_INT32
  85.       integer DFNT_NFLOAT64, DFNT_NFLOAT32, DFNT_NINT8
  86.       integer DFNT_NINT16, DFNT_NINT32, DFNT_NATIVE
  87.  
  88.       DFNT_FLOAT64 = 6
  89.       DFNT_FLOAT32 = 5
  90.       DFNT_INT8 = 20
  91.       DFNT_INT16 = 22
  92.       DFNT_INT32 = 24
  93.       DFNT_NATIVE = 4096
  94.  
  95. C These should really use a logical OR to compute these values
  96. C However, OR() is not really that portable
  97.  
  98.       DFNT_NFLOAT64 = DFNT_NATIVE + DFNT_FLOAT64
  99.       DFNT_NFLOAT32 = DFNT_NATIVE + DFNT_FLOAT32
  100.       DFNT_NINT8 =    DFNT_NATIVE + DFNT_INT8
  101.       DFNT_NINT16 =   DFNT_NATIVE + DFNT_INT16
  102.       DFNT_NINT32 =   DFNT_NATIVE + DFNT_INT32
  103.  
  104.       rank = 2
  105.       dims(1) = 10
  106.       dims(2) = 10
  107.       number_failed = 0
  108.  
  109.       print *, 'Creating arrays...'
  110.   
  111.       do 110 i=1,10
  112.           do 100 j=1,10
  113.             f64(i,j) = (i * 10) + j
  114.           f32(i,j) = (i * 10) + j
  115. C  Use the following line for VMS
  116. C            i8(i,j) =  (i * 10) + j
  117.            i8(i,j) = char( (i * 10) + j )
  118.           i16(i,j) = (i * 10) + j
  119.           i32(i,j) = (i * 10) + j
  120.   100     continue
  121.   110 continue
  122.   
  123.       err = dssdims(rank, dims)
  124.   
  125. C  individual files 
  126.       print *,'Testing arrays in individual files...'
  127.   
  128.       err = dssnt(DFNT_NFLOAT64)
  129.       err1 = dspdata('fo1.hdf', rank, dims, f64)
  130.       err2 = dsgdata('fo1.hdf', rank, dims, tf64)
  131.       print *,'Write: ', err1, '    Read: ', err2
  132.       err = 0
  133.       do 160 i=1,10
  134.           do 150 j=1,10
  135.           if (f64(i,j).ne.tf64(i,j)) err = 1
  136.           tf64(i,j) = 0.0
  137.   150     continue
  138.   160 continue
  139.  
  140.       call err_check(err, number_failed, 'float64')
  141.  
  142.       err = dssnt(DFNT_NFLOAT32)
  143.       err1 = dspdata('fo2.hdf', rank, dims, f32)
  144.       err2 = dsgdata('fo2.hdf', rank, dims, tf32)
  145.       print *,'Write: ', err1, '    Read: ', err2
  146.       err = 0
  147.       do 210 i=1,10
  148.           do 200 j=1,10
  149.           if (f32(i,j).ne.tf32(i,j)) err = 1
  150.           tf32(i,j) = 0.0
  151.   200     continue
  152.   210 continue
  153.  
  154.       call err_check(err, number_failed, 'float32')
  155.  
  156.       err = dssnt(DFNT_NINT8)
  157.       err1 = dspdata('fo3.hdf', rank, dims, i8)
  158.       err2 = dsgdata('fo3.hdf', rank, dims, ti8)
  159.       print *,'Write: ', err1, '    Read: ', err2
  160.       err = 0
  161.       do 310 i=1,10
  162.           do 300 j=1,10
  163.           if (i8(i,j).ne.ti8(i,j)) err = 1
  164. C Use the following line for VMS
  165. C            ti8(i,j) = 0
  166.             ti8(i,j) = char(0)
  167.   300     continue
  168.   310 continue
  169.  
  170.       call err_check(err, number_failed, 'int8')
  171.  
  172.       err = dssnt(DFNT_NINT16)
  173.       err1 = dspdata('fo4.hdf', rank, dims, i16)
  174.       err2 = dsgdata('fo4.hdf', rank, dims, ti16)
  175.       print *,'Write: ', err1, '    Read: ', err2
  176.       err = 0
  177.       do 410 i=1,10
  178.           do 400 j=1,10
  179.           if (i16(i,j).ne.ti16(i,j)) err = 1
  180.           ti16(i,j) = 0
  181.   400     continue
  182.   410 continue
  183.  
  184.       call err_check(err, number_failed, 'int16')
  185.  
  186.       err = dssnt(DFNT_NINT32)
  187.       err1 = dspdata('fo5.hdf', rank, dims, i32)
  188.       err2 = dsgdata('fo5.hdf', rank, dims, ti32)
  189.       print *,'Write: ', err1, '    Read: ', err2
  190.       err = 0
  191.       do 510 i=1,10
  192.           do 500 j=1,10
  193.           if (i32(i,j).ne.ti32(i,j)) err = 1
  194.           ti32(i,j) = 0
  195.   500     continue
  196.   510 continue
  197.  
  198.       call err_check(err, number_failed, 'int32')
  199.  
  200.  
  201. C 
  202.       print *, 'Writing arrays to single file.'
  203.       print *, 'Error values: '
  204. C
  205.       err = dssnt(DFNT_NFLOAT64)
  206.       print *, '            ', dsadata('fo.hdf', rank, dims, f64)
  207.  
  208.       err = dssnt(DFNT_NFLOAT32)
  209.       print *, '            ', dsadata('fo.hdf', rank, dims, f32)
  210.  
  211.       err = dssnt(DFNT_NINT8)
  212.       print *, '            ', dsadata('fo.hdf', rank, dims, i8)
  213.  
  214.       err = dssnt(DFNT_NINT16)
  215.       print *, '            ', dsadata('fo.hdf', rank, dims, i16)
  216.  
  217.       err = dssnt(DFNT_NINT32)
  218.       print *, '            ', dsadata('fo.hdf', rank, dims, i32)
  219.  
  220. C 
  221.       print *, 'Reading arrays from single file... '
  222.       print *, 'Error values: '
  223. C
  224.       print *, '            ', dsgdata('fo.hdf', rank, dims, tf64)
  225.       print *, '            ', dsgdata('fo.hdf', rank, dims, tf32)
  226.       print *, '            ', dsgdata('fo.hdf', rank, dims, ti8)
  227.       print *, '            ', dsgdata('fo.hdf', rank, dims, ti16)
  228.       print *, '            ', dsgdata('fo.hdf', rank, dims, ti32)
  229.  
  230. C 
  231.       print *, 'Checking arrays from single file...\n\n'
  232.  
  233.       err = 0
  234.       do 910 i=1,10
  235.          do 900 j=1,10
  236.            if (f64(i,j) .ne. tf64(i,j)) err = 1
  237.   900    continue
  238.   910 continue
  239.  
  240.       call err_check(err, number_failed, 'float64')
  241. C 
  242.  
  243.       err = 0
  244.       do 1010 i=1,10
  245.          do 1000 j=1,10
  246.            if (f32(i,j) .ne. tf32(i,j)) err = 1
  247.  1000    continue
  248.  1010 continue
  249.  
  250.       call err_check(err, number_failed, 'float32')
  251. C 
  252.       err = 0
  253.       do 1110 i=1,10
  254.          do 1100 j=1,10
  255.            if (i8(i,j) .ne. ti8(i,j)) err = 1
  256.  1100    continue
  257.  1110 continue
  258.  
  259.       call err_check(err, number_failed, 'int8')
  260. C 
  261.       err = 0
  262.       do 1210 i=1,10
  263.          do 1200 j=1,10
  264.            if (i16(i,j) .ne. ti16(i,j)) err = 1
  265.  1200    continue
  266.  1210 continue
  267.  
  268.       call err_check(err, number_failed, 'int16')
  269. C 
  270.       err = 0
  271.       do 1310 i=1,10
  272.          do 1300 j=1,10
  273.            if (i32(i,j) .ne. ti32(i,j)) err = 1
  274.  1300    continue
  275.  1310 continue
  276.  
  277.       call err_check(err, number_failed, 'int32')
  278. C 
  279.       print *
  280.       if (number_failed .gt. 0 ) then
  281.       print *,'        >>> ', number_failed, ' TESTS FAILED <<<'
  282.       else
  283.       print *,'        >>> ALL TESTS PASSED <<<'
  284.       endif
  285.       print *
  286.       print *
  287.  
  288.       stop
  289.       end  
  290.   
  291. C
  292. C
  293.       subroutine err_check(err, num_fail, type)
  294.       integer err, num_fail
  295.       character*(*) type
  296.  
  297.       if (err .eq. 1) then 
  298.       print *,'>>> Test failed for ',type, ' array.'
  299.         num_fail = num_fail+1
  300.       else
  301.       print *,'Test passed for ', type, ' array.'
  302.       endif
  303.  
  304.       return
  305.       end
  306.  
  307.