应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 仿真模拟 » 【求助】fortran程序,程序贴出来了，望高手帮忙
北京石油化工学院2026年研究生招生接收调剂公告
121/2返回列表12下一页
查看: 1177  |  回复: 11
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看
当前主题已经存档。

panjunxing

木虫 (著名写手)

小学生

[交流] 【求助】fortran程序,程序贴出来了，望高手帮忙

!   !  the pattern in presence partical
  
  
    INTEGER  DELT
    INTEGER  idum               
    INTEGER  T  
    REAL    ran2       
    REAL    G,D,A,F
               
   INTEGER DR(40),DL(40),DS(15),DX(15)
   REAL   U(40,40,15), IU(40,40,15)
         
       


!  PROGRAM ONE

    DATA  DELT, D, G, N1, N2,A, F,HA,WA&
               /1,0.5,1.2,40,15,0.02,0.4,0.2,0.4/
                                                 
                
   T=0
                
   IDUM=-1
          DO 20 X=1,N1
          DO 20 Y=1,N1
          DO 20 Z=1,N2
                U(X,Y,Z)=0.02*(ran2(idum)-0.5)+0.0
               
     20 CONTINUE
         

!   BOUNDARY CONDITION
          
25       DO 30 X=1,N1
          DO 30 Y=1,N1
          DO 30 Z=1,N2
                    
            DL(X)=X-1
            DR(X)=X+1
            DL(Y)=Y-1
            DR(Y)=Y+1
            DS(Z)=Z+1
            DX(Z)=Z-1

    30 CONTINUE
             

   DL(1)=N1
                        DR(N1)=1
                        DX(0)=1
                        DS(N2+1)=N2
            U(X,Y,1-1)=U(X,Y,1)
                        U(X,Y,N2+1)=U(X,Y,N2)
                        IU(X,Y,1-1)=IU(X,Y,1)
                        IU(X,Y,N2+1)=IU(X,Y,N2)                       

         
!   MAIN PROGRAM
  
       



  35 DO 80  X=1,N1
      DO 80  Y=1,N1
      DO 80  Z=1,N2
         

                        
  IU(X,Y,Z)=D*((6*(U(DR(X),Y,Z)+U(DL(X),Y,Z)&
                +U(X,DR(Y),Z)+U(X,DL(Y),Z)&
                +U(X,Y,DS(Z))+U(X,Y,DX(Z)))&
           +3*(U(DR(X),DR(Y),Z)+U(DR(X),DL(Y),Z)&
                +U(DL(X),DR(Y),Z)+U(DL(X),DL(Y),Z)&
                +U(DR(X),Y,DS(Z))+U(DR(X),Y,DX(Z))&
        +U(DL(X),Y,DS(Z))+U(DL(X),Y,DX(Z))&
         +U(X,DR(Y),DS(Z))+U(X,DR(Y),DX(Z))&
        +U(X,DL(Y),DS(Z))+U(X,DL(Y),DX(Z)))&
         +(U(DR(X),DR(Y),DS(Z))+U(DR(X),DR(Y),DX(Z))&
         +U(DL(X),DL(Y),DX(Z))+U(DL(X),DL(Y),DS(Z))&
        +U(DR(X),DL(Y),DS(Z))+U(DL(X),DR(Y),DS(Z))&
        +U(DL(X),DR(Y),DX(Z))+U(DR(X),DL(Y),DX(Z))))/80&
                -U(X,Y,Z))+G*TANH(U(X,Y,Z))-S*ALOG(G)
                               
80 CONTINUE
         


      DO 85 Z=1,N2
                   S=HA*WA*DE
                    IF(Z==1)THEN
                       DE=1
         ELSEIF(Z>1.AND.Z                        DE=0
         ELSEIF(Z==N2)THEN
                       DE=1


             END IF
           85  CONTINUE   






            


  

   
          
          
           90  DO 100 X=1,N1
                 DO 100 Y=1,N1
                   DO 100 Z=1,N2
           U(X,Y,Z)=IU(X,Y,Z)&
                    -(6*(IU(DR(X),Y,Z)+IU(DL(X),Y,Z)&
                        +IU(X,DR(Y),Z)+IU(X,DL(Y),Z)&
                            +IU(X,Y,DS(Z))+IU(X,Y,DX(Z)))&
                +3*(IU(DR(X),DR(Y),Z)+IU(DR(X),DL(Y),Z)&
                   +IU(DL(X),DR(Y),Z)+IU(DL(X),DL(Y),Z)&
                      +IU(DR(X),Y,DS(Z))+IU(DR(X),Y,DX(Z))&
                   +IU(DL(X),Y,DS(Z))+IU(DL(X),Y,DX(Z))&
                   +IU(X,DR(Y),DS(Z))+IU(X,DR(Y),DX(Z))&
                   +IU(X,DL(Y),DS(Z))+IU(X,DL(Y),DX(Z)))&
                  +(IU(DR(X),DR(Y),DS(Z))+IU(DR(X),DR(Y),DX(Z))&
                   +IU(DL(X),DL(Y),DX(Z))+IU(DL(X),DL(Y),DS(Z))&
                   +IU(DR(X),DL(Y),DS(Z))+IU(DL(X),DR(Y),DS(Z))&
                   +IU(DL(X),DR(Y),DX(Z))+IU(DR(X),DL(Y),DX(Z))))/80&
        +(6*(U(DR(X),Y,Z)+U(DL(X),Y,Z)&
                    +U(X,DR(Y),Z)+U(X,DL(Y),Z)&
                    +U(X,Y,DS(Z))+U(X,Y,DX(Z)))&
                 +3*(U(DR(X),DR(Y),Z)+U(DR(X),DL(Y),Z)&
                    +U(DL(X),DR(Y),Z)+U(DL(X),DL(Y),Z)&
                    +U(DR(X),Y,DS(Z))+U(DR(X),Y,DX(Z))&
                     +U(DL(X),Y,DS(Z))+U(DL(X),Y,DX(Z))&
                        +U(X,DR(Y),DS(Z))+U(X,DR(Y),DX(Z))&
                    +U(X,DL(Y),DS(Z))+U(X,DL(Y),DX(Z)))&
                   +(U(DR(X),DR(Y),DS(Z))+U(DR(X),DR(Y),DX(Z))&
                +U(DL(X),DL(Y),DX(Z))+U(DL(X),DL(Y),DS(Z))&
                +U(DR(X),DL(Y),DS(Z))+U(DL(X),DR(Y),DS(Z))&
         +U(DL(X),DR(Y),DX(Z))+U(DR(X),DL(Y),DX(Z))))/80&
                    -A*(U(X,Y,Z)-1+2*F)   

                               
                               
                     
                         
          
          100 CONTINUE
                 
                 
                   T=T+DELT
  
               
         
          
                 
                  

       
       
   IF(T.EQ.50) THEN
          OPEN(1,FILE='X1.DAT')
          DO 130 X=1,N1
          DO 130 Y=1,N1
      DO 130 Z=1,N2
  IF(U(X,Y,Z).GT.0.05) THEN
                  WRITE(1,*) X,Y,Z
                  END IF
        130  CONTINUE          
                 CLOSE(1)
         write (*,*) 'T=', T
                  
  END IF

  IF(T.EQ.100) THEN
          OPEN(2,FILE='X2.DAT')
          DO 140 X=1,N1
          DO 140 Y=1,N1
          DO 140 Z=1,N2

                 IF(U(X,Y,Z).GT.0.05) THEN
                 WRITE(2,*) X,Y,Z
                 END IF
    140  CONTINUE
                 CLOSE(2)
                 write (*,*) 'T=', T

        END IF

        IF(T.EQ.500) THEN
          OPEN(3,FILE='X3.DAT')
           DO 150 X=1,N1
           DO 150 Y=1,N1
           DO 150 Z=1,N2

                  IF (U(X,Y,Z).GT.0.05) THEN
                  WRITE(3,*) X,Y,Z
                  END IF
         150 CONTINUE
                    CLOSE(3)
      write (*,*) 'T=', T         

         
  END IF
       
        IF(T.EQ.1000) THEN
         OPEN(4,FILE='X4.DAT')
                 DO 160 X=1,N1
                 DO 160 Y=1,N1
                 DO 160 Z=1,N2

                 IF(U(X,Y,Z).GT.0.05) THEN
                 WRITE(4,*) X,Y,Z
                 END IF
   160 CONTINUE
           CLOSE(4)
       write (*,*) 'T=', T
  
   END IF
       
        IF(T.EQ.2000) THEN
         OPEN(5,FILE='X5.DAT')
                 DO 170 X=1,N1
                 DO 170 Y=1,N1
                 DO 170 Z=1,N2

                 IF(U(X,Y,Z).GT.0.05) THEN
                 WRITE(5,*) X,Y,Z
                 END IF
   170 CONTINUE
           CLOSE(5)
       write (*,*) 'T=', T
   
    END IF
       
        IF(T.EQ.5000) THEN
         OPEN(6,FILE='X6.DAT')
                 DO 180 X=1,N1
                 DO 180 Y=1,N1
                 DO 180 Z=1,N2

                 IF(U(X,Y,Z).GT.0.05) THEN
                 WRITE(6,*) X,Y,Z
                 END IF
   180 CONTINUE
           CLOSE(6)
       write (*,*) 'T=', T
   
    END IF
       
        IF(T.EQ.10000) THEN
         OPEN(7,FILE='X7.DAT')
                 DO 190 X=1,N1
                 DO 190 Y=1,N1
                 DO 190 Z=1,N2

                 IF(U(X,Y,Z).GT.0.05) THEN
                 WRITE(7,*) X,Y,Z
                 END IF
   190 CONTINUE
           CLOSE(7)
       write (*,*) 'T=', T

   END IF
       
                   IF(T.EQ.20000) THEN
         OPEN(8,FILE='X8.DAT')
                 DO 200 X=1,N1
                 DO 200 Y=1,N1
                 DO 200 Z=1,N2

                 IF(U(X,Y,Z).GT.0.05) THEN
                 WRITE(8,*) X,Y,Z
                 END IF
   200 CONTINUE
           CLOSE(8)
       write (*,*) 'T=', T

   END IF

IF(T.GT.20000)THEN
             
          STOP

  END IF

     GOTO 35
          
   END

!        RANDOM NUMBER
          
   FUNCTION ran2(idum)
      INTEGER idum,IM1,IM2,IMM1,IA1,IA2,IQ1,IQ2,IR1,IR2,NTAB,NDIV
      REAL ran2,AM,EPS,RNMX
      PARAMETER (IM1=2147483563,IM2=2147483399,AM=1./IM1,IMM1=IM1-1,&
                IA1=40014,IA2=40692,IQ1=53668,IQ2=52774,IR1=12211,IR2=3791,&
                NTAB=32,NDIV=1+IMM1/NTAB,EPS=1.2e-7,RNMX=1.-EPS)
      INTEGER idum2,j,k,iv(NTAB),iy
      SAVE iv,iy,idum2
      DATA idum2/123456789/, iv/NTAB*0/, iy/0/
      if (idum.le.0) then
        idum=max(-idum,1)
        idum2=idum
        do 11 j=NTAB+8,1,-1

          k=idum/IQ1
          idum=IA1*(idum-k*IQ1)-k*IR1
          if (idum.lt.0) idum=idum+IM1
          if (j.le.NTAB) iv(j)=idum
11      continue
        iy=iv(1)
      endif
      k=idum/IQ1
      idum=IA1*(idum-k*IQ1)-k*IR1
      if (idum.lt.0) idum=idum+IM1
      k=idum2/IQ2
      idum2=IA2*(idum2-k*IQ2)-k*IR2
      if (idum2.lt.0) idum2=idum2+IM2
      j=1+iy/NDIV
      iy=iv(j)-idum2
      iv(j)=idum
      if(iy.lt.1)iy=iy+IMM1
      ran2=min(AM*iy,RNMX)
      return
      END
回复此楼

» 猜你喜欢
人生旅途，可以休息，但别忘记奔跑
1楼 2008-09-19 08:47:09
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

sandycug

金虫 (小有名气)
★
lei0736(金币+1,VIP+0):谢谢
帮什么忙？

不过你这个程序数组溢出了
赞一下(10人) 回复此楼
2楼2008-09-19 14:27:11
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

panjunxing

木虫 (著名写手)

小学生
这个程序没有办法运行，我想是不是程序中加粗的部分在位置上或者别的什么地方出错了，数组溢出的问题我又该怎么解决？
赞一下 回复此楼
人生旅途，可以休息，但别忘记奔跑
3楼2008-09-22 09:22:06
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

grant.tgb

木虫 (小有名气)

数组定义有问题

★ ★ ★
灯塔守望者(金币+3,VIP+0):谢谢支持小木虫
问题出在这里：
  INTEGER DR(40),DL(40),DS(15),DX(15)
   REAL   U(40,40,15), IU(40,40,15)

而下面有:
  DX(0)=1
  DS(N2+1)=N2
  ......
类似这两种不对应的情况造成了"数组溢出"（其实是你用了超出定义范围的数组）。

解决办法：
1.对于DX(0)，可在前面定义时采用 类似DX(0:15)形式（下面的一样 U(0:40,0:40,0:15), IU(0:40,0:40,0:15)）
2.对于N2+1＝16>15这样的情况，就更加简单了。
3.按这个思路继续检查...
赞一下(10人) 回复此楼
4楼2008-10-08 08:47:26
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

grant.tgb

木虫 (小有名气)

程序很烂

★
lei0736(金币+1,VIP+0):谢谢
再往下，还有很多问题啊。

                    U(X,Y,1-1)=U(X,Y,1)
                    U(X,Y,N2+1)=U(X,Y,N2)
                        IU(X,Y,1-1)=IU(X,Y,1)
                    IU(X,Y,N2+1)=IU(X,Y,N2)   

这里面的X和Y用的古怪，似乎是应该有个两层的循环赋值才对。
这也是“溢出”的原因之一。
赞一下(10人) 回复此楼
5楼2008-10-08 09:01:05
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

grant.tgb

木虫 (小有名气)

至少能运行了

★
sunxiao(金币+1):谢谢参与，迟到的奖励，呵呵 1-22 03:50
!   !  the pattern in presence partical
  
  
    INTEGER  DELT
    INTEGER  idum               
    INTEGER  T  
    REAL    ran2        
    REAL    G,D,A,F
               
   INTEGER DR(0:40),DL(0:40),DS(0:16),DX(0:16)
   REAL   U(0:40,0:40,0:16), IU(0:40,0:40,0:16)
         
        


!  PROGRAM ONE

    DATA  DELT, D, G, N1, N2,A, F,HA,WA               /1,0.5,1.2,40,15,0.02,0.4,0.2,0.4/
                                                
               
   T=0
               
   IDUM=-1
          DO 20 ii=1,N1
          DO 20 jj=1,N1
          DO 20 kk=1,N2
                U(ii,jj,kk)=0.02*(ran2(idum)-0.5)+0.0
               
     20 CONTINUE
   

!   BOUNDARY CONDITION
         
25       DO 30 ii=1,N1
          DO 30 jj=1,N1
          DO 30 kk=1,N2
                    
            DL(ii)=ii-1
            DR(ii)=ii+1
            DL(jj)=jj-1
            DR(jj)=jj+1
            DS(kk)=kk+1
            DX(kk)=kk-1

    30 CONTINUE
do ii=1,N1
do jj=1,N1        
   DL(1)=N1   
   DR(N1)=1
               
   DX(0)=1
   DS(N2+1)=N2
   U(ii,jj,1-1)=U(ii,jj,1)         
   U(ii,jj,N2+1)=U(ii,jj,N2)   
   IU(ii,jj,1-1)=IU(ii,jj,1)
   IU(ii,jj,N2+1)=IU(ii,jj,N2)                       
end do
end do
         
!   MAIN PROGRAM

        
   

  35 DO 80  ii=1,N1
      DO 80  jj=1,N1
      DO 80  kk=1,N2
         
! pause
                        
  IU(ii,jj,kk)=D*((6*(U(DR(ii),jj,kk)+U(DL(ii),jj,kk) +U(ii,DR(jj),kk)+U(ii,DL(jj),kk)   +U(ii,jj,DS(kk))+U(ii,jj,DX(kk)))           +3*(U(DR(ii),DR(jj),kk)+U(DR(ii),DL(jj),kk)                +U(DL(ii),DR(jj),kk)+U(DL(ii),DL(jj),kk)                +U(DR(ii),jj,DS(kk))+U(DR(ii),jj,DX(kk))        +U(DL(ii),jj,DS(kk))+U(DL(ii),jj,DX(kk))         +U(ii,DR(jj),DS(kk))+U(ii,DR(jj),DX(kk))        +U(ii,DL(jj),DS(kk))+U(ii,DL(jj),DX(kk)))         +(U(DR(ii),DR(jj),DS(kk))+U(DR(ii),DR(jj),DX(kk))         +U(DL(ii),DL(jj),DX(kk))+U(DL(ii),DL(jj),DS(kk))        +U(DR(ii),DL(jj),DS(kk))+U(DL(ii),DR(jj),DS(kk))        +U(DL(ii),DR(jj),DX(kk))+U(DR(ii),DL(jj),DX(kk))))/80                -U(ii,jj,kk))+G*TANH(U(ii,jj,kk))-S*ALOG(G)
                                
80 CONTINUE
         


      DO 85 kk=1,N2
                   S=HA*WA*DE
                    IF(kk==1)THEN
                       DE=1
         ELSEIF(kk>1.AND.kk                        DE=0
         ELSEIF(kk==N2)THEN
                       DE=1


             END IF
           85  CONTINUE   


           
           
           90  DO 100 ii=1,N1
                 DO 100 jj=1,N1
                   DO 100 kk=1,N2
           U(ii,jj,kk)=IU(ii,jj,kk)                    -(6*(IU(DR(ii),jj,kk)+IU(DL(ii),jj,kk)                        +IU(ii,DR(jj),kk)+IU(ii,DL(jj),kk)                            +IU(ii,jj,DS(kk))+IU(ii,jj,DX(kk)))                +3*(IU(DR(ii),DR(jj),kk)+IU(DR(ii),DL(jj),kk)                   +IU(DL(ii),DR(jj),kk)+IU(DL(ii),DL(jj),kk)                      +IU(DR(ii),jj,DS(kk))+IU(DR(ii),jj,DX(kk))                   +IU(DL(ii),jj,DS(kk))+IU(DL(ii),jj,DX(kk))                   +IU(ii,DR(jj),DS(kk))+IU(ii,DR(jj),DX(kk))                   +IU(ii,DL(jj),DS(kk))+IU(ii,DL(jj),DX(kk)))                  +(IU(DR(ii),DR(jj),DS(kk))+IU(DR(ii),DR(jj),DX(kk))                   +IU(DL(ii),DL(jj),DX(kk))+IU(DL(ii),DL(jj),DS(kk))                   +IU(DR(ii),DL(jj),DS(kk))+IU(DL(ii),DR(jj),DS(kk))                   +IU(DL(ii),DR(jj),DX(kk))+IU(DR(ii),DL(jj),DX(kk))))/80        +(6*(U(DR(ii),jj,kk)+U(DL(ii),jj,kk)                    +U(ii,DR(jj),kk)+U(ii,DL(jj),kk)                    +U(ii,jj,DS(kk))+U(ii,jj,DX(kk)))                 +3*(U(DR(ii),DR(jj),kk)+U(DR(ii),DL(jj),kk)                    +U(DL(ii),DR(jj),kk)+U(DL(ii),DL(jj),kk)                    +U(DR(ii),jj,DS(kk))+U(DR(ii),jj,DX(kk))                     +U(DL(ii),jj,DS(kk))+U(DL(ii),jj,DX(kk))                        +U(ii,DR(jj),DS(kk))+U(ii,DR(jj),DX(kk))                    +U(ii,DL(jj),DS(kk))+U(ii,DL(jj),DX(kk)))                   +(U(DR(ii),DR(jj),DS(kk))+U(DR(ii),DR(jj),DX(kk))                +U(DL(ii),DL(jj),DX(kk))+U(DL(ii),DL(jj),DS(kk))                +U(DR(ii),DL(jj),DS(kk))+U(DL(ii),DR(jj),DS(kk))         +U(DL(ii),DR(jj),DX(kk))+U(DR(ii),DL(jj),DX(kk))))/80                    -A*(U(ii,jj,kk)-1+2*F)   

                                
                                
                     
                          
         
          100 CONTINUE
                 
                  
                   T=T+DELT
  
               
         
           
                 
                  

        
        
   IF(T.EQ.50) THEN
          OPEN(1,FILE='X1.DAT')
          DO 130 ii=1,N1
          DO 130 jj=1,N1
      DO 130 kk=1,N2
  IF(U(ii,jj,kk).GT.0.05) THEN
                  WRITE(1,*) ii,jj,kk
                  END IF
        130  CONTINUE           
                 CLOSE(1)
         write (*,*) 'T=', T
                  
  END IF

  IF(T.EQ.100) THEN
          OPEN(2,FILE='X2.DAT')
          DO 140 ii=1,N1
          DO 140 jj=1,N1
          DO 140 kk=1,N2

                 IF(U(ii,jj,kk).GT.0.05) THEN
                 WRITE(2,*) ii,jj,kk
                 END IF
    140  CONTINUE
                 CLOSE(2)
                 write (*,*) 'T=', T

        END IF

        IF(T.EQ.500) THEN
          OPEN(3,FILE='X3.DAT')
           DO 150 ii=1,N1
           DO 150 jj=1,N1
           DO 150 kk=1,N2

                  IF (U(ii,jj,kk).GT.0.05) THEN
                  WRITE(3,*) ii,jj,kk
                  END IF
         150 CONTINUE
                    CLOSE(3)
      write (*,*) 'T=', T         

         
  END IF
        
        IF(T.EQ.1000) THEN
         OPEN(4,FILE='X4.DAT')
                 DO 160 ii=1,N1
                 DO 160 jj=1,N1
                 DO 160 kk=1,N2

                 IF(U(ii,jj,kk).GT.0.05) THEN
                 WRITE(4,*) ii,jj,kk
                 END IF
   160 CONTINUE
           CLOSE(4)
       write (*,*) 'T=', T
  
   END IF
        
        IF(T.EQ.2000) THEN
         OPEN(5,FILE='X5.DAT')
                 DO 170 ii=1,N1
                 DO 170 jj=1,N1
                 DO 170 kk=1,N2

                 IF(U(ii,jj,kk).GT.0.05) THEN
                 WRITE(5,*) ii,jj,kk
                 END IF
   170 CONTINUE
           CLOSE(5)
       write (*,*) 'T=', T
   
    END IF
        
        IF(T.EQ.5000) THEN
         OPEN(6,FILE='X6.DAT')
                 DO 180 ii=1,N1
                 DO 180 jj=1,N1
                 DO 180 kk=1,N2

                 IF(U(ii,jj,kk).GT.0.05) THEN
                 WRITE(6,*) ii,jj,kk
                 END IF
   180 CONTINUE
           CLOSE(6)
       write (*,*) 'T=', T
   
    END IF
        
        IF(T.EQ.10000) THEN
         OPEN(7,FILE='X7.DAT')
                 DO 190 ii=1,N1
                 DO 190 jj=1,N1
                 DO 190 kk=1,N2

                 IF(U(ii,jj,kk).GT.0.05) THEN
                 WRITE(7,*) ii,jj,kk
                 END IF
   190 CONTINUE
           CLOSE(7)
       write (*,*) 'T=', T

   END IF
        
                   IF(T.EQ.20000) THEN
         OPEN(8,FILE='X8.DAT')
                 DO 200 ii=1,N1
                 DO 200 jj=1,N1
                 DO 200 kk=1,N2

                 IF(U(ii,jj,kk).GT.0.05) THEN
                 WRITE(8,*) ii,jj,kk
                 END IF
   200 CONTINUE
           CLOSE(8)
       write (*,*) 'T=', T

   END IF

IF(T.GT.20000)THEN
            
          STOP

  END IF

     GOTO 35
         
   END

!        RANDOM NUMBER
         
   FUNCTION ran2(idum)
      INTEGER idum,IM1,IM2,IMM1,IA1,IA2,IQ1,IQ2,IR1,IR2,NTAB,NDIV
      REAL ran2,AM,EPS,RNMX
      PARAMETER (IM1=2147483563,IM2=2147483399,AM=1./IM1,IMM1=IM1-1,                IA1=40014,IA2=40692,IQ1=53668,IQ2=52774,IR1=12211,IR2=3791,                 NTAB=32,NDIV=1+IMM1/NTAB,EPS=1.2e-7,RNMX=1.-EPS)
      INTEGER idum2,j,k,iv(NTAB),iy
      SAVE iv,iy,idum2
      DATA idum2/123456789/, iv/NTAB*0/, iy/0/
      if (idum.le.0) then
        idum=max(-idum,1)
        idum2=idum
        do 11 j=NTAB+8,1,-1

          k=idum/IQ1
          idum=IA1*(idum-k*IQ1)-k*IR1
          if (idum.lt.0) idum=idum+IM1
          if (j.le.NTAB) iv(j)=idum
11      continue
        iy=iv(1)
      endif
      k=idum/IQ1
      idum=IA1*(idum-k*IQ1)-k*IR1
      if (idum.lt.0) idum=idum+IM1
      k=idum2/IQ2
      idum2=IA2*(idum2-k*IQ2)-k*IR2
      if (idum2.lt.0) idum2=idum2+IM2
      j=1+iy/NDIV
      iy=iv(j)-idum2
      iv(j)=idum
      if(iy.lt.1)iy=iy+IMM1
      ran2=min(AM*iy,RNMX)
      return
      END
赞一下(6人) 回复此楼
6楼2008-10-08 09:11:17
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

grant.tgb

木虫 (小有名气)

看不惯用X，Y，Z做整型

★ ★
spur(金币+2,VIP+0):3Q!欢迎常来！
而且楼主也没定义其为整型！

把X，Y，Z都改为ii,jj,kk了，其他基本没动。

输出结果T=50,T=100,...,T=20000以后程序就停了，不知要算啥。

哈哈

[ Last edited by grant.tgb on 2008-10-9 at 07:49 ]
赞一下(10人) 回复此楼
7楼2008-10-08 09:14:53
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

Gvtheen

金虫 (小有名气)
上楼说得对！！
回复此楼
8楼2008-10-08 10:18:21
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

anxt2006

木虫 (正式写手)

fortran里如何产生从0到1的加权的随机数

高手们，请教一个问题：fortran里如何产生从0到1的加权的随机数吗？我想用蒙特卡罗积分，但是我的被积函数有尖峰，所以想找一个加权的随机数产生程序，在尖峰的地方多取一些点，在其他地方少取一些点。 忘高手指点。
赞一下 回复此楼
9楼2008-10-10 18:41:09
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

panjunxing

木虫 (著名写手)

小学生
太感谢大家了！高手！
赞一下 回复此楼
人生旅途，可以休息，但别忘记奔跑
10楼2008-10-20 18:42:14
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 panjunxing 的主题更新
121/2返回列表12下一页
普通表情 龙 兔 虎 猫 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 英一数二生物信息学287分，本科生物科学，求调剂 +4 碧水xyz 2026-03-29 5/250 2026-04-04 15:04 by liuhaixu
[考研] 329求调剂 +11 miaodesi 2026-04-02 13/650 2026-04-04 12:20 by 无际的草原
[考研] 材料调剂 +10 一样YWY 2026-04-03 10/500 2026-04-04 12:18 by 无际的草原
[考研] 求生物学调剂 +12 15172915737 2026-04-01 12/600 2026-04-04 10:55 by 求调剂zz
[考研] 材料专业383求调剂 +8 郭阳阳阳成 2026-04-03 8/400 2026-04-04 10:29 by Rednal.
[考研] 调剂0855-288 +5 x熊二a 2026-04-03 5/250 2026-04-04 00:19 by 猪会飞
[考研] 考研调剂 +3 15615482637 2026-04-03 3/150 2026-04-03 22:50 by ms629
[考研] 工科求调剂 +10 11ggg 2026-04-03 10/500 2026-04-03 22:35 by syjjj0321
[考研] 353求调剂 +5 MayUxw1 2026-04-03 5/250 2026-04-03 21:17 by 啵啵啵0119
[考研] 0856，269分求调剂 +15 有学上就行求求� 2026-03-30 18/900 2026-04-03 16:50 by melodiousnow
[考研] 285求调剂 +6 FZAC123 2026-03-30 6/300 2026-04-03 12:22 by xingguangj
[考研] 085600，320分求调剂 +6 大馋小子 2026-04-02 6/300 2026-04-02 21:54 by dongzh2009
[考研] 290求调剂085701 +3 1314捧花 2026-04-02 3/150 2026-04-02 13:34 by Ecowxq666！
[考研] 求调剂推荐 +3 南山南@ 2026-04-01 3/150 2026-04-02 12:09 by xiaoranmu
[考研] 一志愿9初试366 本双非求调剂 +4 运气来得若有似� 2026-04-02 4/200 2026-04-02 09:56 by guanxin1001
[考研] 安全工程 285 求调剂 +3 Xinyu56 2026-04-01 4/200 2026-04-01 21:50 by 静静静静静静静�
[考研] 262求调剂 +9 励志一定发文章 2026-03-31 10/500 2026-04-01 12:22 by sunshine0013
[考研] 一志愿北京科技大学085601材料工程英一数二初试总分335求调剂 +5 双马尾痞老板2 2026-03-31 5/250 2026-04-01 09:04 by oooqiao
[考研] 本科211生物医学工程085409求调剂339分 +7 里子木yy 2026-03-29 7/350 2026-03-31 14:35 by fmesaito
[考研] 0703 化学 求调剂，一志愿山东大学 342 分 +7 Shern—- 2026-03-28 7/350 2026-03-30 16:31 by nothing投稿中
信息提示
关闭
请填处理意见
关闭