home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MISC / MATH / SPECTR20.ZIP / SINE.FOR < prev    next >
Encoding:
Text File  |  1992-04-22  |  4.3 KB  |  164 lines
  1. *    SINE.FOR
  2.  
  3. *    Sinewave Generation Program
  4.  
  5. *    David E. Hess
  6. *    Fluid Flow Group - Process Measurements Division
  7. *    Chemical Science and Technology Laboratory
  8. *    National Institute of Standards and Technology
  9. *    April 15, 1992
  10.  
  11. *    The purpose of this routine is to use the computer to generate
  12. *    a known function of time (a sinewave) and to store the output
  13. *    in a data file that may be read by SPECTRUM. The routine then
  14. *    simulates the sampling process by prompting for the various
  15. *    sampling parameters. 
  16.  
  17.     IMPLICIT    REAL*4 (A-H,O-Z), INTEGER*2 (I-N)
  18.     PARAMETER   (NUMO=2,NUMO2=3,NMAX=16384)
  19.     INTEGER*2   GAIN(0:7)
  20.     INTEGER*2   NDATA[ALLOCATABLE,HUGE](:)
  21.     INTEGER*4   IRSIZE,I,IDELTMS
  22.     REAL*4      T[ALLOCATABLE,HUGE](:)
  23.     REAL*4      X[ALLOCATABLE,HUGE](:)
  24.     CHARACTER*1 FIRST
  25.     CHARACTER*4 FLNM
  26.     CHARACTER*8 FILNAM
  27.  
  28. *    Initialization
  29.  
  30.     ICHANS=1
  31.     PI=2.0*ASIN(1.0)
  32.     VOFST=20.0/4096.0
  33.     GAIN=0
  34.  
  35. *    Get the input parameters.
  36.  
  37.     WRITE (*,'(1X,A\)') 'Enter the amplitude of the sinewave : '
  38.     READ (*,*) AMP
  39.     WRITE (*,'(1X,A\)') 'Enter the frequency of the sinewave : '
  40.     READ (*,*) FREQ
  41.     WRITE (*,'(1X,A\)') 'Enter the phase (in degrees) : '
  42.     READ (*,*) PHASE
  43.     WRITE (*,'(1X,A\)') 'Enter DC value : '
  44.     READ (*,*) DC
  45.     WRITE (*,'(1X,A\)') 'Enter delta T secs. (1.0/Sample Rate) : '
  46.     READ (*,*) DELT
  47. 30    WRITE (*,'(1X,A\)') 'Enter # of points per record (N) : '
  48.     READ (*,*) N
  49.  
  50. *    N less than or equal to NMAX error checking.
  51.  
  52.     IF (N .GT. NMAX) THEN
  53.       WRITE (*,'(/1X,A,I5/)')
  54.      +      '# of points per record <= ',NMAX
  55.       GO TO 30
  56.     ENDIF
  57.  
  58. *    Power of two error checking.
  59.  
  60.     FN=FLOAT(N)
  61.     ITST=NINT(ALOG10(FN)/ALOG10(2.0))
  62.     ITST2=INT(2**ITST)-N
  63.  
  64.     IF (ITST2 .NE. 0) THEN
  65.       WRITE (*,'(/1X,A,I5,A/1X,A/)') 'You have entered ',
  66.      +      N,' data points.','# data points must be a power of 2.'
  67.       GO TO 30
  68.     ENDIF
  69.  
  70. *    Allocate space for the NDATA, T and X arrays.
  71.  
  72.     ALLOCATE (NDATA(N), T(N), X(N), STAT=IERR)
  73.     IF (IERR .NE. 0)
  74.      +          STOP 'Not enough storage for data.  Aborting ...'
  75.  
  76.  
  77.     WRITE (*,'(1X,A\)') 'Enter # of records (NUMREC) : '
  78.     READ (*,*) NUMREC
  79. 40    WRITE (*,'(1X,A\)') 'Enter output file name (4 chars) : '
  80.     READ (*,'(A)') FLNM
  81.  
  82. *    Convert to uppercase and check first character alphabetic.
  83.  
  84.     DO J=4,1,-1
  85.       FIRST=FLNM(J:J)
  86.       IF (ICHAR(FIRST) .GE. 97 .AND. ICHAR(FIRST) .LE. 122) THEN
  87.         IHOLD=ICHAR(FIRST)-32
  88.         FIRST=CHAR(IHOLD)
  89.         FLNM(J:J)=FIRST
  90.       ENDIF
  91.     ENDDO
  92.     IF (ICHAR(FIRST) .LT. 65 .OR. ICHAR(FIRST) .GT. 90) THEN
  93.       WRITE (*,'(/1X,A,A,A/1X,A,A,A/1X,A/)') 
  94.      +      'Filename ',FLNM,' began with',
  95.      +      'the nonalphabetic character ',FIRST,'.',
  96.      +      'Re-enter the filename correctly.'
  97.       GO TO 40
  98.     ENDIF
  99.  
  100.     FILNAM=FLNM // '.DAT'
  101.     IRSIZE=ICHANS*N*2
  102.     IDELTMS=NINT(DELT*1.0E+06)
  103.     PHASRD=PHASE*2.0*PI/360.0
  104.  
  105. *    Write the data in the form of binary numbers to a data
  106. *    file that may be read by SPAD.
  107.  
  108.     OPEN (NUMO,FILE=FILNAM,STATUS='UNKNOWN',ACCESS='SEQUENTIAL',
  109.      +        FORM='BINARY')
  110.     WRITE (NUMO) ICHANS,IRSIZE,NUMREC,IDELTMS
  111.     WRITE (NUMO) (GAIN(I),I=0,7)
  112.  
  113. *    Put message on screen.
  114.  
  115.     WRITE (*,'(/////////////////////16X,
  116.      +       ''S I N E W A V E   C R E A T I O N   U T I L I T Y'')')
  117.     WRITE (*,'(/25X,''Creating '',A,'' now.''/)') FILNAM 
  118.     
  119.     DO IB=1,NUMREC
  120.  
  121. *      Vary the phase of the sinewave for different records to
  122. *      simulate the effect of noncontiguous chunks of time in
  123. *      the sampling process.
  124.  
  125.       PHASE=PHASRD+FLOAT(IB-1)/FLOAT(NUMREC-1)*2.0*PI
  126.  
  127. *      Generate the sinewave.
  128.  
  129.       DO I=0,N-1
  130.         T(I+1)=FLOAT(I)*DELT
  131.         X(I+1)=DC+AMP*SIN(2.0*PI*FREQ*T(I+1)+PHASE)
  132.         NDATA(I+1)=INT(X(I+1)/VOFST)
  133.       ENDDO
  134.  
  135. *      Display record number message.
  136.  
  137.       IF (IB .EQ. 1) THEN
  138.         WRITE (*,50) IB
  139. 50        FORMAT (25X,'Writing Record ',I4.4)
  140.       ELSE
  141.         WRITE (*,60) IB
  142. 60        FORMAT ('+',24X,'Writing Record ',I4.4)
  143.       ENDIF
  144.  
  145. *      Output the results to the unformatted file.
  146.  
  147.       WRITE (NUMO) (NDATA(I),I=1,N)
  148.  
  149. *      Put the results of the first record in a formatted file.
  150.  
  151.       IF (IB .EQ. 1) THEN
  152.         OPEN (NUMO2,FILE='SINT.PRN',STATUS='UNKNOWN')
  153.           WRITE (NUMO2,'(G17.7,2X,G17.7)') (T(I),X(I),I=1,N)
  154.         CLOSE (NUMO2,STATUS='KEEP')
  155.       ENDIF 
  156.  
  157.     ENDDO
  158.  
  159.     CLOSE (NUMO,STATUS='KEEP')
  160.  
  161.     WRITE(*,'( )')
  162.     STOP '                    Program terminated successfully.'
  163.     END
  164.