[原创] 世界杯小组赛模拟出线程序

module NrType ! 确定常数
        implicit none

        public ! 均设为公有变量
        integer(selected_int_kind(2)),parameter::IxB=selected_int_kind(9) ! 整数类型选择
        integer(IxB),parameter::DP=kind(1.0e0) ! 单精度实数

end module NrType

program football
        use NrType
        implicit none

        save ! 均为静态变量
        integer(IxB),parameter::NCSV=10 ! 输入输出文件号
        integer(IxB),parameter::WIN=3,DRAW=1,LOSS=0 ! 胜3平1负0
        integer(IxB),parameter::TEAMS=4,TEAMSCORE=3,CYCLING=2,NUM=21000000_IxB ! 小组球队数TEAMS 小组赛循环数CYCLING(世界杯小组赛为1,欧冠亚冠主客场小组赛为2) 球队积分TEAMSCORE 样本总数NUM
        integer(IxB),allocatable::matrix(:,:),score(:),first(:),second(:),firstLoc(:),secondLoc(:)
        integer(IxB)::i,j,k,n,point,total

        open(NCSV,file='计算结果.csv')
        allocate(matrix(TEAMS,TEAMS),score(TEAMS),first(NUM),second(NUM),firstLoc(NUM),secondLoc(NUM))
        matrix=0 ! 矩阵元素初值为0 主对角线设为0
        total=0

        CALL RANDOM_SEED 

        do k=1,NUM
                !write(NCSV,"(a,4(',',i2))")'表格',(i,i=1,TEAMS) ! 表头

                do i=1,TEAMS
                        do j=1,i-1
                                do n=1,CYCLING ! 小组赛循环数CYCLING
                                        call CalPoint(point) ! 比赛结果
                                        matrix(i,j)=matrix(i,j)+point ! 关于主对角线对称 若为3分则对手为0分
                                        if(point==DRAW)matrix(j,i)=matrix(j,i)+point ! 关于主对角线对称 平局两队各得1分
                                        if(point==LOSS)matrix(j,i)=matrix(j,i)+WIN ! 关于主对角线对称 若为0分则对手为3分
                                end do
                        end do
                end do

                !do i=1,TEAMS
                        !write(NCSV,"(i2,4(',',i2))")i,matrix(i,:)
                !end do
                
                score=(/(sum(matrix(:,j)),j=1,TEAMS)/) ! 总积分
                total=total+count(score==TEAMSCORE)
                first(k)=maxval(score) ! 小组头名积分
                firstLoc(k)=maxloc(score,1) ! 头名球队
                !write(NCSV,"(a,4(',',i2))")'总积分',score ! 各队总积分
                !write(NCSV,"(a,',',i2,',',a,',',i2)")'头名积分',first(k),'头名球队',firstLoc(k)
                ! 头名积分置0以便查找次名
                score(firstLoc(k))=0 ! 头名积分置0 此时数组score已经改变
                second(k)=maxval(score) ! 小组次名积分
                secondLoc(k)=maxloc(score,1) ! 次名球队
                !write(NCSV,"(a,',',i2,',',a,',',i2)")'次名积分',second(k),'次名球队',secondLoc(k)
                matrix=0 ! 样本矩阵清零
        end do

        write(NCSV,"(a,5(',',a))")'球队积分','头名次数','次名次数','总次数','出线概率','头名概率' ! 表头
        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)

        write(*,*)'程序结束,按任意键退出!'
        read(*,*)

contains
        subroutine CalPoint(point) ! 模拟一场比赛胜平负结果
                integer(IxB),intent(out)::point
                real(DP)::harvest
                real(DP),parameter::R1=0.33333333e0,R2=0.66666666e0 ! 胜平负概率相同,均为1/3

                CALL RANDOM_NUMBER(harvest)

                if(harvest<=R1)then ! 胜
                        point=WIN
                else if(harvest<=R2)then ! 平
                        point=DRAW
                else ! 负
                        point=LOSS
                end if
                
                return
        end subroutine
end program football