版块导航
正在加载中...
客户端APP下载
论文辅导
调剂小程序
登录
注册
帖子
帖子
用户
本版
应《网络安全法》要求，自2017年10月1日起，未进行实名认证将不得使用互联网跟帖服务。为保障您的帐号能够正常使用，请尽快对帐号进行手机号验证，感谢您的理解与支持！
24小时热门版块排行榜
>
论坛更新日志
(803)
>
导师招生
(83)
>
考研
(78)
>
虫友互识
(35)
>
考博
(21)
>
论文道贺祈福
(18)
>
硕博家园
(15)
>
无机/物化
(13)
>
文献求助
(11)
>
教师之家
(10)
>
公派出国
(7)
>
休闲灌水
(7)
>
基金申请
(6)
>
论文投稿
(6)
>
找工作
(4)
>
博后之家
(3)
小木虫论坛-学术科研互动平台
»
计算模拟区
»
程序语言
»
Fortran
»
【求助】FORTRAN编译通过，但是运行不了
5
1/1
返回列表
查看: 2682 | 回复: 19
只看楼主
@他人
存档
新回复提醒
(忽略)
收藏
在APP中查看
当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖
zyj8119
木虫
(著名写手)
应助: 65
(初中生)
贵宾: 0.003
金币: 915.1
散金: 1440
红花: 35
帖子: 2936
在线: 1329.4小时
虫号: 664177
注册: 2008-11-29
性别: GG
专业: 理论和计算化学
[交流]
【求助】FORTRAN编译通过，但是运行不了
已有3人参与
CODE:
PROGRAM MAIN
PARAMETER(num=14797,blx=61.634002,bly=62.406401,blz=63.429759,
* namino=200)
CHARACTER name(num)*9,fft(num)*5,atomname(num)*4,fx(num)*4
INTEGER occupation(num),Tatom,itt,i
real xc(num),yc(num),zc(num),charge(num)
real xtemp,ytemp,ztemp,xfinal,yfinal,zfinal
OPEN(10,file='2.car',status='old')
do 20 i=1,num
read(10,*)name(i),xc(i),yc(i),zc(i),fx(i),occupation(i),
* fft(i),atomname(i),charge(num)
20 continue
close(10)
do 30 i=1,num
xc(i)=0
yc(i)=0
zc(i)=0
30 continue
natom_add=0
Tatom=num+natom_add
*********************************************************
* add Si to the chosen Oxygen atom
*********************************************************
do 45 itt=1,namino
xtemp=blx*RAN2(IDUM)
ytemp=bly*RAN2(IDUM)
ztemp=blz*RAN2(IDUM)
lbond=1.90
call addatom(xtemp,ytemp,ztemp,lbond,Tatom,xfinal,yfinal,zfinal)
natom_add=natom_add+1
Tatom=Tatom+natom_add
name(Tatom)='Si'
xc(Tatom)=xfinal
yc(Tatom)=yfinal
zc(Tatom)=zfinal
fx(Tatom)='XXXX'
occupation(Tatom)=1
fft(Tatom)='Si3'
atomname(Tatom)='Si'
charge(Tatom)=5.000
open(140,file='amino.car',access='append')
write(140,888)a(Tatom),xc(Tatom),
& yc(Tatom),zc(Tatom),
& fx(Tatom),occupation(Tatom),
& fft(Tatom),atomname(Tatom),
& charge(Tatom)
close(140)
******************************************************************
* add C1 atom on the chosen Si atom
******************************************************************
lbond=1.93
xtemp=xc(Tatom)
ytemp=yc(Tatom)
ztemp=zc(Tatom)
call addatom(xtemp,ytemp,ztemp,lbond,Tatom,xfinal,yfinal,
* zfinal)
natom_add=natom_add+1
Tatom=Tatom+natom_add
name(Tatom)='C'
xc(Tatom)=xfinal
yc(Tatom)=yfinal
zc(Tatom)=zfinal
fx(Tatom)='XXXX'
occupation(Tatom)=1
fft(Tatom)='C_3'
atomname(Tatom)='C'
charge(Tatom)=6.000
open(150,file='amino.car',access='append')
write(150,888)a(Tatom),xc(Tatom),
& yc(Tatom),zc(Tatom),
& fx(Tatom),occupation(Tatom),
& fft(Tatom),atomname(Tatom),
& charge(Tatom)
close(150)
******************************************************************
* add C2 atom on the chosen C1 atom
******************************************************************
lbond=1.50
xtemp=xc(Tatom)
ytemp=yc(Tatom)
ztemp=zc(Tatom)
call addatom(xtemp,ytemp,ztemp,lbond,Tatom,
& xfinal,yfinal,zfinal)
natom_add=natom_add+1
Tatom=Tatom+natom_add
name(Tatom)='C'
xc(Tatom)=xfinal
yc(Tatom)=yfinal
zc(Tatom)=zfinal
fx(Tatom)='XXXX'
occupation(Tatom)=1
fft(Tatom)='C_3'
atomname(Tatom)='C'
charge(Tatom)=7.000
open(160,file='amino.car',access='append')
write(160,888)a(Tatom),xc(Tatom),
& yc(Tatom),zc(Tatom),
& fx(Tatom),occupation(Tatom),
& fft(Tatom),atomname(Tatom),
& charge(Tatom)
close(160)
******************************************************************
* add C3 atom on the chosen C2 atom
******************************************************************
lbond=1.50
xtemp=xc(Tatom)
ytemp=yc(Tatom)
ztemp=zc(Tatom)
call addatom(xtemp,ytemp,ztemp,lbond,Tatom,
& xfinal,yfinal,zfinal)
natom_add=natom_add+1
Tatom=Tatom+natom_add
name(Tatom)='C'
xc(Tatom)=xfinal
yc(Tatom)=yfinal
zc(Tatom)=zfinal
fx(Tatom)='XXXX'
occupation(Tatom)=1
fft(Tatom)='C_3'
atomname(Tatom)='C'
charge(Tatom)=8.000
open(170,file='amino.car',access='append')
write(170,888)a(Tatom),xc(Tatom),
& yc(Tatom),zc(Tatom),
& fx(Tatom),occupation(Tatom),
& fft(Tatom),atomname(Tatom),
& charge(Tatom)
close(170)
******************************************************************
* add N atom on the chosen C3 atom
******************************************************************
lbond=1.53
xtemp=xc(Tatom)
ytemp=yc(Tatom)
ztemp=zc(Tatom)
call addatom(xtemp,ytemp,ztemp,lbond,Tatom,
& xfinal,yfinal,zfinal)
natom_add=natom_add+1
Tatom=Tatom+natom_add
name(Tatom)='N'
xc(Tatom)=xfinal
yc(Tatom)=yfinal
zc(Tatom)=zfinal
fx(Tatom)='XXXX'
occupation(Tatom)=1
fft(Tatom)='N_3'
atomname(Tatom)='N'
charge(Tatom)=9.000
open(180,file='amino.car',access='append')
write(180,888)a(Tatom),xc(Tatom),
& yc(Tatom),zc(Tatom),
& fx(Tatom),occupation(Tatom),
& fft(Tatom),atomname(Tatom),
& charge(Tatom)
close(180)
45 continue
*********************************************************************************
* write the output file
*********************************************************************************
open(190,file='output-final.car',access='append')
do 200 i=1,Tatom
write(190,888)a(i),xc(i),yc(i),zc(i),fx(i),occupation(i),fft(i),
& atomname(i),charge(i)
200 continue
close(190)
888 format(A5,3X,F12.9,2X,F13.9,3X,F12.9,1X,A4,1X,I1,6X,A5,3X,A2,F7.3)
*********************************************************************************
*********************************************************************************
end
**********************************add atom************************************
SUBROUTINE addatom(xtemp,ytemp,ztemp,lbond,Tatom,xfinal,yfinal,
* zfinal)
REAL center(14,2)
INTEGER Tatom
open(35,file='center.txt',status='old')
do 36 i=1,14
read(35,*)center(i,1),center(i,2)
36 continue
close(35)
lc=1000
xcenter=0
ycenter=0
do 40 j=1,14
lct=sqrt((xtemp-center(i,1))**2+(ytemp-center(i,2)**2))
if(lct.lt.lc)then
lc=lct
*******把整个体分解成无数的平行的平面，确定整个平面的每个分割区域的中心*******************
xcenter=center(i,1)
ycenter=center(i,2)
end if
40 continue
if(ytemp.le.ycenter)then
ja=20
jb=0
jc=-1
jd=j
else
ja=-20
jb=0
jc=1
jd=j
endif
*****************向负方向搜索**********************************
if(xtemp.le.xcenter-5)then
ia=20
ib=0
ic=-1
minlbond=lbond-0.1
maxlbond=lbond+0.1
search_step=0.1
do 1000 i=ia,ib,ic
do 1010 j=ja,jb,jc
do 1020 k=-20,20
targetx=xtemp+search_step*i
targety=ytemp+search_step*j
targetz=ztemp+search_step*k
dis1=sqrt((targetx-xtemp)**2+
& (targety-ytemp)**2+
& (targetz-ztemp)**2)
if(dis1.gt.minlbond.and.dis1.lt.maxlbond)then
do 1030 im=1,Tatom
dis2=sqrt((targetx-xc(im))**2+
& (targety-yc(im))**2+
& (targetz-zc(im))**2)
if(dis2.lt.3.0)then
goto 1020
end if
1030 continue
goto 1040
end if
1020 continue
1010 continue
1000 continue
1040 xfinal=targetx
yfinal=targety
zfinal=targetz
end if
*****************向正方向搜索**********************************
if(xtemp.ge.xcenter+5)then
ia=20
ib=-20
ic=-1
minlbond=lbond-0.1
maxlbond=lbond+0.1
search_step=0.1
do 1050 i=ia,ib,ic
do 1060 j=ja,jb,jc
do 1070 k=-20,20
targetx=xtemp+search_step*i
targety=ytemp+search_step*j
targetz=ztemp+search_step*k
dis1=sqrt((targetx-xtemp)**2+
& (targety-ytemp)**2+
& (targetz-ztemp)**2)
if(dis1.gt.minlbond.and.dis1.lt.maxlbond)then
do 1080 im=1,Tatom
dis2=sqrt((targetx-xc(im))**2+
& (targety-yc(im))**2+
& (targetz-zc(im))**2)
if(dis2.lt.3.0)then
goto 1070
endif
1080 continue
end if
goto 1090
1070 continue
1060 continue
1050 continue
1090 xfinal=targetx
yfinal=targety
zfinal=targetz
end if
end SUBROUTINE
******************************************************************************
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
回复此楼
» 猜你喜欢
281求调剂（0805）
已经有8人回复
环境领域全国重点实验室招收博士1-2名
已经有3人回复
材料专硕306英一数二
已经有10人回复
301求调剂
已经有6人回复
一志愿天津大学化学工艺专业（081702）315分求调剂
已经有7人回复
302求调剂
已经有6人回复
26博士申请
已经有3人回复
268求调剂
已经有3人回复
311求调剂
已经有10人回复
被我言中：新模板不强调格式了，假专家开始管格式了
已经有4人回复
高级回复
» 本主题相关价值贴推荐，对您同样有帮助:
【求助】求fortra程序
已经有4人回复
好好学习，天天向上。
1楼
2010-09-08 16:50:11
已阅
回复此楼
关注TA
给TA发消息
送TA红花
TA的回帖
hakekill
木虫
(小有名气)
应助: 0
(幼儿园)
金币: 1709.3
帖子: 131
在线: 19小时
虫号: 246017
注册: 2006-04-29
性别: GG
专业: 水环境与生态水利
★ ★
小木虫(金币
+0.5
):给个红包，谢谢回帖交流
nono2009(金币+1):鼓励应助。 2010-09-09 08:05:59
你这个程序的问题在于，主程序中没有声明数组a
子程序中是直接使用了xc、yc和zc。在子程序中要么通过参数传递过来，要么用common。
上面是fortran 77的做法。
Fortran90的话可以用contains将subroutine包含在主程序里面，或者是使用module来传递数组。
赞
一下
(2人)
回复此楼
高级回复
8楼
2010-09-08 20:37:25
已阅
回复此楼
关注TA
给TA发消息
送TA红花
TA的回帖
查看全部 20 个回答
zyj8119
木虫
(著名写手)
应助: 65
(初中生)
贵宾: 0.003
金币: 915.1
散金: 1440
红花: 35
帖子: 2936
在线: 1329.4小时
虫号: 664177
注册: 2008-11-29
性别: GG
专业: 理论和计算化学
编译没有错误，但是运行会出现问题：
--------------------Configuration: jiaan - Win32 Debug--------------------
Linking...
jiaan.obj : error LNK2001: unresolved external symbol _A@4
jiaan.obj : error LNK2001: unresolved external symbol _XC@4
jiaan.obj : error LNK2001: unresolved external symbol _YC@4
jiaan.obj : error LNK2001: unresolved external symbol _ZC@4
Debug/jiaan.exe : fatal error LNK1120: 4 unresolved externals
Error executing link.exe.
jiaan.exe - 5 error(s), 0 warning(s)
赞
一下
回复此楼
好好学习，天天向上。
2楼
2010-09-08 16:51:27
已阅
回复此楼
关注TA
给TA发消息
送TA红花
TA的回帖
zyj8119
木虫
(著名写手)
应助: 65
(初中生)
贵宾: 0.003
金币: 915.1
散金: 1440
红花: 35
帖子: 2936
在线: 1329.4小时
虫号: 664177
注册: 2008-11-29
性别: GG
专业: 理论和计算化学
center.txt:
2.201 2.228
3.301 3.342
5.502 5.570
7.703 7.798
9.904 10.026
12.105 12.254
14.306 14.482
16.507 16.710
18.708 18.938
20.909 21.166
23.110 23.394
25.311 25.622
27.513 27.850
29.713 30.078
赞
一下
回复此楼
好好学习，天天向上。
3楼
2010-09-08 16:51:55
已阅
回复此楼
关注TA
给TA发消息
送TA红花
TA的回帖
zyj8119
木虫
(著名写手)
应助: 65
(初中生)
贵宾: 0.003
金币: 915.1
散金: 1440
红花: 35
帖子: 2936
在线: 1329.4小时
虫号: 664177
注册: 2008-11-29
性别: GG
专业: 理论和计算化学
引用回帖:
Originally posted by
zyj8119
at 2010-09-08 16:51:55:
center.txt:
2.201 2.228
3.301 3.342
5.502 5.570
7.703 7.798
9.904 10.026
12.105 12.254
14.306 14.482
16.507 16.710
18.708 18.938
20.909 21.166
23.110 23.394
25.311 25.622
27.513 2 ...
http://d.namipan.com/d/e0c22a32e ... 28a70fb9cd4b4831200
,这个是2.car
赞
一下
回复此楼
好好学习，天天向上。
4楼
2010-09-08 16:53:18
已阅
回复此楼
关注TA
给TA发消息
送TA红花
TA的回帖
查看全部 20 个回答
如果回帖内容含有宣传信息，请如实选中。否则帐号将被全论坛禁言
普通表情
龙
兔
虎
猫
高级回复
(可上传附件)
百度网盘
|
360云盘
|
千易网盘
|
华为网盘
在新窗口页面中打开自己喜欢的网盘网站，将文件上传后，然后将下载链接复制到帖子内容中就可以了。
最具人气热帖推荐
[查看全部]
作者
回/看
最后发表
[
考研
]
301求调剂
+6
yy要上岸呀
2026-03-17
6/300
2026-03-17 23:58
by
星空星月
[
考博
]
26博士申请
+3
1042136743
2026-03-17
3/150
2026-03-17 23:30
by
轻松不少随
[
考研
]
293求调剂
+7
zjl的号
2026-03-16
12/600
2026-03-17 18:22
by
重科小霸王
[
考研
]
308求调剂
+4
是Lupa啊
2026-03-16
4/200
2026-03-17 17:12
by
ruiyingmiao
[
考研
]
材料专硕274一志愿陕西师范大学求调剂
+5
薛云鹏
2026-03-13
5/250
2026-03-17 10:15
by
Sammy2
[
考研
]
326求调剂
+4
诺贝尔化学奖觊�
2026-03-15
7/350
2026-03-16 17:11
by
诺贝尔化学奖觊�
[
考研
]
304求调剂
+4
ahbd
2026-03-14
4/200
2026-03-16 16:48
by
我的船我的海
[
考研
]
一志愿211 0703方向310分求调剂
+3
努力奋斗112
2026-03-15
3/150
2026-03-16 16:44
by
houyaoxu
[
考研
]
070303 总分349求调剂
+3
LJY9966
2026-03-15
5/250
2026-03-16 14:24
by
xwxstudy
[
考研
]
材料与化工一志愿南昌大学327求调剂推荐
+7
Ncdx123456
2026-03-13
8/400
2026-03-16 12:15
by
karry wen
[
考研
]
294求调剂
+3
Zys010410@
2026-03-13
4/200
2026-03-15 10:59
by
zhq0425
[
考研
]
265求调剂
+4
威化饼07
2026-03-12
4/200
2026-03-14 17:23
by
userper
[
考研
]
【0703化学调剂】-一志愿华中师范大学-六级475
+5
Becho359
2026-03-11
5/250
2026-03-14 11:35
by
哦哦123
[
考研
]
求材料调剂
+5
隔壁陈先生
2026-03-12
5/250
2026-03-13 22:03
by
星空星月
[
考研
]
工科，求调剂
+3
我887
2026-03-11
3/150
2026-03-13 21:39
by
JourneyLucky
[
考研
]
【考研调剂求收留】
+3
Ceciilia
2026-03-11
3/150
2026-03-13 20:18
by
JourneyLucky
[
考研
]
考研调剂
+4
芬达46
2026-03-12
4/200
2026-03-13 16:04
by
ruiyingmiao
[
考研
]
307求调剂
+5
超级伊昂大王
2026-03-12
5/250
2026-03-13 15:56
by
棒棒球手
[
考研
]
070303一志愿西北大学学硕310找调剂
+3
d如愿上岸
2026-03-13
3/150
2026-03-13 10:43
by
houyaoxu
[
考研
]
270求调剂 085600材料与化工专硕
+3
YXCT
2026-03-11
3/150
2026-03-13 10:13
by
houyaoxu
信息提示
关闭
请填处理意见
关闭
确定
回复此楼
281求调剂（0805）
已经有8人回复
