SHARE
TWEET

pseudorandom

starm100 Apr 2nd, 2019 78 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program game
  2. implicit none
  3. type measure
  4.     real(4)::amount
  5.     character(len=4)::units
  6. end type measure
  7. integer::points=0,r
  8. real::r0,rk
  9. character(len=1)::prompt
  10. type(measure)::british(1:6),metric(1:6),answer
  11.  
  12. british(1:6).amount=1
  13. british(1).units='in'
  14. metric(1)=measure(2.54,'cm')
  15. british(2).units='ft'
  16. metric(2)=measure(30.48,'cm')
  17. british(3).units='yd'
  18. metric(3)=measure(91.44,'cm')
  19. british(4).units='cable'
  20. metric(4)=measure(185.2,'m')
  21. british(5).units='mile'
  22. metric(5)=measure(1609.344,'m')
  23. british(6).units='knot'
  24. metric(6)=measure(1852,'m')
  25.  
  26. write(*,'(a\)') 'r0(0<r0<1)='
  27. read(*,*) r0
  28. do while (.true.)
  29. r=random_int(r0)
  30. write(*,'(f3.1,1x,a4,1x,a8)') british(r),' equals?'
  31. read(*,*) answer.amount,answer.units
  32. if ((answer.amount .EQ. metric(r).amount) .AND. (answer.units .EQ. metric(r).units)) then
  33.     write(*,*) 'Correct!'
  34.     points=points+1
  35. else
  36.     write(*,*) 'Wrong'
  37.     write(*,*) 'Your score is:',points
  38.     write(*,*) 'Continue(y/n)?'
  39.     read(*,*) prompt
  40.     if (prompt .EQ. 'y') then
  41.         points=0
  42.         continue
  43.     else
  44.         stop
  45.     end if
  46. end if
  47. end do  
  48. contains
  49.    
  50. function random_int(r0) result (r) !Генератор псевдослучайных чисел
  51. implicit none
  52. real,intent(inout)::r0
  53. real::r1
  54. real(8),parameter::pi_8=4*atan(1.0_8)
  55. integer::r
  56. integer,parameter::a=1,b=6
  57. r1=(pi_8-2+r0)**3
  58. r1=r1-floor(r1)
  59. r0=r1
  60. r1=(b-a)*r1+a
  61. r=nint(r1)
  62. end function random_int
  63.    
  64. end program game
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top