24小时热门版块排行榜    

查看: 1304  |  回复: 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的回帖

wxjbuilder

木虫 (知名作家)

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

shxincui518

铜虫 (正式写手)

厉害啊!崇拜啊!中奖啊!
2楼2008-11-21 22:34:10
已阅   回复此楼   关注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的回帖
普通表情 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[基金申请] 基金中了 +15 laoda193707 2026-08-06 15/750 2026-08-11 00:11 by jiafei2190
[基金申请] 帮忙看看fileCode +4 wwncly 2026-08-10 8/400 2026-08-10 22:07 by demonstreets
[基金申请] filecode +8 documentary 2026-08-10 8/400 2026-08-10 19:20 by loufangrui
[基金申请] 静等基金结果 +5 gjjjzhong 2026-08-10 16/800 2026-08-10 17:19 by Tide man
[基金申请] 关于Filecode分析方法 +3 majunge000 2026-08-10 3/150 2026-08-10 15:46 by lch2012
[基金申请] 国自然结果 +4 Vierhys 2026-08-10 8/400 2026-08-10 15:06 by Vierhys
[基金申请] 应该是93bebmhtak前后十一个字符比较关键 +14 Lanmanbaby 2026-08-09 22/1100 2026-08-10 14:57 by wwncly
[基金申请] 8月时间戳变的,举个手。玩一下,释放压力 +11 archvillain 2026-08-04 13/650 2026-08-10 14:41 by seekfind
[基金申请] 据悉今年马上要出结果了 +7 瞬息宇宙 2026-08-10 8/400 2026-08-10 12:42 by Vivilian
[基金申请] 2026国自然放榜时间 +9 布布和一二 2026-08-08 9/450 2026-08-10 11:22 by xxxx2020
[基金申请] 这样的filecode谁见过 +11 布布和一二 2026-08-08 22/1100 2026-08-10 11:10 by wmfsnow
[基金申请] 关于filecode,很负责任的告诉大家 +6 爱看书的可乐 2026-08-08 7/350 2026-08-08 22:13 by a_niu
[基金申请] 国基金的申报应该改成非等额制,评价高的钱多评价低的钱少,但是增加资助率 +7 a089 2026-08-07 7/350 2026-08-08 18:05 by gltch
[基金申请] 固定端突然变了,今天 +6 archvillain 2026-08-06 10/500 2026-08-07 16:03 by 医学老男孩
[基金申请] 听说今天filecode变了 +24 布布和一二 2026-08-06 47/2350 2026-08-07 16:02 by zhiyanjiang
[基金申请] filecode +14 等待解的谜 2026-08-06 19/950 2026-08-07 12:20 by wlwhappy
[基金申请] 求各位大神看下 100+6 hpkpkpkp 2026-08-05 33/1650 2026-08-06 14:49 by zhiyanjiang
[基金申请] 影响面上的因素 +8 布布和一二 2026-08-05 11/550 2026-08-06 10:41 by 宝贝虫子
[基金申请] 好消息?这个有何含义??? +8 Tide man 2026-08-05 10/500 2026-08-05 16:14 by xmuxiaoyu
[基金申请] 有没有H口的?有收到消息的吗? +3 超级海虾 2026-08-04 3/150 2026-08-04 17:26 by 学教育滴
信息提示
请填处理意见