版块导航: 正在加载中...

登录注册

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

24小时热门版块排行榜

北京石油化工学院2026年研究生招生接收调剂公告

返回列表

当前主题已经存档。

阳光不锈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

回复此楼

» 猜你喜欢

1楼 2009-05-18 16:35:01

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

czhui11

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

★
sunxiao(金币+1,VIP+0):谢谢参与，欢迎常来仿真编程版 5-19 02:14

你怎么发这么长啊,谁有那么长时间去看啊

赞一下(10人)

回复此楼

2楼2009-05-18 20:44:19

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

程序强帖: 16
应助: 157 (高中生)
贵宾: 0.02
金币: 18844.7
红花: 29
帖子: 3803
在线: 1422.4小时
虫号: 183750
注册: 2006-02-13
专业: 污染生态化学

★ ★
sunxiao(金币+2,VIP+0):谢谢参与，欢迎常来仿真编程版 5-19 02:14

不仅长，而且没有注释，再有，也不能编译执行，呵呵……

赞一下(10人)

回复此楼

3楼2009-05-18 22:48:40

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

mickk

铁杆木虫 (职业作家)

应助: 11 (小学生)
金币: 9196.3
散金: 1002
红花: 3
帖子: 4608
在线: 643.3小时
虫号: 179848
注册: 2006-02-09
性别: GG
专业: 光子与光电子器件

★
gwdavid(金币+1,VIP+0):欢迎常来 5-31 19:49

不仅长，而且好像不完整，没法调试呀

赞一下(10人)

回复此楼

4楼2009-05-30 23:09:02

已阅回复此楼关注TA 给TA发消息送TA红花 TA的回帖

相关版块跳转我要订阅楼主阳光不锈7717 的主题更新

返回列表

最具人气热帖推荐 [查看全部]		作者	回/看	最后发表

[考研] 300求调剂，材料科学英一数二 +8	leaflight 2026-03-24	8/400	2026-03-29 01:31 by fmesaito
[考研] 调剂310 +7	温柔的晚安 2026-03-25	8/400	2026-03-29 01:09 by 我是小康
[硕博家园] 求调剂 330分 085600材料与化工 +3	gqhhh 2026-03-22	3/150	2026-03-29 00:52 by 544594351
[考研] 数一英一271专硕（085401）求调剂，可跨 +7	前行必有光 2026-03-28	8/400	2026-03-28 23:22 by 小木虫tim
[考研] 275求调剂 +10	Micky11223 2026-03-25	14/700	2026-03-28 15:48 by Micky11223
[考研] 085602 化工专硕 338分求调剂 +12	路痴小琪 2026-03-27	12/600	2026-03-28 15:41 by L135790
[考研] 340求调剂 +5	jhx777 2026-03-27	5/250	2026-03-28 04:18 by fmesaito
[有机交流] 高温高压反应求助 10+4	chibby 2026-03-25	4/200	2026-03-27 21:08 by BT20230424
[考研] 考研调剂 +9	小蜡新笔 2026-03-26	9/450	2026-03-27 11:10 by 不吃魚的貓
[考研] 0703化学一志愿南京师范大学303求调剂 +3	zzffylgg 2026-03-24	3/150	2026-03-27 10:42 by shangxh
[考研] 325求调剂 +5	李嘉图·S·路 2026-03-23	5/250	2026-03-27 00:42 by wxiongid
[考研] 调剂 +4	柚柚yoyo 2026-03-26	4/200	2026-03-26 20:43 by fmesaito
[考研] 329求调剂 +5	1() 2026-03-22	5/250	2026-03-26 20:40 by fmesaito
[考研] 机械学硕310分，数一英一，一志愿211本科双非找调剂信息 +3	@357 2026-03-25	3/150	2026-03-26 16:34 by by.MENG
[考研] 085602 289分求调剂 +8	WWW西西弗斯 2026-03-24	8/400	2026-03-26 16:33 by 不吃魚的貓
[考研] 334分一志愿武理-080500 材料求调剂 +4	李李不服输 2026-03-25	4/200	2026-03-25 21:26 by 星空星月
[考研] 求调剂 +3	李李不服输 2026-03-25	3/150	2026-03-25 13:03 by cmz0325
[考研] 340求调剂 +5	话梅糖111 2026-03-24	5/250	2026-03-25 06:53 by ilovexiaobin
[考研] 300分，材料，求调剂，英一数二 +5	超赞的 2026-03-24	5/250	2026-03-24 21:07 by 星空星月
[考研] 277分求调剂，跨调材料 +3	考研调剂lxh 2026-03-24	3/150	2026-03-24 13:52 by JourneyLucky