home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / C / Applications / DataScope 2.0.3 / Datafiles / Example_rmt_pgm / wavex.f < prev   
Encoding:
Text File  |  1994-05-04  |  3.7 KB  |  154 lines  |  [TEXT/MPS ]
  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  Remember that on SUN4 systems, you cannot run external routines
  14. c  unless your IP number is hardcoded into the system table as a remote
  15. c  host; this is because DataScope uses the rexecd socket, where this
  16. c  restriction applies.
  17. c
  18. c  On UNICOS:
  19. c     cc -DUNICOS -c dscall.c
  20. c     cf77 wavex.f dscall.o -o wavex -lnet
  21. c
  22. c  On Suns:
  23. c     cc -DSUN -c dscall.c
  24. c     f77 wavex.f dscall.o -o wavex
  25. c
  26. c
  27. c  original version:  Alan Craig, 1989
  28. c  DataScope version:  Tim Krauskopf, 1989
  29. c
  30. c  this code is in the public domain
  31. c
  32.  
  33.        real dat(50,50),diff
  34.        character*1 hdf(50,50)
  35.        character*1 pal(768)
  36.        character*80 fname,host
  37.        character*4 tmp
  38.        integer idab(50,50),shape(2)
  39. c
  40. c  Change this host line to indicate YOUR Macintosh.  Use the 
  41. c  IP address in most cases, e.g.
  42. c            host = '192.17.20.10'
  43. c  or use the "name" associated with your Mac, e.g.
  44. c            host = 'mymac.uiuc.edu'
  45. c
  46.        host = '192.17.20.10'
  47.        call ds_open(host)
  48.        
  49.        
  50.        xn=0.0
  51.        yn=0.0
  52.        pi=3.1415926
  53.        c=0.1
  54.        be=0.1
  55.        xsize = 50 
  56.        ysize = 50 
  57.        ce=0.5
  58.        bot = 99999999
  59.        top= -999999999
  60.        fname = '        '
  61.        do 10 i=1,10,2
  62.           print*,'frame = ',i
  63.  
  64.           do 50 j = 1,xsize
  65.            do 21 jj=1,ysize
  66.              x = j / xsize 
  67.              y = jj / ysize
  68.              t = i
  69.              f4 = 0.0
  70.             
  71.               do 30 n = -15,15 
  72.                do 31 m= -15,15
  73.  
  74.                 fa = cos(sqrt((float(m))**2 + (float(n))**2) * pi *c *t)
  75.                 f2 = cos(n * pi * xn)
  76.                 f3 = cos(n * pi * x)
  77.                 g2 = cos(m * pi * yn)
  78.                 g3 = cos(m * pi * y)
  79.                 f4 = f4 + ( fa * f2 * f3 * g2 * g3)
  80.  
  81. 31             continue
  82. 30           continue
  83.             
  84.              dat(j,jj) = f4
  85.  
  86. 21        continue
  87. 50        continue
  88.  
  89. c    This section finds the range of values in a single frame
  90.  
  91.           if (i .eq. 1) then 
  92.             do 91 im=1 , xsize
  93.              do 90 in=1 , ysize
  94.                 if (dat(im,in) .lt. bot) then 
  95.                   bot = dat(im,in)
  96.                 endif
  97.                 if (dat(im,in) .gt. top) then 
  98.                    top = dat(im,in)
  99.                 endif
  100. 90          continue
  101. 91        continue
  102.              diff = top - bot
  103.               ratio = 255.0 / diff
  104.            endif
  105.  
  106.  
  107. c    This section constructs a file name for each frame based on the 
  108. c    iteration number
  109.  
  110.           write (tmp,37) i
  111. 37        format (I4)
  112.           do 92 ll=1,4
  113.               if ((tmp(ll:ll)) .eq. ' ') then
  114.                  tmp(ll:ll) = '0'
  115.               endif
  116. 92        continue
  117.           fname='wav.'//tmp
  118.  
  119. c    This line writes out a single frame
  120.  
  121.        call ds(fname,dat,50,50,top,bot)
  122.  
  123. 10     continue
  124.  
  125.     call ds_close
  126.        stop
  127.        end
  128.  
  129.  
  130. c
  131. c  See NCSA DataScope documentation for more information on the 
  132. c  ds_send call.  Uses routines in dscall.o, provided with DataScope.
  133. c
  134. c
  135.        subroutine ds(name,vals,nrows,ncols,max,min) 
  136.        integer nrows,ncols,dummy
  137.        real vals(ncols,nrows),rows(50),cols(50),max,min
  138.        character *80 host,name,flags
  139.  
  140.        do 500 i=1,nrows
  141. 500      rows(i) = float(i)
  142.  
  143.        do 501 i=1,ncols
  144. 501      cols(i) = float(i)
  145.  
  146.        max = 220.0
  147.        min = -150.0
  148.        flags = 'RG'
  149.  
  150.        call ds_send1(name,flags,max,min,nrows,ncols,rows,cols,vals)
  151.  
  152.        return
  153.        end
  154.