home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d2xx / d267 / diglib.lha / Diglib / diglib.zoo / diglib / fivmet.for < prev    next >
Text File  |  1989-06-20  |  5KB  |  240 lines
  1.     PROGRAM FIVMET
  2.     REAL*4 OILDENSITY, METALDENSITY
  3.     COMMON/HISTO/XPOS(5,500),DIAMETER,VOLTS,V0Z,SIGVX,SIGVZ
  4.     COMMON/RGA/IT,F1,C,R
  5.     INCLUDE GRAPH.INC
  6.     INCLUDE EXEC.INC
  7.     INCLUDE INTUIT.INC
  8.     INCLUDE GCBIG.PRM
  9.     DATA SPACING/1.4/,ALENGTH/500./
  10.      1          ,PI/3.14159265/,METALDENSITY/6.1/
  11.      2       ,G/981./,Q/1.602E-19/,OILDENSITY/0.91/
  12.     SIGVX = 0.01
  13.     SIGVZ = 1.0
  14.     IT = 1
  15. c    DENSITY = METALDENSITY
  16. c    WRITE(9,10)
  17. c10    FORMAT('ENTER DROP DIAMTER IN MICRONS')
  18. c    ACCEPT DIAMETER
  19. c    WRITE(9,15)
  20. c15    FORMAT('ENTER DROP VELOCITY IN CM/SEC')
  21. c    ACCEPT V0Z
  22. c    WRITE(9,20)
  23. c20    FORMAT('ENTER PLATE POTENTIAL IN KILOVOLTS')
  24. c    ACCEPT VOLTS
  25. c    WRITE(9,25)
  26. c25    FORMAT('OIL (0) OR METAL (1)')
  27. c    ACCEPT DENSITY
  28. c    IF(DENSITY.EQ.0) DENSITY = OILDENSITY
  29. c    WRITE(9,30)
  30. c30    FORMAT('NUMBER OF ELECTRONS?')
  31. c    ACCEPT ELECTRONS
  32.     DENSITY = OILDENSITY
  33.     DIAMETER = 90.
  34.     V0Z = 1000.
  35.     VOLTS = 30.
  36.     ELECTRONS = 0.
  37.     VOLTS = VOLTS * 1000.
  38.     RADIUS = DIAMETER/2.E4
  39.     DO 40 J = 1,5
  40.     DO 40 I = 1,500
  41.     XPOS(J,I) = 0.
  42. 40    CONTINUE
  43.     VDROP = 4*PI*(RADIUS)**3/3.
  44.     DROPMASS = VDROP*DENSITY
  45.     DO 50 I = 1,5
  46.     DO 50 J = 1,500
  47.     CALL RGAUSS(0.,SIGVX,VX)
  48.     CALL RGAUSS(V0Z,SIGVZ,VZ)
  49.     T = (-VZ+SQRT(VZ**2+2.*G*ALENGTH))/G
  50.     AX = Q*(ELECTRON+FLOAT(3-I))*VOLTS*1.E7/(DROPMASS*SPACING)
  51.     XPOS(I,J) = 0.5*AX*T**2
  52.     XPOS(I,J) = XPOS(I,J) + VX*T
  53. 50    CONTINUE
  54.     V0Z = V0Z/100.
  55.     CALL HIST
  56.     END
  57.  
  58.     SUBROUTINE RGAUSS(X0,SIGMA,V)
  59. C
  60.     COMMON/RGA/IT,F1,C,R
  61.     DATA PI/3.14159265/
  62. 11    IF(IT.NE.1) GO TO 2
  63.     IT = 2
  64.     R = RANFL(0)
  65.     C = COS(2.0*PI*R)
  66.     F1 = SQRT(-2.*ALOG(RANFL(0)))
  67.     V = F1*C*SIGMA+X0
  68.     GO TO 3
  69. 2    IT = 1
  70.     V = F1*SIN(2.*PI*R)*SIGMA+X0
  71. 3    RETURN
  72.     END
  73.  
  74.     SUBROUTINE HIST
  75.  
  76.     CALL DEVSEL(2,4,IERR)
  77.     IF(IERR.NE.0) STOP 'UNABLE TO SELECT DEVICE 1'
  78.     CALL BAR('X DEFLECTION (CM)'//CHAR(0),'NUMBER'//CHAR(0)
  79.      1        ,'DEFLECTION HISTOGRAM'//CHAR(0),0)
  80.     CALL ENDPLT
  81.     CALL RLSDEV
  82.     RETURN
  83.     END
  84.  
  85.     SUBROUTINE BAR(SXLAB,SYLAB,STITLE,TYPE)
  86.  
  87. C
  88. C
  89.     COMMON/HISTO/X(5,500),DIAMETER,VOLTS,V0Z,SIGVX,SIGVZ
  90.     INTEGER TYPE,COUNT(6,512)
  91.         REAL*4    XLOW,XHIGH,STEP,FBAR,YLOW,YHIGH,X0,Y0,VX0,VY0,VX1,VY1
  92.         CHARACTER*1 SXLAB(20),SYLAB(20),STITLE(20)
  93.     CHARACTER*20 LABEL1,LABEL2,LABEL3,LABEL4,LABEL5
  94. C
  95. C
  96.         YLOW   = 0.0
  97.         YHIGH  = 1.0
  98.         FBAR   = 512.
  99. C
  100.         XLOW = X(1,1)
  101.     XHIGH = X(1,1)
  102. C
  103.     DO 20 I = 1,5
  104.     DO 10 J = 1,500
  105.     XLOW = AMIN1(XLOW,X(I,J))
  106.     XHIGH = AMAX1(XHIGH,X(I,J))
  107. 10    CONTINUE
  108. 20    CONTINUE
  109.         STEP   = (XHIGH - XLOW) / FBAR
  110. C
  111.         DO 100 I = 1,512
  112.     DO 100 J = 1,6
  113.     COUNT(J,I) = 0
  114. 100    CONTINUE
  115. C
  116. C
  117.         DO 200 I = 1,5
  118.     DO 200 J = 1,500
  119.     IF(X(I,J).GE.XLOW) GO TO 101
  120.     JJ = 1
  121.     GO TO 103
  122. 101    IF(X(I,J).LE.XHIGH) GO TO 102
  123.     JJ = 512
  124.     GO TO 103
  125. C
  126. 102         JJ      = INT((X(I,J)-XLOW)/STEP) + 1
  127.             IF (JJ .GT. 512) JJ = 512
  128. 103         COUNT(I,JJ) = COUNT(I,JJ) + 1
  129.         COUNT(6,JJ) = COUNT(6,JJ) + 1
  130. C
  131. 200     CONTINUE
  132. C
  133.     IHI1 = COUNT(1,1)
  134.     IHI2 = COUNT(6,1)
  135.     DO 210 J = 1,512
  136.     IHI2 = MAX0(IHI2,COUNT(6,J))
  137.     DO 210 I = 1,5
  138.     IHI1 = MAX0(IHI1,COUNT(I,J))
  139. 210    CONTINUE
  140. C
  141.     YLOW = 0.0
  142.     YHIGH1 = FLOAT(IHI1) + 0.1 * FLOAT(IHI1)
  143.     YHIGH2 = FLOAT(IHI2) + 0.1 * FLOAT(IHI2)
  144. C
  145.     CALL BGNPLT
  146.     CALL GSCOLR(1,IERR)
  147.     CALL MAPSIZ(0.0,100.0,14.0,50.0,0.0)
  148.     CALL MAPSML(XLOW,XHIGH,YLOW,YHIGH1,SXLAB,SYLAB,STITLE,TYPE)
  149.  
  150. C
  151.         DO 300 I = 1,5
  152.     CALL GSCOLR(1+I,IERR)
  153.     X0 = XLOW
  154.     Y0 = 0.0
  155.     CALL SCALE(X0,Y0,VX0,VY0)
  156.     CALL GSMOVE(VX0,VY0)
  157. C
  158.     DO 400 J = 1,512
  159. C
  160.     X0   = XLOW + J * STEP
  161.     Y0   = FLOAT(COUNT(I,J))
  162.     CALL SCALE(X0,Y0,VX1,VY1)
  163.     IF(Y0.GT.0.) GO TO 398
  164.     CALL GSMOVE(VX1,VY0)
  165.     GO TO 399
  166. 398    CALL GSDRAW(VX0,VY1)
  167.     CALL GSDRAW(VX1,VY1)
  168.     CALL GSDRAW(VX1,VY0)
  169. C
  170. 399    VX0 = VX1
  171. 400    CONTINUE
  172. 300    CONTINUE
  173. C
  174.     CALL GSCOLR(1,IERR)
  175.     CALL MAPSIZ(0.0,100.0,54.0,85.0,0.0)
  176.     CALL MAPSML(XLOW,XHIGH,YLOW,YHIGH2,SXLAB,SYLAB,STITLE,TYPE)
  177.     CALL GSCOLR(7,IERR)
  178. C
  179.     X0 = XLOW
  180.     Y0 = 0.0
  181.     CALL SCALE(X0,Y0,VX0,VY0)
  182.     CALL GSMOVE(VX0,VY0)
  183. C
  184.     DO 500 J = 1,512
  185. C
  186. C
  187.     X0   = XLOW + J * STEP
  188.     Y0   = FLOAT(COUNT(6,J))
  189.     CALL SCALE(X0,Y0,VX1,VY1)
  190.     IF(Y0.GT.0.) GO TO 498
  191.     CALL GSMOVE(VX1,VY0)
  192.     GO TO 499
  193. 498    CALL GSDRAW(VX0,VY1)
  194.     CALL GSDRAW(VX1,VY1)
  195.     CALL GSDRAW(VX1,VY0)
  196. C
  197. 499    VX0 = VX1
  198. 500    CONTINUE
  199. 999    VOLTS = VOLTS/1000.
  200.     SIGVX = SIGVX * 10000.
  201.     SIGVZ = SIGVZ * 10000.
  202.     WRITE(LABEL1,510)INT(DIAMETER)
  203.     WRITE(LABEL2,510)INT(VOLTS)
  204.     WRITE(LABEL3,510)INT(V0Z)
  205.     WRITE(LABEL4,510)INT(SIGVX)
  206.     WRITE(LABEL5,510)INT(SIGVZ)
  207. 510    FORMAT(I6)
  208.     VLEN1 = GSLENS('DROPLET DIAMETER (MICRONS) = '//CHAR(0))
  209.     VLEN2 = GSLENS('PLATE KILOVOLTAGE = '//CHAR(0))
  210.     VLEN3 = GSLENS('MEAN Z VELOCITY (METERS/SECOND) = '//CHAR(0))
  211.     VLEN4 = GSLENS('X VELOCITY JITTER (MICRONS/SECOND) = '//CHAR(0))
  212.     VLEN5 = GSLENS('Z VELOCITY JITTER (MICRONS/SECOND) = '//CHAR(0))
  213.     CALL MAPSIZE( 0.0,100.0,0.0,12.0,0.0)
  214.     CALL GSCOLR(1,IERR)
  215.     CALL GSMOVE(0.,2.2)
  216.     CALL GSPSTR('Droplet diameter (microns) = '//CHAR(0))
  217.     CALL GSMOVE(0.,1.7)
  218.     CALL GSPSTR('Plate Kilovoltage = '//CHAR(0))
  219.     CALL GSMOVE(0.,1.2)
  220.     CALL GSPSTR('Mean z Velocity (meters/second) = '//CHAR(0))
  221.     CALL GSMOVE(0.,0.7)
  222.     CALL GSPSTR('x Velocity Jitter (microns/second) = '//CHAR(0))
  223.     CALL GSMOVE(0.,0.2)
  224.     CALL GSPSTR('z Velocity Jitter (microns/second) = '//CHAR(0))
  225.     CALL GSMOVE(VLEN1,2.2)
  226.     CALL GSPSTR(LABEL1//CHAR(0))
  227.     CALL GSMOVE(VLEN2,1.7)
  228.     CALL GSPSTR(LABEL2//CHAR(0))
  229.     CALL GSMOVE(VLEN3,1.2)
  230.     CALL GSPSTR(LABEL3//CHAR(0))
  231.     CALL GSMOVE(VLEN4,0.7)
  232.     CALL GSPSTR(LABEL4//CHAR(0))
  233.     CALL GSMOVE(VLEN5,0.2)
  234.     CALL GSPSTR(LABEL5//CHAR(0))
  235. C
  236. C       BYE
  237. C
  238.         RETURN
  239.         END
  240.