Denmark1

Blackjack Program

Jan 9th, 2015
460
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Program blackjack
  2. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  3. !C                                                                        C
  4. !C        PROGRAM NAME:        SHUFFLE                                    C
  5. !C                                                                        C
  6. !C        INPUTS:                                                         C
  7. !C                                                                        C
  8. !C        OUTPUTS:                                                        C
  9. !C                                                                        C
  10. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  11. IMPLICIT NONE
  12. character(len=11) cards(52), player_cards(13), dealer_cards(13)
  13. character(len=1) parse(572)
  14. logical player_busted, dealer_busted, bj
  15. integer player_score, dealer_score
  16. equivalence(parse(1),cards(1)),(player_cards(1),cards(1)),(dealer_cards(1),cards(13))
  17. data cards/' 2-hearts  ',' 3-hearts  ',' 4-hearts  ',' 5-hearts  ',&
  18.            ' 6-hearts  ',' 7-hearts  ',' 8-hearts  ',' 9-hearts  ',&
  19.            '10-hearts  ',' J-hearts  ',' Q-hearts  ',' K-hearts  ',&
  20.            ' A-hearts  ',                                          &
  21.            ' 2-clubs   ',' 3-clubs   ',' 4-clubs   ',' 5-clubs   ',&
  22.            ' 6-clubs   ',' 7-clubs   ',' 8-clubs   ',' 9-clubs   ',&
  23.            '10-clubs   ',' J-clubs   ',' Q-clubs   ',' K-clubs   ',&
  24.            ' A-clubs   ',                                          &
  25.            ' 2-spades  ',' 3-spades  ',' 4-spades  ',' 5-spades  ',&
  26.            ' 6-spades  ',' 7-spades  ',' 8-spades  ',' 9-spades  ',&
  27.            '10-spades  ',' J-spades  ',' Q-spades  ',' K-spades  ',&
  28.            ' A-spades  ',                                          &
  29.            ' 2-diamonds',' 3-diamonds',' 4-diamonds',' 5-diamonds',&
  30.            ' 6-diamonds',' 7-diamonds',' 8-diamonds',' 9-diamonds',&
  31.            '10-diamonds',' J-diamonds',' Q-diamonds',' K-diamonds',&
  32.            ' A-diamonds'/
  33. player_busted = .false.
  34. dealer_busted = .false.
  35. call knuth_shuffle(cards)
  36. call player_play(player_cards,parse, player_busted, player_score)
  37. If (player_score .gt. 21) then
  38. print *, "Player has busted with a score of", player_score
  39. else
  40. call dealer_play(dealer_cards,parse, dealer_busted, dealer_score, bj)
  41. endif
  42. end program blackjack
  43.  
  44. subroutine knuth_shuffle(cards)
  45. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  46. !C                                                                        C
  47. !C        PROGRAM NAME:        KNUTH_SHUFFLE                              C
  48. !C                                                                        C
  49. !C        INPUTS:              CARDS                                      C
  50. !C                                                                        C
  51. !C        OUTPUTS:             CARDS                                      C
  52. !C                                                                        C
  53. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  54. implicit none
  55. integer lo, card
  56. character(len=11) cards(52), temp
  57. real rn
  58. call random_seed()
  59. do lo=52,1,-1
  60.     call random_number(rn)
  61.     card=int(rn*(lo+1))
  62.     if(card.le.0) card = 1
  63.     if(card.ge.52) card = 52
  64.     if(card.ne.lo) then
  65.           temp = cards(card)
  66.           cards(card) = cards(lo)
  67.           cards(lo) = temp
  68.      endif
  69. enddo
  70. return
  71. end subroutine knuth_shuffle
  72.  
  73.  
  74. subroutine dealer_play(dealer_cards,parse, dealer_busted, isum, bj)
  75. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  76. !C                                                                        C
  77. !C        PROGRAM NAME:        DEALER_PLAY                                C
  78. !C                                                                        C
  79. !C        INPUTS:              DEALER_CARDS                               C
  80. !C                                                                        C
  81. !C        OUTPUTS:             <none>                                     C
  82. !C                                                                        C
  83. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  84. implicit none
  85. integer i,j,ival1, ival2, ace, isum,ipos1,ipos2
  86. character(len=11) dealer_cards(13)
  87. character(len=1) parse(572)
  88. logical dealer_busted, bj
  89. ace = 0
  90. isum = 0
  91. ipos1=133
  92. ipos2=134
  93. ! turn over first two cards
  94. write(*,'("DEALER IS DEALT:  ",A11,5x,A11)') dealer_cards(1), dealer_cards(2)
  95. !
  96. ! Parse the cards
  97. !
  98. ! First card
  99. !  i and j are the ASCII representations of the numbers (1-9) or
  100. !  letters (J,Q,K,A)
  101. !
  102. i=ichar(parse(ipos1))
  103. j=ichar(parse(ipos2))
  104. !
  105. !  If the first character is "1" (ASCII 49), then
  106. !  the card must be a "ten"
  107. !
  108. If(i.eq.49) then
  109.      ival1 = 10
  110. else
  111.      if(j.lt.65) then   !  numbers
  112.           ival1=j-48    !  convert ASCII to base 10
  113.      else
  114.           if(j.eq.74) ival1=10  !  J
  115.           if(j.eq.81) ival1=10  !  Q
  116.           if(j.eq.75) ival1=10  !  K
  117.           if(j.eq.65) then
  118.                ival1=11         !  A
  119.                ace = ace + 1
  120.           endif
  121.      endif
  122. endif
  123. !
  124. !  Second Card
  125. !
  126. ipos1=ipos1+11
  127. ipos2=ipos2+11
  128. i=ichar(parse(ipos1))
  129. j=ichar(parse(ipos2))
  130. If(i.eq.49) then
  131.      ival2 = 10
  132. else
  133.      if(j.lt.65) then
  134.           ival2=j-48
  135.      else
  136.           if(j.eq.74) ival2=10
  137.           if(j.eq.81) ival2=10
  138.           if(j.eq.75) ival2=10
  139.           if(j.eq.65) then
  140.                ival2=11
  141.                ace = ace + 1
  142.           endif
  143.      endif
  144. endif
  145. isum = ival1 + ival2
  146. print *,' sum of first dealer two cards = ',isum
  147. If(isum.eq.21) then
  148.   Write(*,'(" DEALER HAS BLACKJACK - YOU LOSE ")')
  149.   Return
  150. endif
  151. !
  152. !  Third card
  153. !
  154. do while (isum.lt.17)
  155. If (isum.lt.17) then
  156.      ipos1=ipos1+11
  157.      ipos2=ipos2+11
  158.      i=ichar(parse(ipos1))
  159.      j=ichar(parse(ipos2))
  160.  
  161. If(i.eq.49) then
  162.      ival1 = 10
  163. else
  164.      if(j.lt.65) then
  165.           ival1=j-48
  166.      else
  167.           if(j.eq.74) ival1=10
  168.           if(j.eq.81) ival1=10
  169.           if(j.eq.75) ival1=10
  170.           if(j.eq.65) then
  171.                ival1=11
  172.                ace = ace + 1
  173.           endif
  174.      endif
  175. endif
  176. isum = isum+ival1
  177. print *,' sum of dealer cards = ',isum
  178. endif
  179. If(isum.gt.21) then
  180.   dealer_busted = .true.
  181.   return
  182. endif
  183. enddo
  184.  
  185. return
  186. end subroutine dealer_play
  187.  
  188.  
  189.  
  190.  
  191.  
  192. subroutine player_play(player_cards,parse, player_busted, isum)
  193. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  194. !C                                                                        C
  195. !C        PROGRAM NAME:        PLAYER_PLAY                                C
  196. !C                                                                        C
  197. !C        INPUTS:              PLAYER_CARDS                               C
  198. !C                                                                        C
  199. !C        OUTPUTS:             <none>                                     C
  200. !C                                                                        C
  201. !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  202. implicit none
  203. integer i,j,ival1, ival2, ace, isum,ipos1,ipos2
  204. character(len=11) player_cards(13)
  205. character(len=1) parse(572)
  206. logical hit, player_busted
  207. hit = .true.
  208. ace = 0
  209. isum = 0
  210. ipos1=1
  211. ipos2=2
  212. ! turn over first two cards
  213. write(*,'("PLAYER IS DEALT:  ",A11,5x,A11)') player_cards(1), player_cards(2)
  214. !
  215. ! Parse the cards
  216. !
  217. ! First card
  218. !  i and j are the ASCII representations of the numbers (1-9) or
  219. !  letters (J,Q,K,A)
  220. !
  221. i=ichar(parse(ipos1))
  222. j=ichar(parse(ipos2))
  223. !
  224. !  If the first character is "1" (ASCII 49), then
  225. !  the card must be a "ten"
  226. !
  227. If(i.eq.49) then
  228.      ival1 = 10
  229. else
  230.      if(j.lt.65) then   !  numbers
  231.           ival1=j-48    !  convert ASCII to base 10
  232.      else
  233.           if(j.eq.74) ival1=10  !  J
  234.           if(j.eq.81) ival1=10  !  Q
  235.           if(j.eq.75) ival1=10  !  K
  236.           if(j.eq.65) then
  237.                ival1=11         !  A
  238.                ace = ace + 1
  239.           endif
  240.      endif
  241. endif
  242. !
  243. !  Second Card
  244. !
  245. ipos1=ipos1+11
  246. ipos2=ipos2+11
  247. i=ichar(parse(ipos1))
  248. j=ichar(parse(ipos2))
  249. If(i.eq.49) then
  250.      ival2 = 10
  251. else
  252.      if(j.lt.65) then
  253.           ival2=j-48
  254.      else
  255.           if(j.eq.74) ival2=10
  256.           if(j.eq.81) ival2=10
  257.           if(j.eq.75) ival2=10
  258.           if(j.eq.65) then
  259.                ival2=11
  260.                ace = ace + 1
  261.           endif
  262.      endif
  263. endif
  264. isum = ival1 + ival2
  265. print *,' sum of player first two cards = ',isum
  266. If(isum.eq.21) then
  267.   Write(*,'(" PLAYER HAS BLACKJACK ")')
  268.   Return
  269. endif
  270. !
  271. !  Third card
  272. !
  273. print *, "Do you want to hit? T or F"
  274. read *, hit
  275. do while (hit)
  276. If (isum.lt.17) then
  277.      ipos1=ipos1+11
  278.      ipos2=ipos2+11
  279.      i=ichar(parse(ipos1))
  280.      j=ichar(parse(ipos2))
  281.  
  282. If(i.eq.49) then
  283.      ival1 = 10
  284. else
  285.      if(j.lt.65) then
  286.           ival1=j-48
  287.      else
  288.           if(j.eq.74) ival1=10
  289.           if(j.eq.81) ival1=10
  290.           if(j.eq.75) ival1=10
  291.           if(j.eq.65) then
  292.                ival1=11
  293.                ace = ace + 1
  294.           endif
  295.      endif
  296. endif
  297. isum = isum+ival1
  298. print *,' sum of player cards = ',isum
  299. endif
  300. If(isum.gt.21) then
  301.   player_busted = .true.
  302.   return
  303. endif
  304. enddo
  305. print *, "Your sum is", isum
  306. return
  307. end subroutine player_play
RAW Paste Data