世界杯小组赛模拟出线程序

weixing1531 · 发表于 2014-6-23 21:23:52

本帖最后由 weixing1531 于 2014-6-24 21:00 编辑

小组共4只球队单循环共6场比赛（主客场双循环共12场比赛）小组积分前两名出线

两大假定：
1.各队胜、平、负概率均等，均为1/3，不模拟进球
2.积分相同情况下，抽签决定出线

运行环境： Win7 i3 CVF6.6C

世界杯小组出线概率模拟结果：

欧冠主客场双循环小组出线概率模拟结果：

源程序：

[Fortran] 纯文本查看 复制代码

01module NrType ! 确定常数
02        implicit none
03 
04        public ! 均设为公有变量
05        integer(selected_int_kind(2)),parameter::IxB=selected_int_kind(9) ! 整数类型选择
06        integer(IxB),parameter::DP=kind(1.0e0) ! 单精度实数
07 
08end module NrType
09 
10program football
11        use NrType
12        implicit none
13 
14        save ! 均为静态变量
15        integer(IxB),parameter::NCSV=10 ! 输入输出文件号
16        integer(IxB),parameter::WIN=3,DRAW=1,LOSS=0 ! 胜3平1负0
17        integer(IxB),parameter::TEAMS=4,TEAMSCORE=3,CYCLING=2,NUM=21000000_IxB ! 小组球队数TEAMS 小组赛循环数CYCLING(世界杯小组赛为1,欧冠亚冠主客场小组赛为2) 球队积分TEAMSCORE 样本总数NUM
18        integer(IxB),allocatable::matrix(:,:),score(:),first(:),second(:),firstLoc(:),secondLoc(:)
19        integer(IxB)::i,j,k,n,point,total
20 
21        open(NCSV,file='计算结果.csv')
22        allocate(matrix(TEAMS,TEAMS),score(TEAMS),first(NUM),second(NUM),firstLoc(NUM),secondLoc(NUM))
23        matrix=0 ! 矩阵元素初值为0 主对角线设为0
24        total=0
25 
26        CALL RANDOM_SEED
27 
28        do k=1,NUM
29                !write(NCSV,"(a,4(',',i2))")'表格',(i,i=1,TEAMS) ! 表头
30 
31                do i=1,TEAMS
32                        do j=1,i-1
33                                do n=1,CYCLING ! 小组赛循环数CYCLING
34                                        call CalPoint(point) ! 比赛结果
35                                        matrix(i,j)=matrix(i,j)+point ! 关于主对角线对称 若为3分则对手为0分
36                                        if(point==DRAW)matrix(j,i)=matrix(j,i)+point ! 关于主对角线对称 平局两队各得1分
37                                        if(point==LOSS)matrix(j,i)=matrix(j,i)+WIN ! 关于主对角线对称 若为0分则对手为3分
38                                end do
39                        end do
40                end do
41 
42                !do i=1,TEAMS
43                        !write(NCSV,"(i2,4(',',i2))")i,matrix(i,:)
44                !end do
45                 
46                score=(/(sum(matrix(:,j)),j=1,TEAMS)/) ! 总积分
47                total=total+count(score==TEAMSCORE)
48                first(k)=maxval(score) ! 小组头名积分
49                firstLoc(k)=maxloc(score,1) ! 头名球队
50                !write(NCSV,"(a,4(',',i2))")'总积分',score ! 各队总积分
51                !write(NCSV,"(a,',',i2,',',a,',',i2)")'头名积分',first(k),'头名球队',firstLoc(k)
52                ! 头名积分置0以便查找次名
53                score(firstLoc(k))=0 ! 头名积分置0 此时数组score已经改变
54                second(k)=maxval(score) ! 小组次名积分
55                secondLoc(k)=maxloc(score,1) ! 次名球队
56                !write(NCSV,"(a,',',i2,',',a,',',i2)")'次名积分',second(k),'次名球队',secondLoc(k)
57                matrix=0 ! 样本矩阵清零
58        end do
59 
60        write(NCSV,"(a,5(',',a))")'球队积分','头名次数','次名次数','总次数','出线概率','头名概率' ! 表头
61        write(NCSV,"(4(i8,','),f9.7,',',f9.7)")TEAMSCORE,count(first==TEAMSCORE),count(second==TEAMSCORE),total,dble(count(first==TEAMSCORE)+count(second==TEAMSCORE))/dble(total),dble(count(first==TEAMSCORE))/dble(total)
62 
63        write(*,*)'程序结束,按任意键退出!'
64        read(*,*)
65 
66contains
67        subroutine CalPoint(point) ! 模拟一场比赛胜平负结果
68                integer(IxB),intent(out)::point
69                real(DP)::harvest
70                real(DP),parameter::R1=0.33333333e0,R2=0.66666666e0 ! 胜平负概率相同,均为1/3
71 
72                CALL RANDOM_NUMBER(harvest)
73 
74                if(harvest<=R1)then ! 胜
75                        point=WIN
76                else if(harvest<=R2)then ! 平
77                        point=DRAW
78                else ! 负
79                        point=LOSS
80                end if
81                 
82                return
83        end subroutine
84end program football