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

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 写了一个fortran90的小程序，编译通不过，请大侠帮忙
北京石油化工学院2026年研究生招生接收调剂公告
605/6返回列表上一页123456下一页
查看: 4089  |  回复: 59
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看
本帖产生 3 个 程序强帖 ，点击这里进行查看

Gina88

木虫 (正式写手)
引用回帖:
Originally posted by snoopyzhao at 2011-05-09 10:05:26:
你没有给我 EIGENVAL 啊，你给的是一个压缩文件，其中的内容是 CHGCAR1……

嗯，这次上传EIGENVAL了。
谢谢啦：）
赞一下 回复此楼
41楼2011-05-09 10:33:24
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
引用回帖:
Originally posted by Gina88 at 2011-05-09 10:33:24:
嗯，这次上传EIGENVAL了。
谢谢啦：）

给个 spin=2 时的 CHGCAR1 文件看一下……
赞一下 回复此楼
42楼2011-05-09 14:29:27
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

Gina88

木虫 (正式写手)
引用回帖:
Originally posted by snoopyzhao at 2011-05-09 14:29:27:
给个 spin=2 时的 CHGCAR1 文件看一下……

呵呵，这次的是有自旋的，而且是两种元素的情况。
非常非常感谢了！
赞一下 回复此楼
43楼2011-05-09 15:13:26
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

引用回帖:
Originally posted by Gina88 at 2011-05-09 09:51:06:
en，相减的数据不包含augmentation occupancies的那部分，
相减的是384 160 24以下，augmentation occupancies以上的那部分数据。
即CHGCAR1=CHGCAR1-CHGCAR2。

谢谢大侠了！

数据就是EIGENVAL，还有C ...

给一个实现，但与你最初的想法可能不一样，由于你只进行部分差减，因为除此以外部分的数据，全部以字符串形式读入与输出，只定义为数不多几个数组，而且把数组的维数也降下来，你看一下吧……
CODE:
program diff_CHGCAR

!announcement begin********************
implicit none
real(8),allocatable::densityup(:,:)
real(8),allocatable::densitydn(:,:)
integer,allocatable::atomnum(:)
integer i,k,n,ios,fileunit
integer filenum,atomsum,typenum,line_len
integer FFTx,FFTy,FFTz
character(len=80)::line
character(len=80)::filename
character(len=80)::subline
!End announcement**********************

!Begin reading data from "EIGENVAL"******
real(8)::atomnum1,atomnum2,notkown3
integer spin                    
open(unit=18,file="EIGENVAL")
read(18,*)atomnum1,atomnum2,notkown3,spin
close(18)
!End reading data from "EIGENVAL"********

write(*,*)"number of files:(2 or 3?)"
read(*,*)filenum

open(unit=68,file="CHGCAR",status="replace")

do n=1,filenum
   write(filename,'(a,i0)') 'CHGCAR',n
   fileunit = 28 + n-1
   open(unit=fileunit,file=filename,status='old')
   read(fileunit,'(a)')line
   if (n==1) write(68,'(a)') trim(line)
   read(fileunit,'(a)')line
   if (n==1) write(68,'(a)') trim(line)
   do i=1,3
      read(fileunit,'(a)')line
      if (n==1) write(68,'(a)') trim(line)
   end do
   read(fileunit,'(a)')line
   if (n==1) then
      write(68,'(a)') trim(line)
      line=adjustl(line)
      line_len=len_trim(line)
      typenum=1
      do i=1,line_len
         if(line(i:i)==' ' .and. line(i:i+1)/=' ') typenum=typenum+1
      end do
      allocate(atomnum(typenum))
   end if
   read(fileunit,'(a)') line
   if (n==1) then
      write(68,'(a)') trim(line)
      read(line,*) (atomnum(i),i=1,typenum)
      atomsum=sum(atomnum)
   end if
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)') trim(line)
   do i=1,atomsum
      read(fileunit,'(a)') line
      if(n==1) write(68,'(a)') trim(line)
   end do
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)')
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)') trim(line)
   subline = adjustl(line)
   read(line,*) FFTx,FFTy,FFTz
   if (n==1)  allocate(densityup(FFTx*FFTy*FFTz,filenum))
   read(fileunit,*)(densityup(i,n),i=1,FFTx*FFTy*FFTz)
   if (n/=1) then
      do k=2,FFTx*FFTy*FFTz
         densityup(k,1) = densityup(k,1)-densityup(k,n)
      end do
   end if
if (spin /=2 .and. n/=1) close(fileunit)
end do

write(68,'(5e16.9)')(densityup(k,1),k=1,FFTx*FFTy*FFTz)

do n=1,filenum
   fileunit = 28 + n-1
   do
      read(fileunit,'(a)',iostat=ios) line
      if (ios < 0) exit
      if (index (line, trim(subline)) /= 0) exit
      if (n == 1) then
         write(68,'(a)') trim(line)
      endif
   end do
   if (spin /=2) exit
   if (n == 1) then
       write(68,'(a)') trim(line)
       allocate(densitydn(FFTx*FFTy*FFTz,filenum))
   end if
   read(fileunit, *) (densityup(i,n),i=1,FFTx*FFTy*FFTz)
   if (n/=1) then
      do k=2,FFTx*FFTy*FFTz
         densityup(k,1) = densityup(k,1)-densityup(k,n)
      end do
   end if
   if(n/=1) close(fileunit)
end do

if (spin == 2) then
   write(68,'(5e16.9)')(densitydn(k,1),k=1,FFTx*FFTy*FFTz)
   do
      read(28,'(a)',iostat=ios) line
      if (ios < 0) exit
      write(68,'(a)') trim(line)
   end do
end if

close(28)
close(68)
stop
end
赞一下 回复此楼
44楼2011-05-09 16:41:46
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

★ ★
微尘、梦想(金币+2): 2011-05-09 18:07:21
上面的程序中有一个地方错了，更正了一下：
CODE:
program diff_CHGCAR

!announcement begin********************
implicit none
real(8),allocatable::densityup(:,:)
real(8),allocatable::densitydn(:,:)
integer,allocatable::atomnum(:)
integer i,k,n,ios,fileunit
integer filenum,atomsum,typenum,line_len
integer FFTx,FFTy,FFTz
character(len=80)::line
character(len=80)::filename
character(len=80)::subline
!End announcement**********************

!Begin reading data from "EIGENVAL"******
real(8)::atomnum1,atomnum2,notkown3
integer spin                    
open(unit=18,file="EIGENVAL")
read(18,*)atomnum1,atomnum2,notkown3,spin
close(18)
!End reading data from "EIGENVAL"********

write(*,*)"number of files:(2 or 3?)"
read(*,*)filenum

open(unit=68,file="CHGCAR",status="replace")

do n=1,filenum
   write(filename,'(a,i0)') 'CHGCAR',n
   fileunit = 28 + n-1
   open(unit=fileunit,file=filename,status='old')
   read(fileunit,'(a)')line
   if (n==1) write(68,'(a)') trim(line)
   read(fileunit,'(a)')line
   if (n==1) write(68,'(a)') trim(line)
   do i=1,3
      read(fileunit,'(a)')line
      if (n==1) write(68,'(a)') trim(line)
   end do
   read(fileunit,'(a)')line
   if (n==1) then
      write(68,'(a)') trim(line)
      line=adjustl(line)
      line_len=len_trim(line)
      typenum=1
      do i=1,line_len
         if(line(i:i)==' ' .and. line(i:i+1)/=' ') typenum=typenum+1
      end do
      allocate(atomnum(typenum))
   end if
   read(fileunit,'(a)') line
   if (n==1) then
      write(68,'(a)') trim(line)
      read(line,*) (atomnum(i),i=1,typenum)
      atomsum=sum(atomnum)
   end if
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)') trim(line)
   do i=1,atomsum
      read(fileunit,'(a)') line
      if(n==1) write(68,'(a)') trim(line)
   end do
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)')
   read(fileunit,'(a)') line
   if(n==1) write(68,'(a)') trim(line)
   subline = adjustl(line)
   read(line,*) FFTx,FFTy,FFTz
   if (n==1)  allocate(densityup(FFTx*FFTy*FFTz,filenum))
   read(fileunit,*)(densityup(i,n),i=1,FFTx*FFTy*FFTz)
   if (n/=1) then
      do k=2,FFTx*FFTy*FFTz
         densityup(k,1) = densityup(k,1)-densityup(k,n)
      end do
   end if
if (spin /=2 .and. n/=1) close(fileunit)
end do

write(68,'(5e16.9)')(densityup(k,1),k=1,FFTx*FFTy*FFTz)

do n=1,filenum
   fileunit = 28 + n-1
   do
      read(fileunit,'(a)',iostat=ios) line
      if (ios < 0) exit
      if (index (line, trim(subline)) /= 0) exit
      if (n == 1) then
         write(68,'(a)') trim(line)
      endif
   end do
   if (spin /=2) exit
   if (n == 1) then
       write(68,'(a)') trim(line)
       allocate(densitydn(FFTx*FFTy*FFTz,filenum))
   end if
   read(fileunit, *) (densitydn(i,n),i=1,FFTx*FFTy*FFTz)
   if (n/=1) then
      do k=2,FFTx*FFTy*FFTz
         densitydn(k,1) = densitydn(k,1)-densitydn(k,n)
      end do
   end if
   if(n/=1) close(fileunit)
end do

if (spin == 2) then
   write(68,'(5e16.9)')(densitydn(k,1),k=1,FFTx*FFTy*FFTz)
   do
      read(28,'(a)',iostat=ios) line
      if (ios < 0) exit
      write(68,'(a)') trim(line)
   end do
end if

close(28)
close(68)
stop
end
赞一下(1人) 回复此楼
45楼2011-05-09 16:45:24
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★
余泽成(金币+1): 谢谢参与应助！ 2011-05-19 19:22:17
其实，densitydn也不是必须的。densityup 用完之后，还可以用来盛放 densitydn 的东西，这两个数组是一样的大小的。如果不要 densitydn，那么程序内存占用可能会减小近一半。
赞一下(1人) 回复此楼
46楼2011-05-09 16:47:55
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★ ★
微尘、梦想(金币+2): 谢谢如此耐心的回答！ 2011-05-09 18:07:47
哦，在
CODE:
write(68,'(5e16.9)')(densityup(k,1),k=1,FFTx*FFTy*FFTz)

之后，应该加上 DEALLOCATE(densityup)

同样，在
CODE:
write(68,'(5e16.9)')(densitydn(k,1),k=1,FFTx*FFTy*FFTz)

之后，也应该加上DEALLOCATE(densitydn)
赞一下(1人) 回复此楼
47楼2011-05-09 17:02:17
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

★
余泽成(金币+1): 谢谢参与应助！ 2011-05-19 19:22:33
程序中还有两处错误

请将程序中两处：
CODE:
do k=2,FFTx*FFTy*FFTz

改为
CODE:
do k=1,FFTx*FFTy*FFTz
赞一下(1人) 回复此楼
48楼2011-05-09 19:29:37
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

Gina88

木虫 (正式写手)
引用回帖:
Originally posted by snoopyzhao at 2011-05-09 19:29:37:
程序中还有两处错误

请将程序中两处：
CODE:
do k=2,FFTx*FFTy*FFTz

改为
CODE:
do k=1,FFTx*FFTy*FFTz


谢谢您！您给我的程序所用内存比我的应该节省很多，运行实现了我想要的功能。真的非常感谢！

从得到您写的程序我一直在看，大部分能看懂。
除了下面读写
augmentation occupancies   1  33
  0.5246464E+00 -0.3787519E+00  0.5632211E-24  0.9813096E-01 -0.5674925E-24
  0.1721307E-24 -0.6489097E-01 -0.1721307E-24  0.3600302E+00  0.0000000E+00
  0.5255511E+00  0.0000000E+00 -0.2341957E-25  0.1750307E+00  0.2692635E-26
  0.7649248E+00  0.0000000E+00  0.1090754E-24  0.2306250E+00 -0.1012863E-24
  0.5314240E-17  0.2497328E+00  0.0000000E+00  0.5526112E-25  0.8797233E-01
-0.6241027E-25  0.4471885E-17  0.2937433E-01  0.0000000E+00 -0.2790149E-26
  0.1616863E-01  0.3756390E-26 -0.2151094E-18
augmentation occupancies   2  33
  0.5478887E+00  0.1007788E+00  0.1268635E-24 -0.5136288E-01 -0.1258005E-24
  0.2057362E-25  0.4940735E-01 -0.2461255E-25  0.1845513E-01  0.3143559E-24
  0.1146283E+00 -0.3276243E-24 -0.2114718E-25  0.3425659E-01  0.2167872E-25
  0.1329006E+01  0.0000000E+00 -0.8091556E-25  0.8198887E-01  0.8251071E-25
  0.4708363E-18  0.3142530E+00 -0.1295663E-26  0.6056954E-25  0.6759688E-01
-0.7514666E-25 -0.2222845E-17  0.2562290E-01  0.0000000E+00  0.1816476E-25
  0.1262322E-01 -0.1922575E-25  0.1530643E-18
  0.100000000000E+01  0.100000000000E+01
  160  160  160
部分的程序之外，这部分能看出来是反复读取和写入，可是怎么判断循环结束还是看不懂。另外
160 160 160没有看见读，怎么就能写入了呢。
这个程序真是奇妙啊。
也就高手能写出这样的程序。
要是我自己，打死我也想不出还有这个写法。
真的非常感谢snoopyzhao 了：）

   do
      read(fileunit,'(a)',iostat=ios) line
      if (ios < 0) exit
      if (index (line, trim(subline)) /= 0) exit
      if (n == 1) then
         write(68,'(a)') trim(line)
      endif
   end do
   if (spin /=2) exit
   if (n == 1) then
       write(68,'(a)') trim(line)
       allocate(densitydn(FFTx*FFTy*FFTz,filenum))
   end if
赞一下 回复此楼
49楼2011-05-10 00:52:37
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)

【答案】应助回帖

★ ★
微尘、梦想(金币+2): 2011-05-10 19:03:47
引用回帖:
Originally posted by Gina88 at 2011-05-10 00:52:37:
谢谢您！您给我的程序所用内存比我的应该节省很多，运行实现了我想要的功能。真的非常感谢！

从得到您写的程序我一直在看，大部分能看懂。
除了下面读写
augmentation occupancies   1  33
  0.5246464E ...

部分的程序之外，这部分能看出来是反复读取和写入，可是怎么判断循环结束还是看不懂。另外
160 160 160没有看见读，怎么就能写入了呢。
这个程序真是奇妙啊。
也就高手能写出这样的程序。
要是我自己，打死我也想不出还有这个写法。
真的非常感谢snoopyzhao 了：）

在进入下面这个循环之前，如果是 spin ==2，那么所有的文件都没有关闭，如果是 spin /=2，那么除文件 1 以外都关闭了。

   do
      read(fileunit,'(a)',iostat=ios) line
      if (ios < 0) exit
      if (index (line, trim(subline)) /= 0) exit !这一行是判断是不是 160 160 160 那行的。如果是跳出读 augmentation occupancies 部分的循环。
      if (n == 1) then
         write(68,'(a)') trim(line)
      endif
   end do
   if (spin /=2) exit ! 如果 spin /=2，程序到这里已经结束了，因为 iostat 显示已经读到文件的最后了……
   if (n == 1) then
       write(68,'(a)') trim(line) !这就是写 160 160 160 那一行的
       allocate(densitydn(FFTx*FFTy*FFTz,filenum))
   end if

后面应该是这个部分一样，但那只是关系 spin ==2 的事了……
赞一下(1人) 回复此楼
50楼2011-05-10 06:50:40
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 Gina88 的主题更新
605/6返回列表上一页123456下一页
普通表情 龙 兔 虎 猫
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 316求调剂 +7 江辞666 2026-03-26 7/350 2026-03-28 21:28 by sanrepian
[考研] 22408 359分调剂 +4 Qshers 2026-03-27 5/250 2026-03-28 21:26 by zhq0425
[考研] 一志愿华理，数一英一285求A区调剂 +8 AZMK 2026-03-25 12/600 2026-03-28 18:15 by AZMK
[考研] 求调剂 +3 QiMing7 2026-03-25 4/200 2026-03-28 14:30 by QiMing7
[考研] 394求调剂 +3 好事多磨静候佳� 2026-03-26 5/250 2026-03-28 14:24 by 唐沐儿
[考研] 283求调剂 +7 A child 2026-03-28 7/350 2026-03-28 12:05 by zllcz
[材料工程] 一志愿C9材料与化工专业总分300求调剂 +8 曼111 2026-03-24 9/450 2026-03-28 07:58 by YYYYX1234
[考研] 求调剂推荐 材料 304 +15 荷包蛋hyj 2026-03-26 15/750 2026-03-28 04:13 by fmesaito
[考研] 一志愿北京化工大学 070300 学硕 336分 求调剂 +9 vv迷 2026-03-22 9/450 2026-03-27 15:59 by 不吃魚的貓
[考博] 26申博 +3 加油冲啊！ 2026-03-26 3/150 2026-03-27 15:38 by cls512
[考研] 085600材料与化工调剂 +10 A-哆啦Z梦 2026-03-23 16/800 2026-03-27 15:13 by caszguilin
[考研] 一志愿北化求调剂 +3 Jsman 2026-03-22 3/150 2026-03-26 21:06 by ajpv风雷
[考研] 生物学 296 求调剂 +4 朵朵- 2026-03-26 6/300 2026-03-26 19:01 by 不吃魚的貓
[考研] 281求调剂 +6 Koxui 2026-03-24 7/350 2026-03-26 15:37 by 无际的草原
[考研] 07化学303求调剂 +5 睿08 2026-03-25 5/250 2026-03-25 22:46 by 418490947
[考研] 机械学硕总分317求调剂！！！！ +4 Acaciad 2026-03-25 4/200 2026-03-25 19:59 by hanserlol
[考研] 289材料与化工（085600）B区求调剂 +4 这么名字咋样 2026-03-22 5/250 2026-03-25 08:20 by mx.yue
[考研] 上海电力大学材料防护与新材料重点实验室招收调剂研究生（材料、化学、电化学，环境） +4 我爱学电池 2026-03-23 4/200 2026-03-25 00:59 by 1027_324
[考研] 300分，材料，求调剂，英一数二 +5 超赞的 2026-03-24 5/250 2026-03-24 21:07 by 星空星月
[考研] 292求调剂 +4 鹅鹅鹅额额额额� 2026-03-24 4/200 2026-03-24 16:41 by peike
信息提示
关闭
请填处理意见
关闭