home *** CD-ROM | disk | FTP | other *** search
/ ftp.ncsa.uiuc.edu / ftp.ncsa.uiuc.edu.zip / ftp.ncsa.uiuc.edu / DataScope / misc / wavex.f < prev   
Text File  |  2017-03-03  |  4KB  |  150 lines
  1. c   
  2. c  Example FORTRAN source for generating a movie sequence of images
  3. c  to be viewed with NCSA DataScope 1.2.
  4. c
  5. c  Works with NCSA DataScope 1.2 and the dscall.o library included and
  6. c  documented with DataScope.  The ds_send call transfers the dataset to
  7. c  the client Macintosh.
  8. c
  9. c  Has been tested on:
  10. c     UNICOS
  11. c     Sun UNIX 4.0 - change the array dimensions to 20x20 or it takes forever
  12. c
  13. c
  14. c  On UNICOS:
  15. c     cc -DUNICOS -c dscall.c
  16. c     cf77 wavex.f dscall.o -o wavex -lnet
  17. c
  18. c  On Suns:
  19. c     cc -DSUN -c dscall.c
  20. c     f77 wavex.f dscall.o -o wavex
  21. c
  22. c
  23. c  original version:  Alan Craig, 1989
  24. c  DataScope version:  Tim Krauskopf, 1989
  25. c
  26. c  this code is in the public domain
  27. c
  28.  
  29.        real dat(50,50),diff
  30.        character*1 hdf(50,50)
  31.        character*1 pal(768)
  32.        character*80 fname,host
  33.        character*4 tmp
  34.        integer idab(50,50),shape(2)
  35. c
  36. c  Change this host line to indicate YOUR Macintosh.  Use the 
  37. c  IP address in most cases, e.g.
  38. c            host = '128.174.221.163'
  39. c  or use the "name" associated with your Mac, e.g.
  40. c            host = 'mymac.uiuc.edu'
  41. c
  42.        host = '128.174.221.163'
  43.        call ds_open(host)
  44.        
  45.        
  46.        xn=0.0
  47.        yn=0.0
  48.        pi=3.1415926
  49.        c=0.1
  50.        be=0.1
  51.        xsize = 50 
  52.        ysize = 50 
  53.        ce=0.5
  54.        bot = 99999999
  55.        top= -999999999
  56.        fname = '        '
  57.        do 10 i=1,10,2
  58.           print*,'frame = ',i
  59.  
  60.           do 50 j = 1,xsize
  61.            do 21 jj=1,ysize
  62.              x = j / xsize 
  63.              y = jj / ysize
  64.              t = i
  65.              f4 = 0.0
  66.             
  67.               do 30 n = -15,15 
  68.                do 31 m= -15,15
  69.  
  70.                 fa = cos(sqrt((float(m))**2 + (float(n))**2) * pi *c *t)
  71.                 f2 = cos(n * pi * xn)
  72.                 f3 = cos(n * pi * x)
  73.                 g2 = cos(m * pi * yn)
  74.                 g3 = cos(m * pi * y)
  75.                 f4 = f4 + ( fa * f2 * f3 * g2 * g3)
  76.  
  77. 31             continue
  78. 30           continue
  79.             
  80.              dat(j,jj) = f4
  81.  
  82. 21        continue
  83. 50        continue
  84.  
  85. c    This section finds the range of values in a single frame
  86.  
  87.           if (i .eq. 1) then 
  88.             do 91 im=1 , xsize
  89.              do 90 in=1 , ysize
  90.                 if (dat(im,in) .lt. bot) then 
  91.                   bot = dat(im,in)
  92.                 endif
  93.                 if (dat(im,in) .gt. top) then 
  94.                    top = dat(im,in)
  95.                 endif
  96. 90          continue
  97. 91        continue
  98.              diff = top - bot
  99.               ratio = 255.0 / diff
  100.            endif
  101.  
  102.  
  103. c    This section constructs a file name for each frame based on the 
  104. c    iteration number
  105.  
  106.           write (tmp,37) i
  107. 37        format (I4)
  108.           do 92 ll=1,4
  109.               if ((tmp(ll:ll)) .eq. ' ') then
  110.                  tmp(ll:ll) = '0'
  111.               endif
  112. 92        continue
  113.           fname='wav.'//tmp
  114.  
  115. c    This line writes out a single frame
  116.  
  117.        call ds(fname,dat,50,50,top,bot)
  118.  
  119. 10     continue
  120.  
  121.     call ds_close
  122.        stop
  123.        end
  124.  
  125.  
  126. c
  127. c  See NCSA DataScope documentation for more information on the 
  128. c  ds_send call.  Uses routines in dscall.o, provided with DataScope.
  129. c
  130. c
  131.        subroutine ds(name,vals,nrows,ncols,max,min) 
  132.        integer nrows,ncols,dummy
  133.        real vals(ncols,nrows),rows(50),cols(50),max,min
  134.        character *80 host,name,flags
  135.  
  136.        do 500 i=1,nrows
  137. 500      rows(i) = float(i)
  138.  
  139.        do 501 i=1,ncols
  140. 501      cols(i) = float(i)
  141.  
  142.        max = 220.0
  143.        min = -150.0
  144.        flags = 'RG'
  145.  
  146.        call ds_send1(name,flags,max,min,nrows,ncols,rows,cols,vals)
  147.  
  148.        return
  149.        end
  150.