| 查看: 539 | 回复: 3 | |||
| 当前主题已经存档。 | |||
[交流]
【求助】一个计算库伦相互作用能的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 |
回复此楼» 猜你喜欢
寻求一种能扛住强氧化性腐蚀性的容器密封件
已经有3人回复
-
请问哪里可以有青B申请的本子可以借鉴一下。
已经有4人回复
-
真诚求助：手里的省社科项目结项要求主持人一篇中文核心，有什么渠道能发核心吗
已经有6人回复
-
孩子确诊有中度注意力缺陷
已经有14人回复
-
三甲基碘化亚砜的氧化反应
已经有4人回复
-
请问下大家为什么这个铃木偶联几乎不反应呢
已经有5人回复
-
请问有评职称，把科研教学业绩算分排序的高校吗
已经有5人回复
-
2025冷门绝学什么时候出结果
已经有3人回复
-
天津工业大学郑柳春团队欢迎化学化工、高分子化学或有机合成方向的博士生和硕士生加入
已经有4人回复
-
康复大学泰山学者周祺惠团队招收博士研究生
已经有6人回复
2楼2009-05-18 20:44:19
snoopyzhao
至尊木虫 (职业作家)
- 程序强帖: 16
- 应助: 157 (高中生)
- 贵宾: 0.02
- 金币: 18844.7
- 红花: 29
- 帖子: 3803
- 在线: 1422.4小时
- 虫号: 183750
- 注册: 2006-02-13
- 专业: 污染生态化学
3楼2009-05-18 22:48:40
mickk
铁杆木虫 (职业作家)
- 应助: 11 (小学生)
- 金币: 9196.3
- 散金: 1002
- 红花: 3
- 帖子: 4608
- 在线: 643.3小时
- 虫号: 179848
- 注册: 2006-02-09
- 性别: GG
- 专业: 光子与光电子器件
4楼2009-05-30 23:09:02