24小时热门版块排行榜

返回列表

当前主题已经存档。

当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

阳光不锈7717

应助: (幼儿园)
在线:
虫号: 771680

[交流] 【求助】一个计算库伦相互作用能的fortran程序的并行化(2)

c-------------------------------------------------
c    end if

c    if(myid==2)then

c*** calculate the energy of bond bond interaction
c----------------------------------------------

   do in=natom+1,natombond
      xic = x(in)
      yic = y(in)
      zic = z(in)
      xi = x(in) - xic
      yi = y(in) - yic
      zi = z(in) - zic
   c2scale= 0.0d0
      c4scale= 0.57d0
      c3scale=0.0d0
      do j = natom+1, na
         cscale(j) = 0.57d0
      end do
      do j = 1, nbond12(in)
         cscale(bond12(j,in)) = c2scale
      end do
      do j = 1, nbdatom12(in)
         cscale(bdatom12(j,in)) = c2scale
if(atomlp(1,bdatom12(j,in)).ne.0)then
      cscale(atomlp(1,bdatom12(j,in)))
   &=c2scale
      endif
   if(atomlp(2,bdatom12(j,in)).ne.0) then
      cscale(atomlp(2,bdatom12(j,in)))
   &=c2scale
   endif
if(atompie(1,bdatom12(j,in)).ne.0)
   &  cscale(atompie(1,bdatom12(j,in)))=c2scale
   if(atompie(2,bdatom12(j,in)).ne.0)
   &  cscale(atompie(2,bdatom12(j,in)))=c2scale
      end do
      do j = 1, nbdatom13(in)
         cscale(bdatom13(j,in)) = c3scale
if(atomlp(1,bdatom13(j,in)).ne.0) then
      cscale(atomlp(1,bdatom13(j,in)))
   &=c3scale
      endif
   if(atomlp(2,bdatom13(j,in)).ne.0)then
      cscale(atomlp(2,bdatom13(j,in)))
   &=c3scale
   endif
if(atompie(1,bdatom13(j,in)).ne.0)
   &  cscale(atompie(1,bdatom13(j,in)))=c3scale
   if(atompie(2,bdatom13(j,in)).ne.0)
   &  cscale(atompie(2,bdatom13(j,in)))=c3scale
      end do
      do j = 1, nbond13(in)
         cscale(bond13(j,in)) = c3scale
      end do
      fi = f * pchg(in)

         do kk = in+1, naTOMBOND+NLP
            xc = xic - x(kk)
            yc = yic - y(kk)
            zc = zic - z(kk)
            if (use_image)  call image (xc,yc,zc,0)
            rc2 = xc*xc + yc*yc + zc*zc
               xr = xc + xi - x(kk) + x(kk)
               yr = yc + yi - y(kk) + y(kk)
               zr = zc + zi - z(kk) + z(kk)
               r2 = xr*xr + yr*yr + zr*zr
               r = sqrt(r2)
               fik = fi * pchg(kk) * cscale(kk)
c WRITE(*,*) AM(IN),AM(KK),CSCALE(KK),R

if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               fik =  fik*lamp2
endif
               e = fik / r
   if(kk.le.natombond)then
      if (molcule(bdatom12(1,in)) .ne. molcule(bdatom12(1,kk))) then
               einter = einter + e
      end if
   else
      if (molcule(bdatom12(1,in)) .ne. molcule(lpatom(kk))) then
               einter = einter + e
      end if
   endif
if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               eintero = eintero + e
      end if
if ((molcule(in).eq.obj.and.molcule(kk).eq.obj))then
               eintrao = eintrao + e
      end if
   if(abs(e).gt.800)then
   write(*,*) ii,kk,molcule(II),molcule(kk)
   endif
c       write(11,*) 'bond-bond',e
c-------------------------------------
      end do

         do kk = NATOMBOND+NLP+1, na
            xc = xic - x(kk)
            yc = yic - y(kk)
            zc = zic - z(kk)
            if (use_image)  call image (xc,yc,zc,0)
            rc2 = xc*xc + yc*yc + zc*zc
               xr = xc + xi - x(kk) + x(kk)
               yr = yc + yi - y(kk) + y(kk)
               zr = zc + zi - z(kk) + z(kk)
               r2 = xr*xr + yr*yr + zr*zr
               r = sqrt(r2)
               fik = fi * pchg(kk) * cscale(kk)
if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               fik =  fik*lamp2
endif
               e = fik / r

      if (molcule(bdatom12(1,in)) .ne. molcule(PIEatom(kk))) then
               einter = einter + e
   endif
if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               eintero = eintero + e
      end if
if ((molcule(in).eq.obj.and.molcule(kk).eq.obj))then
               eintrao = eintrao + e
      end if
   if(abs(e).gt.800)then
   write(*,*) ii,kk,molcule(II),molcule(kk)
   endif
c       write(11,*) 'b-lp,pi',e
               ec1 = ec1 + e
      end do

   end do
c-----------------------------------------------------
   end if
   if(myid==3)then
c------------------------------------------------------

c       write(12,*) 'bond',ec1
c*** calculate the energy of lp lpPIE interaction

   do in=natombond+1,natombond+nlp
      xic = x(in)
      yic = y(in)
      zic = z(in)
      xi = x(in) - xic
      yi = y(in) - yic
      zi = z(in) - zic
   c2scale= 0.0d0
      c4scale= 0.57d0
      c3scale=0.0d0
      do j = natomBOND+1, na
         cscale(j) = 0.57d0
      end do
      pi=lpatom(in)
   do j=1,2
   if(atomlp(j,pi).ne.in.AND.NATOMLP(PI).NE.1)
   &cscale(atomlp(j,pi))=0.0d0
enddo
   DO J=1,NATOMPIE(PI)
   CSCALE(ATOMPIE(J,PI))=0.0D0
      ENDDO

      do j=1,n12(pi)
DO K=1,NATOMLP(I12(J,PI))
cscale(atomlp(K,i12(j,pi)))=c2scale
ENDDO
DO K=1,NATOMPIE(I12(J,PI))
cscale(atompie(K,i12(j,pi)))=c2scale
ENDDO
   enddo

      do j=1,n13(pi)
DO K=1,NATOMLP(I13(J,PI))
cscale(atomlp(K,i13(j,pi)))=c3scale
   ENDDO
DO K=1,NATOMPIE(I13(J,PI))
cscale(atompie(K,i13(j,pi)))=c3scale
ENDDO
   enddo

      fi = f * pchg(in)
         do kk = in+1, naTOMBOND+NLP
            xc = xic - x(kk)
            yc = yic - y(kk)
            zc = zic - z(kk)
            if (use_image)  call image (xc,yc,zc,0)
            rc2 = xc*xc + yc*yc + zc*zc
               xr = xc + xi - x(kk) + x(kk)
               yr = yc + yi - y(kk) + y(kk)
               zr = zc + zi - z(kk) + z(kk)
               r2 = xr*xr + yr*yr + zr*zr
               r = sqrt(r2)
               fik = fi * pchg(kk) * cscale(kk)
if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               fik =  fik*lamp2
endif
               e = fik / r
      if (molcule(lpatom(in)) .ne. molcule(lpatom(kk))) then
               einter = einter + e
      end if
if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               eintero = eintero + e
      end if
if ((molcule(in).eq.obj.and.molcule(kk).eq.obj))then
               eintrao = eintrao + e
      end if
   if(abs(e).gt.800)then
   write(*,*) ii,kk,molcule(II),molcule(kk)
   endif
c    write(11,*) 'lp-lp',e
               ec1 = ec1 + e
      end do

         do kk = naTOMBOND+NLP+1,NA
            xc = xic - x(kk)
            yc = yic - y(kk)
            zc = zic - z(kk)
            if (use_image)  call image (xc,yc,zc,0)
            rc2 = xc*xc + yc*yc + zc*zc
               xr = xc + xi - x(kk) + x(kk)
               yr = yc + yi - y(kk) + y(kk)
               zr = zc + zi - z(kk) + z(kk)
               r2 = xr*xr + yr*yr + zr*zr
               r = sqrt(r2)
               fik = fi * pchg(kk) * cscale(kk)

if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               fik =  fik*lamp2
endif
               e = fik / r
      if (molcule(lpatom(in)) .ne. molcule(PIEatom(kk))) then
               einter = einter + e
      end if
if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               eintero = eintero + e
      end if
if ((molcule(in).eq.obj.and.molcule(kk).eq.obj))then
               eintrao = eintrao + e
      end if
   if(abs(e).gt.800)then
   write(*,*) ii,kk,molcule(II),molcule(kk)
   endif
c    write(11,*) 'lp-pie',e
               ec1 = ec1 + e
      end do

   end do
c--------------------------------------------------------
c       end if
c       if(myid==4)then
c--------------------------------------------------------

c       write(12,*) 'lp',ec1
   do in=natombond+nlp+1,na-1
      xic = x(in)
      yic = y(in)
      zic = z(in)
      xi = x(in) - xic
      yi = y(in) - yic
      zi = z(in) - zic
   c2scale= 0.0d0
      c4scale= 0.57d0
      c3scale=0.0d0
      do j = natom+1, na
         cscale(j) = 0.57d0
      end do
      pi=pieatom(in)
do j=1,2
   if(atompie(j,pi).ne.iN)cscale(atompie(j,pi))=0.0d0
enddo
      do j=1,n12(pi)
DO K=1,NATOMPIE(I12(J,PI))
cscale(atompie(K,i12(j,pi)))=c2scale
   ENDDO
   enddo
      do j=1,n13(pi)
DO K=1,NATOMPIE(I13(J,PI))
cscale(atompie(K,i13(j,pi)))=c3scale
   ENDDO
   enddo
      fi = f * pchg(in)
         do kk = in+1, na
            xc = xic - x(kk)
            yc = yic - y(kk)
            zc = zic - z(kk)
            if (use_image)  call image (xc,yc,zc,0)
            rc2 = xc*xc + yc*yc + zc*zc
               xr = xc + xi - x(kk) + x(kk)
               yr = yc + yi - y(kk) + y(kk)
               zr = zc + zi - z(kk) + z(kk)
               r2 = xr*xr + yr*yr + zr*zr
               r = sqrt(r2)
               fik = fi * pchg(kk) * cscale(kk)

if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               fik =  fik*lamp2
endif
               e = fik / r
      if (molcule(PIEatom(in)) .ne. molcule(PIEatom(kk))) then
               einter = einter + e
      end if
if ((molcule(in).eq.obj.and.molcule(kk).ne.obj).or.
   &(molcule(in).ne.obj.and.molcule(kk).eq.obj))then
               eintero = eintero + e
      end if
if ((molcule(in).eq.obj.and.molcule(kk).eq.obj))then
               eintrao = eintrao + e
      end if
   if(abs(e).gt.800)then
   write(*,*) ii,kk,molcule(II),molcule(kk)
   endif
c             write(11,*) 'pie-pie',e
               ec1 = ec1 + e
      end do
   end do
c       write(12,*) 'pie',ec1
c----------------------------------------
   endif
c 以下为计算力的程序不需要并行(由于字数要求已省略)
c---------------------------------------
   ecry=ecry+ec1
      if (.not. use_replica)  goto 111
c*****calculate the interaction with other cells with abeem charges explictly dielec

回复此楼