24小时热门版块排行榜    

查看: 1335  |  回复: 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 的主题更新
普通表情 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[硕博家园] 售SCI一区文章,我:8O5.5.1.O5.4,科目全,可伽急 +3 wsYGJnURYvm6 2026-08-31 3/150 2026-09-01 01:40 by o3EMxHUAQDtS
[考博] 售SCI一区T0P文章,我:8O.55.1.O.54,科目全,可伽急 +3 EZ67DG6CvcKL 2026-08-31 4/200 2026-09-01 01:30 by o3EMxHUAQDtS
[基金申请] 国社科又开始会评了,不知道这次命运如何 +7 雨打竹帘 2026-08-30 11/550 2026-08-31 23:16 by hittle2008
[找工作] 售SCI一区文章,我:8.O.55.1.O.54,科目齐全,可伽急 +3 EZ67DG6CvcKL 2026-08-31 3/150 2026-08-31 22:23 by o3EMxHUAQDtS
[考研] 售SCI文章,我:8O.5.5.1O.54,科目全,可十急 +3 EZ67DG6CvcKL 2026-08-31 3/150 2026-08-31 22:12 by o3EMxHUAQDtS
[基金申请] 投票:  有多少人是今天查系统知道结果的? +17 爱看书的可乐 2026-08-26 19/950 2026-08-31 21:30 by xiangy672
[基金申请] 哪位高人中了,把查询到的截图贴出来让我看看,让我长长见识 +6 yuleib84 2026-08-26 7/350 2026-08-31 19:46 by 鱼翔浅底1
[基金申请] 能否申诉? +7 echo8914667 2026-08-30 8/400 2026-08-31 17:00 by yihongxu
[文学芳草园] 梦想 +5 myrtle 2026-08-26 5/250 2026-08-31 14:40 by hahaboy
[基金申请] 29号明天会评吗 +4 笨笨唐 2026-08-28 4/200 2026-08-31 09:30 by huixian257
[基金申请] 有没有仍没收到信息的 +7 德尚中行 2026-08-27 8/400 2026-08-30 20:52 by purplejack
[基金申请] 系统查不到 +11 董八千 2026-08-26 11/550 2026-08-28 18:06 by Leogzhya
[基金申请] 面上合作单位盖章 +5 ssyjh 2026-08-27 5/250 2026-08-27 20:50 by gdfollow
[基金申请] 为什么 国际(地区)合作与交流项目 没有放榜? 10+3 majunge000 2026-08-26 11/550 2026-08-27 08:42 by 北京莱茵编辑
[基金申请] 2026年8月25日国自然放榜前突然收到列入评审专家邮件,有关系吗? +25 木水思豆 2026-08-25 28/1400 2026-08-26 14:53 by draco1987
[基金申请] 出来了 +9 trojank 2026-08-26 9/450 2026-08-26 14:25 by 宝贝虫子
[基金申请] 为什么国自然不能直接公布 +4 bjdxyxy 2026-08-26 4/200 2026-08-26 13:12 by qingmu1201
[基金申请] 项目信息和经费信息在系统里都可以看到了 +6 wittyboy 2026-08-26 14/700 2026-08-26 10:55 by wittyboy
[基金申请] 牛来!米来!面来! +8 beefly 2026-08-26 8/400 2026-08-26 08:37 by xuzhipiao
[基金申请] 在坚冰还盖着北海的时候,我看到了怒放的梅花。 (金币+10) +6 ziyangfang 2026-08-25 9/450 2026-08-25 20:26 by huagongfeihu
信息提示
请填处理意见