[交流] 【原创】MCM-41的孔径分布的计算已有4人参与

        integer hno
        parameter(hno=2356)

        character a(hno)*5,fx(hno)*4,fft(hno)*5,natom(hno)*1
        double precision xc(hno),yc(hno),zc(hno)
        integer occupation(hno)
        real charge(hno)


      open(10,file='H.car',status='old')
        do 20 i=1,hno
        read(10,*)a(i),xc(i),yc(i),zc(i),fx(i),occupation(i),fft(i),
     &          natom(i),charge(i)
20    continue
      close(10)

        jmm=0
      open(30,file='output.car',access='append')
*40        amm=RAN2(IDUM)
40        imm=int(RAN2(IDUM)*hno)
        if(charge(imm).lt.1.0)then
        jmm=jmm+1
        write(30,888)a(imm),xc(imm),yc(imm),zc(imm),fx(imm),
     &             occupation(imm),fft(imm),natom(imm),charge(imm)
        charge(imm)=2.0
        endif



        if(jmm.eq.50.or.jmm.eq.100.or.jmm.eq.150.or.jmm.eq.200.or.
     &          jmm.eq.250.or.jmm.eq.300.or.jmm.eq.350.or.jmm.eq.400)then
        write(30,*)'********************',jmm,'**************************'
        write(30,*)'********************',jmm,'**************************'
        endif

        if(jmm.lt.415)then
      goto 40
        else
        goto 50
        endif
50    close(30)

888   format(A5,3X,F12.9,2X,F13.9,3X,F12.9,1X,A4,1X,I1,6X,A5,3X,A1,F8.3)   
        end
       
      
      
*&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
*     Random Number Generator               
*&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

                          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

Originally posted by lanyaqian at 2011-06-11 00:14:44:
您好 经常看到你的帖子 在这个论坛里 我是做mof的  一直想知道怎么用monte carlo来模拟物理吸附  是不是很难学 我不是做理论的是做实验的  要是很难学 能和你合作吗 或者你知道 中国那个课题组做的比较好   非 ...

Originally posted by qphll at 2010-12-02 00:27:09:
赞一下.

自己动手, 其乐无穷.

Originally posted by zyj8119 at 2010-12-02 00:28:52:

多谢，这个输出的output.car文件在下一步还有用，程序明天给出。