iodisk.f
上传用户:szhypcb168
上传日期:2007-01-06
资源大小:2187k
文件大小:3k
源码类别:

语音压缩

开发平台:

Unix_Linux

  1. C==========================================================================
  2. C
  3. C ROUTINE
  4. C               iodisk
  5. C
  6. C FUNCTION
  7. C               16-bit disk i/o
  8. C SYNOPSIS
  9. C               function iodisk(mode, lun, fname, nrec, iar, size)
  10. C
  11. C   formal 
  12. C
  13. C                       data    I/O
  14. C       name            type    type    function
  15. C       -------------------------------------------------------------------
  16. C mode int i defines operation
  17. C -1 = close file
  18. C  1 = read
  19. C  2 = write
  20. C  3 = open for read
  21. C  4 = open for write
  22. C lun int i logical unit number
  23. C fname char i file name       
  24. C nrec int i/o direct access record pointer
  25. C (auto increment)
  26. C iar int*2 i/o i/o data record
  27. C size int i record size
  28. C iodisk int fun status
  29. C  -1 => illegal input
  30. C   0 => open/close OK
  31. C size=> read/write OK
  32. c==========================================================================
  33. c
  34. c DESCRIPTION
  35. c
  36. c Uses FORTRAN direct-access unformatted files with
  37. c consecutive 16-bit (i*2) signed samples.  (Note:
  38. c direct access is not required, but sequential access
  39. c EOF determination is difficult under UNIX.)
  40. C
  41. C**************************************************************************
  42. C*-
  43. function iodisk(mode, lun, fname, nrec, iar, size)
  44. implicit undefined(a-z)
  45. integer mode, lun, nrec, size, iodisk
  46. integer*2 iar(size)    
  47. character*(*) fname
  48. integer i
  49. c
  50. if ((mode .eq. 1 .or. mode .eq. 2) .and. nrec .le. 0) then
  51.    iodisk = -1
  52.    print *,' iodisk:  Bad direct access record number', nrec
  53.    goto 999
  54. end if
  55. c
  56. iodisk = 0
  57. if (mode .eq. 1) then
  58. c *read file
  59. c *Warning, read errors aren't reported
  60. c *except iodisk=0!
  61.    read(lun, rec=nrec, err=999) (iar(i),i=1,size)
  62.    iodisk = size
  63.    nrec = nrec+1
  64. else if (mode .eq. 2) then
  65. c *write file
  66.    write(lun, rec=nrec, err=222) (iar(i),i=1,size)
  67.    iodisk = size
  68.    nrec = nrec+1
  69. else if (mode .eq. 3) then
  70. c *open file for read
  71.    open(lun, file=fname, access='direct', status='old',
  72.      +         recl=2*size, err=333)
  73. else if (mode .eq. 4) then
  74. c *open file for write
  75. c *unlink = UNIX file delete
  76.    call unlink(fname)
  77.    open(lun, file=fname, access='direct', status='new',
  78.      +         recl=2*size, err=444)
  79. else if (mode .eq. -1) then
  80. c *close file
  81.    close(lun, err=555)
  82. else
  83. c *illegal mode
  84.    iodisk = -1
  85.    print *,' iodisk:  Illegal mode', mode
  86. end if
  87. goto 999
  88. c
  89. c    Error reporter
  90. c
  91. 222    print *,' iodisk:  Error writing output file', fname
  92.      goto 998
  93. 333    print *,' iodisk:  Error opening input file', fname
  94.      goto 998
  95. 444    print *,' iodisk:  Error opening output file', fname
  96.      goto 998
  97. 555    print *,' iodisk:  Error closing file', lun
  98.      goto 998
  99. 998    stop
  100. 999 return
  101. end