[交流] 【原创】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 qphll at 2010-12-02 00:27:09:
赞一下.

自己动手, 其乐无穷.

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

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

Originally posted by zyj8119 at 2010-12-02 00:24:27:
接上一个帖子，MCM-41建好的模型会有孔径分布，这个在定义中式很复杂的，应该怎么计算呢，可以导出MCM-41中所有的H原子，然后自己写程序去计算孔径分布，我使用的是FORTRAN语言，导出的car结构中，可以使用EXCEL找 ...

          integer noh
         open(10,file='noh.txt',status='old')
         read(10,*)noh
         close(10)
         call distribution(noh)
         end

         subroutine distribution(noh)
         integer noh,nr
         real a(noh,2),step,min,max,rt,rp,b(-4:44,2)
         step=0.5
         min=0.0
         max=0.0
         rt=0.0
         rp=0.0
         nr=0.0
         open(20,file='input.txt',status='old')
         do 30 i=1,noh
         read(20,*)(a(i,j),j=1,2)
30     continue
        close(20)

        do 40 j=-4,44
        min=j*step-0.25
        max=j*step+0.25
               do 50 i=1,noh
        if(min.le.a(i,1).and.max.gt.a(i,1))then
        nr=nr+1
        rt=rt+a(i,2)
        end if
50    continue
       rp=rt/(1.0*nr)
       b(j,1)=nr
       b(j,2)=rp
       nr=0
       rt=0
       rp=0
40   continue
      open(60,file='output.txt',access='append')
     write(60,*)'*****************amount of H in the region**************'
       do 70 i=-4,44
       write(60,*)b(i,1)
70   continue
       write(60,*)'*****************average radius of the region***************'
       do 80 i=-4,44
       write(60,*)b(i,2)
80   continue
      end subroutine

*               main program
                real cx,cy
               integer HNO,lattice
               open(1000,file='parameter.txt',status='old')
               read(1000,*)cx
                     read(1000,*)cy
                     read(1000,*)HNO
               read(1000,*)lattic
               call statistic(cx,cy,HNO,lattic)
*              write(*,*)cx,cy,HNO
               end

               subroutine statistic(cx,cy,HNO,lattic)
               real cx,cy,cz,fc0,cx0,cy0,range,step
               integer HNO,cyc,lattic
               real p(HNO,11),r(lattic,lattic,HNO),rp(lattic,100)
               real d(HNO),rmin,rmax,fc(lattic,lattic)
               integer nb(0:99)
               range=10.0
              open(10,file='input.txt',status='old')
              do 10 i=1,HNO
              read(10,*)(p(i,j),j=1,11)
*            if(p(i,6).gt.29)then
*            p(i,6)=p(i,6)-57.975988
*            end if
*            if(p(i,7).gt.67)then
*            p(i,7)=p(i,7)-133.758958
*            end if
100       continue
            close(10)
***************print the coordinate***********************
            open(1000,file='output.txt',access='append')
            write(1000,*)'**********x coordinate*****************
            do 1001 i=1,HNO
              write(1000,*)p(i,6)
1001     continue
            write(1000,*)'**********y coordinate*****************
               do 1002 i=1,HNO
              write(1000,*)p(i,7)
1002     continue
             write(1000,*)'**********y coordinate*****************
               do 1003 i=1,HNO
              write(1000,*)p(i,8)
1003     continue
            close(1000)
********************************************************
             do 220 cyc=1,10
             fc0=1.0e20
             cx0=cx
             cy0=cy
             step=range*2.0/(1.0*lattic)
             do 101 i=1,lattic
                do 102 j=1,lattic
              rp(i,j)=0.0
              fc(i,j)=0.0
102        continue
101        continue

             do 110 i=1,lattic
               do 120 j=1,lattic
                 do 130 k=1,HNO
                  cx=cx0-range+step*i
                  cy=cy0-range+step*j
                  r(i,j,k)=sqrt((p(k,6)-cx)**2+(p(k,6)-cy)**2)
                  rp(i,j)=rp(i,j)+r(i,j,k)/(HNO*1.0)
130            continue
120           continue
110         continue

              do 140 i=1,lattic
               do 150 j=1,lattic
                 do 160 k=1,HNO
                fc(i,j)=fc(i,j)+(r(i,j,k)-rp(i,j))**2
160           continue
               fc(i,j)=sqrt(fc(i,j)/1.0*(HNO-1)))
               if(fc(i,j).lt.fc0)then
               fc0=fc(i,j)
               cx=cx0-range+step*i
               cy=cy0-range+step*j
               end if
150         continue
140         continue
              range=range/2.0
220        continue
            
              do 170 i=1,HNO
                d(i)=sqrt((p(i,6)-cx)**2+(p(i,7)-cy)**2)
170         continue

              open(20,file='output.txt',access='append')
              write(20,*)'the center of pore'
              write(20,*)'x=',cx,'y=',cy
              write(20,*)'fangcha=',fc0
              write(20,*)'****************************'
              write(20,*)'distance between Hydrogen atom and the center of pore'
              do 180 i=1,HNO
              write(20,*)d(i)
180        continue
              close(20)
              do 185 i=0,99
              nb(i)=0
185        continue
     
             do 190 i=0,99
             rmin=10.0+0.1*i
             rmax=10.0+0.1*(i+1)
                 do 200 j=1,HNO
                   if(rmin.lt.d(j).and.rmax.ge.d(j))then
                  nb(i)=nb(i)+1
200          continue
190          continue

             open(30,file='output.txt',access='append')
             write(30,*)'****************nb*****************'
             write(30,*)'distribution of pore radius'
             do 210 i=0,99
             rr=10.1+0.1*i
             write(30,*)nb(i)
*           write(30,*)nb(i)
210        continue
             close(30)
             end
           

   

Originally posted by zyj8119 at 2010-12-02 10:01:19:
统计完成以后，接下来就是计算孔径分布了，源程序是这样的：

[code]
*               main program
                real cx,cy
               integer HNO,lattice
               open(1000,file='para ...

Originally posted by zyj8119 at 2010-12-02 10:01:19:
统计完成以后，接下来就是计算孔径分布了，源程序是这样的：

[code]
*               main program
                real cx,cy
               integer HNO,lattice
               open(1000,file='para ...

Originally posted by hsqlxsz at 2010-12-02 09:34:40:
眼前一片茫然，技术含量太高，仰视一下