24小时热门版块排行榜    

查看: 1317  |  回复: 5
当前主题已经存档。

stereochemistry

[交流] 如果你玩双色球,这个小程序可能能帮助你拿500万大奖哦。

program Shuangseqiu

interface
function random10(lbound,ubound)
implicit none

real:: lbound, ubound
real:: random10(33)
end function
end interface
!------------------------------------------------------------
interface
function random11(lbound,ubound)
implicit none
real:: lbound, ubound
real:: random11(16)
end function
end interface
!-----------------------------------------------------------
integer :: jie(6),s,ij,ik,ikk,io
real ::a(33),b(16)
integer:: aa(33),kpp,ll,aaa(33),oo
integer:: bb(16), bbb(16)
integer:: red(6)
real:: kp
Print*, 'This is a program written in 2008-11-13,for ShuangSeQiu Games'
Print*, '------This is a present for Xiao LV ShiXiong from LWL--------'
call random_seed()

a=random10(1.0,33.0)

do ij=1,33
     do ik=ij+1,33
          if(a(ik).ge.a(ij)) then
              kp=a(ij)
                  a(ij)=a(ik)
                  a(ik)=kp
        endif
        enddo
        enddo


do ikk =1,33
if(ikk.gt.16) goto 145
bb(ikk)=0
145  continue
   aa(ikk)=0
enddo


do ikk =1,33
   a(ikk)=int(a(ikk))
    do io=1,33
if(a(ikk).eq.io) aa(io)=aa(io)+1
enddo
enddo   
!---------------------------------------
  b=random11(1.0,16.0)
do ikk =1,16
   b(ikk)=int(b(ikk))
    do io=1,16
if(b(ikk).eq.io) bb(io)=bb(io)+1
enddo
enddo  
!---------------------------------------


do oo=1,33
if(oo.gt.16) goto 123
bbb(oo)=oo
123 continue
aaa(oo)=oo
enddo


!---------------------------------------------
do ij=1,33
     do ik=ij+1,33
          if(aa(ik).ge.aa(ij)) then
               oo=aaa(ij)
                   aaa(ij)=aaa(ik)
                   aaa(ik)=oo

               kpp=aa(ij)
                   aa(ij)=aa(ik)
                   aa(ik)=kpp
        endif
        enddo
        enddo
!---------------------------------------------------
do ij=1,16
     do ik=ij+1,16
          if(bb(ik).ge.bb(ij)) then
               oo=bbb(ij)
                   bbb(ij)=bbb(ik)
                   bbb(ik)=oo

               kpp=bb(ij)
                   bb(ij)=bb(ik)
                   bb(ik)=kpp
        endif
        enddo
        enddo


!------------------------------------------------
Write(*,*) '+++++++++++++++++++++++++++++++++++++'
Write(*,*) 'The Red Six one is here: From 1--33'
Write(*,*) '++++++++++++++++++++++++++++++++++++++'
do ik=1,6
write(*,*)ik,aaa(ik), aa(ik)
red(ik)=aaa(ik)
enddo
do ik=1,6
   do ij=ik+1,6
   if(red(ij).ge.red(ik)) then
      oo=red(ik)
          red(ik)=red(ij)
          red(ij)=oo
          endif
          enddo
          enddo
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Write(*,*) '+++++++++++++++++++++++++++++++++++++'
Write(*,*) 'The Blue Two one is here: From 1--16'
Write(*,*) '++++++++++++++++++++++++++++++++++++++'
do ik=1,2
write(*,*)ik,bbb(ik), bb(ik)
enddo
Write(*,*) '---------The 500 Million is Here--Please enjot it---------------'


write(*,"(6(i2,1x),'**',1x,2(i2,1x))"  red(6),red(5),red(4),red(3),red(2),red(1) &
, bbb(1),bbb(2)
Print*, 'Good Luck-Good Luck-Good Luck-Good Luck-Good Luck-Good Luck-Good Luck'     
end


function random10(lbound,ubound)
real:: len
real:: random10(33)
real:: lbound, ubound
real t
integer i
len=ubound-lbound


do i=1,33
call random_number(t)

random10(i)=lbound+len*t

enddo
return
end


function random11(lbound,ubound)
real:: len
real:: random11(16)
real:: lbound, ubound
real t
integer i
len=ubound-lbound


do i=1,16
call random_number(t)

random11(i)=lbound+len*t

enddo
return
end

[ Last edited by woshilsh on 2008-11-29 at 16:09 ]
回复此楼
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

shxincui518

铜虫 (正式写手)

厉害啊!崇拜啊!中奖啊!
2楼2008-11-21 22:34:10
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

wxjbuilder

木虫 (知名作家)

有没有注释语句,可以教大家来学习一下如何编程?
悠悠天地,奈何独立苍茫?
3楼2008-11-28 21:18:50
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

yongqin965

银虫 (小有名气)

楼主厉害!好好研究...
4楼2008-12-18 18:00:03
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

dkx10

厉害是什么语言呀
5楼2009-01-04 14:01:11
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 stereochemistry 的主题更新
普通表情 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[基金申请] 欢迎发来filecode的Mz6后的代码验证其规律 +35 医学老男孩 2026-08-13 82/4100 2026-08-17 19:18 by 我4大白菜
[基金申请] 感觉是下周放榜了 +4 angus9576 2026-08-17 8/400 2026-08-17 17:26 by angus9576
[基金申请] filecode=后面第一个是大写字母 +8 wangze12014 2026-08-14 10/500 2026-08-17 17:05 by xter9665
[基金申请] 时间戳变了,能看出什么问题? +4 基诺咪客 2026-08-17 4/200 2026-08-17 16:10 by Vivilian
[基金申请] 哪位老哥知道今年的国自然具体哪一天放榜? +12 Ldrop2023 2026-08-13 15/750 2026-08-17 15:02 by 小豌豆_发芽
[基金申请] 今天系统多次维护,明天很可能放榜! +8 zju2000 2026-08-16 9/450 2026-08-17 12:20 by lmz0216
[基金申请] 时间戳又变了8-15 +13 archvillain 2026-08-15 25/1250 2026-08-16 20:13 by zhaosm1982
[基金申请] 2027广东省杰青 +3 奶牛小黑 2026-08-15 6/300 2026-08-16 20:07 by 奶牛小黑
[基金申请] 快农历七夕节了,轻松一下,男人悄悄话,女施主请不要进来。 +3 Tide man 2026-08-14 3/150 2026-08-16 17:47 by jurkat.1640
[基金申请] 咱们一起用铁证分析2026国家社科基金中标与否 +7 启萌科技 2026-08-12 26/1300 2026-08-16 12:35 by 启萌科技
[基金申请] 有时候,自然基金真的不能太认真 (我的申报经验) +10 majunge000 2026-08-11 12/600 2026-08-16 08:18 by xli1984
[精细化工] 招聘 金属平磨液,抛光液研发工程师 +3 小天0311 2026-08-14 3/150 2026-08-16 07:31 by H9PLUS
[基金申请] 各位道友,我要去昆明玩几天,回来见。 +7 Tide man 2026-08-14 8/400 2026-08-15 01:11 by arzu_hma
[基金申请] 是这周出结果还是下周出结果? +4 yuleib84 2026-08-11 4/200 2026-08-14 23:05 by lfy8008
[硕博家园] 读博的好处 +4 lnee 2026-08-11 4/200 2026-08-14 10:20 by ahsoarli
[基金申请] 不应该看fileCode +7 且听虎啸 2026-08-12 9/450 2026-08-13 14:27 by flydreamws
[基金申请] Filecode 又变了,巨变 +3 WH3796 2026-08-12 4/200 2026-08-13 14:13 by 小木虫6752397
[基金申请] 分享一下我之前已中青C的计划书的filecode +4 布布和一二 2026-08-11 5/250 2026-08-13 12:56 by cratir
[基金申请] 2019年青年基金涵评意见,大家看看几个A,几个B? +11 Tide man 2026-08-11 11/550 2026-08-13 07:35 by 撸猫猫
[基金申请] 什么时候出结果,有咨询渠道??? +3 Tide man 2026-08-11 3/150 2026-08-11 17:54 by kudofaye
信息提示
请填处理意见