home *** CD-ROM | disk | FTP | other *** search
/ Photo CD Demo 1 / Demo.bin / hdf / unix / hdf3_2r2 / test / tsdmmsf.f < prev    next >
Encoding:
Text File  |  1992-10-29  |  12.1 KB  |  422 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/tsdmmsf.f,v 1.6 1992/08/31 16:14:15 chouck beta koziol $
  26. C
  27. C $Log: tsdmmsf.f,v $
  28. c Revision 1.6  1992/08/31  16:14:15  chouck
  29. c Added tests for calibration tag stuff
  30. c
  31. c Revision 1.5  1992/07/08  22:05:20  sxu
  32. c Changed dsgmaxm() to dsgrang(), and dssmaxm() to dssrang().
  33. c
  34. c Revision 1.4  1992/07/07  21:51:03  chouck
  35. c Minor error reporting fix
  36. c
  37. c Revision 1.3  1992/07/07  21:04:17  chouck
  38. c Changed 'character' to 'byte' for VMS systems.  Fixed error
  39. c reporting.
  40. c
  41. c Revision 1.2  1992/05/07  16:48:07  dilg
  42. c Put in comment explaining the choice between using "char(-128)" and
  43. c "char(0)"
  44. c
  45. c Revision 1.1  1992/04/27  17:17:46  sxu
  46. c Initial revision
  47. c
  48. c Revision 1.2  1992/03/24  20:42:04  sxu
  49. c Changed output file names
  50. c
  51. c Revision 1.1  1992/02/29  22:53:38  mfolk
  52. c Initial revision
  53. c
  54. C
  55.  
  56.       program ntcheckF
  57. C
  58. C
  59. C  Program to test writing SDSs with different types of data and
  60. C  scales and max/min values.
  61. C
  62. C  Input file:  none
  63. C  Output files: o0, o1, ... o6
  64. C
  65. C
  66. C  **** VMS users ****
  67. C
  68. C  VMS has a special way of handling the passsing of character
  69. C   strings between C and FORTRAN.  For these tests to work 
  70. C   correctly, you must change the definition of i8 and ti8
  71. C   to be 'byte' not 'character'  You will also need to remove
  72. C   a couple of calls to char().  If you search on the string 
  73. C   VMS you should be able to find all of the necessary changes.
  74. C
  75.    
  76.       
  77.       integer dsgdata, dsadata, dssdims, dssrang, dsgrang, dssnt
  78.       integer dssdisc, dsgdisc, dsscal, dsgcal
  79.  
  80.       real*8 f64(10,10), tf64(10,10)
  81.       real*8 f64scale(10), tf64scale(10)
  82.       real*8 f64max, f64min, tf64max, tf64min
  83.  
  84.       real*8 cal,  cale,  ioff,  ioffe
  85.       real*8 ical, icale, iioff, iioffe
  86.       integer*4 ctype, ictype
  87.  
  88.       real*4 f32(10,10), tf32(10,10)
  89.       real*4 f32scale(10), tf32scale(10)
  90.       real*4 f32max, f32min, tf32max, tf32min
  91.  
  92. C  Change these to be of type 'byte' for VMS      
  93. C      byte i8(10,10), ti8(10,10)
  94. C      byte i8scale(10), ti8scale(10), i8max, i8min
  95. C      byte ti8max, ti8min   
  96.       character i8(10,10), ti8(10,10)
  97.       character i8scale(10), ti8scale(10), i8max, i8min
  98.       character ti8max, ti8min
  99.  
  100.       integer*2 i16(10,10), ti16(10,10)
  101.       integer*2 i16scale(10), ti16scale(10), i16max, i16min
  102.       integer*2 ti16max, ti16min
  103.  
  104.       integer*4 i32(10,10), ti32(10,10)
  105.       integer*4 i32scale(10), ti32scale(10), i32max, i32min
  106.       integer*4 ti32max, ti32min
  107.  
  108.       integer i, j, err, err1, err2, err3, err4
  109.       integer rank, dims(2)
  110.       integer number_failed
  111.       integer DFNT_FLOAT64, DFNT_FLOAT32, DFNT_INT8, DFNT_INT16
  112.       integer DFNT_INT32
  113.  
  114.       f64max = 40.0
  115.       f64min = 0.0
  116.       f32max = 40.0
  117.       f32min = 0.0
  118. C Use the following lines for VMS
  119. C      i8min = -128
  120. C      i8max = 127
  121.       i8max = char(127)
  122. C NOTE: If you get a compile error on the "char(-128)" line, substitute
  123. C       the "char(0)" line.  Its not quite as thorough a test, but...
  124. C      i8min = char(0)
  125.       i8min = char(-128)
  126.       i16max = 1200
  127.       i16min = -1200
  128.       i32max = 99999999
  129.       i32min = -999999999
  130.       
  131.       rank = 2
  132.       dims(1) = 10
  133.       dims(2) = 10
  134.       number_failed = 0
  135.       DFNT_FLOAT64 = 6
  136.       DFNT_FLOAT32 = 5
  137.       DFNT_INT8 = 20
  138.       DFNT_INT16 = 22
  139.       DFNT_INT32 = 24
  140.       
  141. C
  142. C Set up some calibration info
  143. C
  144.       cal   = 10.0
  145.       cale  = 35.235
  146.       ioff  = 16.75
  147.       ioffe = 47.8
  148.       ctype = DFNT_INT16
  149.  
  150.       print *, 'Creating arrays...'
  151.       
  152.       do 110 i=1,10
  153.           do 100 j=1,10
  154.             f64(i,j) = (i * 40) + j
  155.             f32(i,j) = (i * 40) + j
  156. C  Use the following line for VMS
  157. C            i8(i,j) =  (i * 10) + j      
  158.             i8(i,j) = char( (i * 10) + j )
  159.             i16(i,j) = (i * 3000) + j
  160.             i32(i,j) = (i * 20) + j
  161.   100     continue
  162.           f64scale(i) = (i * 40) + j
  163.           f32scale(i) = (i * 40) + j
  164. C  Use the following line for VMS
  165. C          i8scale(i) = (i * 10) + j
  166.           i8scale(i) = char((i * 10) + j)
  167.             i16scale(i) = (i * 3000) + j
  168.             i32scale(i) = (i * 20) + j
  169.   110 continue
  170.  
  171.       err1 = dssdims(rank, dims)
  172.       
  173. C
  174. C  Writing dimscale, max/min, and arrays to a single file 
  175. C
  176.       print *, 'Writing arrays to single file...'
  177.  
  178.       err  = dssnt(DFNT_FLOAT64)
  179.       err1 = dssdisc(1, 10, f64scale)
  180.       err2 = dssrang(f64max, f64min)
  181.       err4 = dsscal(cal, cale, ioff, ioffe, ctype)
  182.       err3 = dsadata('of.hdf', rank, dims, f64)
  183.       call errchkio(err1, err2, err3, number_failed, 'float64 write')
  184.  
  185.       if(err4.eq.(-1)) then
  186.          number_failed = number_failed + 1
  187.          print *, '>>> Setting calibration failed'
  188.       endif
  189.  
  190.       err  = dssnt(DFNT_FLOAT32)
  191.       err1 = dssdisc(1, 10, f32scale)
  192.       err2 = dssrang(f32max, f32min)
  193.       err3 = dsadata('of.hdf', rank, dims, f32)
  194.       call errchkio(err1, err2, err3, number_failed, 'float32 write')
  195.  
  196.       err  = dssnt(DFNT_INT8)
  197.       err1 = dssdisc(1, 10, i8scale)
  198.       err2 = dssrang(i8max, i8min)
  199.       err3 = dsadata('of.hdf', rank, dims, i8)
  200.       call errchkio(err1, err2, err3, number_failed, 'int8 write')
  201.       
  202.       
  203.       err  = dssnt(DFNT_INT16)
  204.       err1 = dssdisc(1, 10, i16scale)
  205.       err2 = dssrang(i16max, i16min)
  206.       err3 = dsadata('of.hdf', rank, dims, i16)
  207.       call errchkio(err1, err2, err3, number_failed, 'int16 write')
  208.       
  209.       err  = dssnt(DFNT_INT32)
  210.       err1 = dssdisc(1, 10, i32scale)
  211.       err2 = dssrang(i32max, i32min)
  212.       err3 = dsadata('of.hdf', rank, dims, i32)
  213.       call errchkio(err1, err2, err3, number_failed, 'int32 write')
  214.       
  215. C
  216. C  Reading back dimscales, max/min, and arrays from single file
  217. C
  218.       err1 = dsgdata('of.hdf', rank, dims, tf64)
  219.       err2 = dsgdisc(1, 10, tf64scale)
  220.       err3 = dsgrang(tf64max, tf64min)
  221.       err4 = dsgcal(ical, icale, iioff, iioffe, ictype) 
  222.       call errchkio(err1, err2, err3, number_failed, 'float64 read')
  223.  
  224.       if(err4.eq.(-1)) then
  225.          number_failed = number_failed + 1
  226.          print *, '>>> Reading calibration failed'
  227.       endif
  228.       
  229.       if((cal.ne.ical).or.(cale.ne.icale)) then
  230.          if((ioff.ne.iioff).or.(ioff.ne.iioffe)) then
  231.             if(ctype.ne.ictype) then
  232.                print *, '>>>Returned calibration values are wrong'
  233.                print *, ical, icale
  234.                print *, iioff, iioffe
  235.                print *, ictype 
  236.                print *, cal, cale
  237.                print *, ioff, ioffe
  238.                print *, ctype
  239.                number_failed = number_failed + 1
  240.             endif
  241.          endif
  242.       endif
  243.  
  244.       err1 = dsgdata('of.hdf', rank, dims, tf32)
  245.       err2 = dsgdisc(1, 10, tf32scale)
  246.       err3 = dsgrang(tf32max, tf32min)
  247.       err4 = dsgcal(ical, icale, iioff, iioffe, ictype) 
  248.       call errchkio(err1, err2, err3, number_failed, 'float32 read')
  249.  
  250.       if(err4.ne.(-1)) then
  251.          number_failed = number_failed + 1
  252.          print *, '>>> Read calibration where none stored'
  253.       endif
  254.       
  255.       err1 = dsgdata('of.hdf', rank, dims, ti8)
  256.       err2 = dsgdisc(1, 10, ti8scale)
  257.       err3 = dsgrang(ti8max, ti8min)
  258.       call errchkio(err1, err2, err3, number_failed, 'int8 read')
  259.       
  260.       err1 = dsgdata('of.hdf', rank, dims, ti16)
  261.       err2 = dsgdisc(1, 10, ti16scale)
  262.       err3 = dsgrang(ti16max, ti16min)
  263.       call errchkio(err1, err2, err3, number_failed, 'int16 read')
  264.       
  265.       err1 = dsgdata('of.hdf', rank, dims, ti32)
  266.       err2 = dsgdisc(1, 10, ti32scale)
  267.       err3 = dsgrang(ti32max, ti32min)
  268.       call errchkio(err1, err2, err3, number_failed, 'int32 read')
  269.       
  270. C
  271. C  Checking dimscales, max/min and arrays from single file
  272. C
  273.       print *, 'Checking dimscales, max/min & arrays from single file'
  274.  
  275. C  float64
  276.       err1 = 0
  277.       err2 = 0
  278.       err3 = 0
  279.       do 1010 i=1,10
  280.          do 1000 j=1,10
  281.            if (f64(i,j) .ne. tf64(i,j)) err1 = 1
  282.  1000    continue
  283.  
  284.          if (f64scale(i) .ne. tf64scale(i)) err2 = 1
  285.  1010 continue
  286.  
  287.       if ((f64max .ne. tf64max) .or. (f64min .ne. tf64min)) err3 = 1
  288.       call errchkarr(err1, err2, err3, number_failed, 'float64')
  289.  
  290. C  float32
  291.       err1 = 0
  292.       err2 = 0
  293.       err3 = 0
  294.       do 1030 i=1,10
  295.          do 1020 j=1,10
  296.            if (f32(i,j) .ne. tf32(i,j)) err1 = 1
  297.  1020    continue
  298.          if (f32scale(i) .ne. tf32scale(i)) err2 = 1
  299.  1030 continue
  300.  
  301.       if ((f32max .ne. tf32max) .or. (f32min .ne. tf32min)) err3 = 1
  302.       call errchkarr(err1, err2, err3, number_failed, 'float32')
  303.  
  304. C  int8
  305.       err1 = 0
  306.       err2 = 0
  307.       err3 = 0
  308.       do 1110 i=1,10
  309.          do 1100 j=1,10
  310.            if (i8(i,j) .ne. ti8(i,j)) err1 = 1
  311.  1100    continue
  312.          if (i8scale(i) .ne. ti8scale(i)) err2 = 1
  313.  1110 continue
  314.  
  315.       if ((i8max .ne. ti8max) .or. (i8min .ne. ti8min)) err3 = 1
  316.       call errchkarr(err1, err2, err3, number_failed, 'int8')
  317.  
  318. C  int16
  319.       err1 = 0
  320.       err2 = 0
  321.       err3 = 0
  322.        do 1210 i=1,10
  323.          do 1200 j=1,10
  324.            if (i16(i,j) .ne. ti16(i,j)) err1 = 1
  325.  1200    continue
  326.          if (i16scale(i) .ne. ti16scale(i)) err2 = 1
  327.  1210 continue
  328.  
  329.       if ((i16max .ne. ti16max) .or. (i16min .ne. ti16min)) err3 = 1
  330.       call errchkarr(err1, err2, err3, number_failed, 'int16')
  331.  
  332. C  int32
  333.       err1 = 0
  334.       err2 = 0
  335.       err3 = 0
  336.        do 1310 i=1,10
  337.          do 1300 j=1,10
  338.            if (i32(i,j) .ne. ti32(i,j)) err1 = 1
  339.  1300    continue
  340.            if (i32scale(i) .ne. ti32scale(i)) err2 = 1
  341.  1310 continue
  342.  
  343.       if ((i32max .ne. ti32max) .or. (i32min .ne. ti32min)) err3 = 1
  344.       call errchkarr(err1, err2, err3, number_failed, 'int32')
  345. C
  346. C  Sum up
  347. C
  348.       
  349.       if (number_failed .gt. 0 ) then
  350.           print *, '        >>> ', number_failed, ' TESTS FAILED <<<'
  351.       else
  352.           print *, '        >>> ALL TESTS PASSED <<<'
  353.       endif
  354.  
  355.       stop
  356.       end
  357.  
  358.  
  359. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  360. C
  361. C     SUBROUTINE errchkio
  362. C
  363. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  364.       subroutine errchkio(err1, err2, err3, num_fail, msg)
  365.       integer err1, err2, err3, num_fail
  366.       character*(*)  msg
  367.  
  368.       integer FAIL
  369.  
  370.       FAIL = -1
  371.  
  372.       if (err1.eq.FAIL .or. err2.eq.FAIL .or. err3.eq.FAIL) then
  373.           num_fail = num_fail + 1
  374.           print *
  375.           print *,'>>> Test failed for ',msg, ' <<<'
  376.           print *, '  err1=',err1, '   err2=',err2, '   err3=',err3
  377.       else
  378.           print *,'Test passed for ', msg
  379.       endif
  380.       print *
  381.  
  382.       return
  383.       end
  384.  
  385.       
  386. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  387. C
  388. C     SUBROUTINE errchkarr
  389. C
  390. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  391.       subroutine errchkarr(err1, err2, err3, num_fail, type)
  392.       integer err1, err2, err3, num_fail
  393.       character*(*)  type
  394.       
  395.       print *
  396.       if (err1 .eq. 1) then
  397.         print *, '>>> Test failed for ', type, ' array' 
  398.         num_fail = num_fail + 1
  399.       else
  400.         print *, 'Test passed for ', type, ' array'
  401.       endif
  402.  
  403.       if (err2 .eq. 1) then
  404.         print *, '>>> Test failed for ',type, ' scales.'
  405.         num_fail = num_fail + 1
  406.       else
  407.         print *, 'Test passed for ', type, ' scales.'
  408.       endif
  409.  
  410.       if (err3 .eq. 1) then
  411.         print *, '>>> Test failed for ', type, ' max/min.'
  412.         num_fail = num_fail + 1
  413.       else
  414.         print *, 'Test passed for ', type, ' max/min.'
  415.       endif
  416.  
  417.       print *
  418.  
  419.       return
  420.       end
  421.  
  422.