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

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 【求助】帮忙改写展宽程序
121/2返回列表12下一页
查看: 1511  |  回复: 11
只看楼主 @他人 存档 新回复提醒 (忽略) 收藏    在APP中查看

sci_papers

银虫 (正式写手)

[交流] 【求助】帮忙改写展宽程序 已有3人参与

大家好,我想用高斯展宽程序,现在得到了一个,但是感觉不是很满意,再次贴出,麻烦大家帮我看看怎么修改,而且我也不太懂编程,所以大家修改后麻烦也全部贴上.谢谢,我现在的程序如下:

        program CONVOLUTE
        implicit none
        integer noofmodes,arbitrary
        parameter(arbitrary=3500)
        double precision wavenr(arbitrary),IRint(arbitrary)
        integer weigenv
!        wavenumber start and finish
        double precision wbegin,wend
        character*80 fname
        character*30 tc
       
!        Filename: inputfilename
        read(5,*) tc,fname
!        wbegin: 0.0
        read(5,*) tc,wbegin
!        wend: 3500.0
        read(5,*) tc,wend
!        print the data
        print *,'Filename: ',fname
        print *,'wbegin: ',wbegin
        print *,'wend: ',wend
       
        print *,'calling subroutine...'
        call readfreq(fname,wavenr,IRint,weigenv,wbegin)
       
        call convolution(wbegin,wend,wavenr,IRint,weigenv)
        stop
!        end program
        end
       
        subroutine readfreq(fname,wavenr,IRint,weigenv,wbegin)
!        print *,'beginning of subroutine...'
!        read in eigenfrequencies and IR intensities
        implicit none
        integer noofmodes,arbitrary
        parameter(arbitrary=3500)
        double precision wavenr(arbitrary),IRint(arbitrary)
        double precision energy(2,arbitrary),wbegin
        character*80 fname
!        print *,'opening the file'
        integer i,reason,weigenv
        double precision wavetmp, inttmp
        open (unit=3,file=fname,status='OLD')
        i=0
!        print *,'entering do statement'
        do
        read(3,*,IOSTAT=reason) wavetmp,inttmp
        if (reason>0) then
        print *,'reason>0, i.e. somethings wrong'
        else if (reason<0) then
        print *,'reason<0, reached the end of file'
        close(3)
        return
        else
        if(wavetmp.gt.wbegin) then
        i=i+1
!        print *,'eigenfreq: ',wavetmp,'IR intensity',inttmp
        wavenr(i)=wavetmp
        IRint(i)=inttmp
        print *,'eigenfreq: ',wavenr(i),' IR intensity: ',IRint(i),' i = ',i
        weigenv=i
        endif
        end if
        end do
        return
!        print *,'end of subroutine'
        end subroutine
       
       
        subroutine convolution(wbegin,wend,wavenr,IRint,weigenv)
        implicit none
        integer bignumber,arbitrary
        parameter(bignumber=10000000,arbitrary=3500)
        double precision wbegin,wend,wavenr(arbitrary),IRint(arbitrary)
        integer noofscanpoints,n,m,k,weigenv
        parameter(noofscanpoints=100000)
        double precision deltaw,w1(bignumber),conv(bignumber)
        double precision mygamma,wave2ev
        parameter(wave2ev=8065.46)
!        mygamma=4.0d-3*wave2ev
        mygamma=10.0
!        mygamma=4.0d-3 in eV unit, convert to wavenumber by multiple wave2ev
       
        deltaw=(wend-wbegin)/dfloat(noofscanpoints)
        do n=1,noofscanpoints
        w1(n)=wbegin+n*deltaw
        conv(n)=0.0
        enddo
        do m=1,weigenv
        do k=1,noofscanpoints
!        print *,'m=',m,'k=',k
        conv(k)=conv(k)+IRint(m)/((w1(k)-wavenr(m))**2+mygamma**2)
!        print *,'w1=',w1(k),' conv(k)=',conv(k)
        enddo
        enddo
       
        open(unit=1,file='IETSconv.dat',status='unknown')
        do k=1,noofscanpoints
        write(1,*) w1(k),conv(k)
        enddo
        close(1)
       
        return
        end subroutine


现在麻烦大家:
1. 麻烦检查下这个程序的高斯展宽是否正确. 自己没用过,真不知道.谢谢
2. 这个程序需要提供jobinput.txt文件,然后这个文件中含有相关数值:
inputfile anth.txt
wbegin 1000.0
wend 1800.0
这些数值也包括了需要展宽的波段数,比如:1000.0-1800.0。我觉得这个也挺好,因为有时候需要分析的波段不是全部波段, 然后这个展宽程序自动从anth.txt文件中自动读取这个范围的数据展宽.然后会输出一个展宽后的数据文件IETSconv.dat.当然我说这些对于编程的人来说就太啰嗦了,因为大家一看就知道什么意思.不好意思

3. 我现在想要的就是,自己输入需要读取的文件,也输出保存的文件名.这样比较方便.不想这样读取inputfile,因为如果处理数据多的话,每次都要修改inputfile文件,很麻烦.当然在这儿,如果我只输入一个文件,最后数据自动保存为同名的dat类型文件则更好.
比如./gauvib.exe < anth.txt > anth.dat
或者./gauvib.exe < anth.txt 然后得到anth.dat数据文件更好

4. 既然想不用inputfile文件,那这个文件中的波段要在程序中实现了.在程序中加入可以设置波段的语句.
比如:
wbegin=1000.0
wend=1800.0

5. 如果谁有这样的或者更好的高斯或者洛伦茨展宽程序可以帮忙给我,因为要用,自己又不会.
再次先感谢大家.深深的希望大家帮个忙.看怎么修改程序.
回复此楼

» 猜你喜欢

» 本主题相关价值贴推荐，对您同样有帮助:
1楼 2010-05-14 20:29:30
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★ ★
resonant(金币+2):新政策摸索中，感谢回帖交流。 2010-05-14 20:43:10
sci_papers(金币+2):谢谢,swizard,我也试过了,最后也是生成一个相同的文件,如果处理很多数据的话,也比较麻烦.所以就想得到,输入一个然后就输出一个相同文件名的文件.这样感觉在Linux下更好一点.所以还是想麻烦各位帮看看我的这个程序. 2010-05-14 22:46:06
sci_papers(金币+1):我不会编程哦,哎,惭愧.所以麻烦大家帮忙看看,要不看怎么在这个现有的程序上改. 2010-05-14 22:51:15
为什么不直接用 swizard （http://www.sg-chem.net/swizard/）？ 那个有更多的选项啥的……

如果一定要自己写，你可以参考它的说明书中的相应的方法，呵呵……
赞一下(1人) 回复此楼
2楼2010-05-14 20:38:32
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

sci_papers

银虫 (正式写手)
有展宽程序的帮忙给一个吧,或者帮忙看看这个程序怎么改,谢谢了
赞一下 回复此楼
3楼2010-05-15 18:58:18
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
sci_papers(金币+2):谢谢,我马上贴出来 2010-05-15 20:06:34
你给一个数据文件以及其它所有必须的文件，告诉我们如何去跑，会大概获得一个什么样的结果，这样我们才可以试着去改。要知道，会编程的不见得懂得你的专业，呵呵……

另外，如果你的结果与 Swizard 出来的结果一致，也可以用 Swizard 的结果作为 bench mark，呵呵……
赞一下 回复此楼
4楼2010-05-15 19:12:25
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

sci_papers

银虫 (正式写手)
引用回帖:
Originally posted by snoopyzhao at 2010-05-15 19:12:25:
你给一个数据文件以及其它所有必须的文件，告诉我们如何去跑，会大概获得一个什么样的结果，这样我们才可以试着去改。要知道，会编程的不见得懂得你的专业，呵呵……

另外，如果你的结果与 Swizard 出来的结果 ...

我就是想用我的那个程序展宽如下文件anth.txt的1000.0-1200.0之间波段的数值,利用如下操作,直接得到anth.dat文件.
./gauvib.exe < anth.txt > anth.dat


     1317.72      0.000116
        1299.71     -0.001662   
        1276.74      0.000732   
        1273.09     -0.000163   
        1267.25      0.001292   
        1231.14      0.001560   
        1212.02     -0.006060  
        1207.34      0.002982   
        1203.73      0.001189   
        1188.71     -0.000662   
        1182.54     -0.000166   
        1170.78      0.000149     
        1149.25     -0.000112   
        1118.63      0.000126   
        1118.22      0.000898   
        1091.80     -0.001232   
        1089.63      0.000377  
        1053.32      0.000209   
        1049.16      0.000863  
        1033.49     -0.000936  
        1011.41      0.000196     
        1002.53      0.000581   
         978.58      0.000019   
         939.70      0.001685   
         935.25     -0.000613   
         931.69     -0.001225   
         922.34     -0.000126   
         921.47      0.000166   
         885.45      0.000699

这都是比较简单对于编程的人,可是我不太懂.
我现在的程序有点点麻烦,需要

./gauvib.exe < jobinput.txt

而自己想要展宽的波段,和数据文件就在这个jobinput.txt文件中.每次改动比较麻烦.所以想在我的那个程序里面直接改动自己想要的波段.而且,不想要 jobinput.txt 文件,通过自己直接输入文件来得到,如./gauvib.exe < anth.txt > anth.dat.不知道说清楚没. 程序的改动应该就是在读取文件,设置波段,和输出文件那部分,由于我不太懂,老改错.

Swizard 我也试过了,但是这样直接读取数据文件报错.而且也比较慢,因为我数据多的话,就比较麻烦,所以想在Linux系统下用,而且通过
./gauvib.exe < anth.txt > anth.dat的操作比较快点.麻烦各位了

[ Last edited by sci_papers on 2010-5-15 at 21:09 ]
赞一下 回复此楼
5楼2010-05-15 21:04:03
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
sci_papers(金币+5):非常感谢您了,主要就是输入文件,波段设置,和输出文件那块的程序.我不想直接读取jobinput.txt.处理文本多,就麻烦.而且处理出来的结果文件夹一个名字也不方便,所以想自己输入输出. 2010-05-15 21:56:27
明天帮你改吧，应该不是很困难……
赞一下 回复此楼
6楼2010-05-15 21:32:38
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★ ★ ★
余泽成(金币+3):辛苦了！ 2010-05-16 10:08:32
sci_papers(金币+40):非常感谢,snoopyzhao 的热心帮助,这个修改一直困惑我好几天.啥也不说了,就是谢谢. 2010-05-16 14:30:47
达到你的第一个目标，直接
./gauvib.exe < anth.txt > anth.dat
就可以了，但觉得有点儿不方便的是起点和终点的波长是写死在程序里的，不知道这是不是你想要的。

至于你所说的高斯展宽啥的，由于没有见过公式，所以现在还不能确定，但只在最后一个子程序中修改，应该也不困难。回头有时间再弄吧。
CODE:
      program CONVOLUTE
      implicit none
      integer arbitrary
      parameter(arbitrary=3500)
      double precision wavenr(arbitrary),IRint(arbitrary)
      integer weigenv
!     wavenumber start and finish
      double precision wbegin,wend
      
      wbegin = 1000.0
      wend = 1800.0

      call readfreq(wavenr,IRint,weigenv,wbegin,wend)
      call convolution(wbegin,wend,wavenr,IRint,weigenv)
      stop
!     end program
      end
      
      subroutine readfreq(wavenr,IRint,weigenv,wbegin,wend)
!     print *,'beginning of subroutine...'
!     read in eigenfrequencies and IR intensities
      implicit none
      integer arbitrary
      parameter(arbitrary=3500)
      double precision wavenr(arbitrary),IRint(arbitrary)
      double precision wbegin,wend
      integer i,reason,weigenv
      double precision wavetmp, inttmp
      i=0
!     print *,'entering do statement'
      do
      read(*,*,IOSTAT=reason) wavetmp,inttmp
      if (reason>0) stop
      if (reason<0) return
      if(wavetmp.gt.wbegin .and. wavetmp .lt. wend) then
      i=i+1
      wavenr(i)=wavetmp
      IRint(i)=inttmp
!     print *,'eigenfreq: ',wavenr(i),' IR intensity: ',
!    &        IRint(i),' i = ',i
      weigenv=i
      endif
      end do
      return
      end subroutine
      
      subroutine convolution(wbegin,wend,wavenr,IRint,weigenv)
      implicit none
      integer bignumber,arbitrary
      parameter(bignumber=10000000,arbitrary=3500)
      double precision wbegin,wend,wavenr(arbitrary),IRint(arbitrary)
      integer noofscanpoints,n,m,k,weigenv
      parameter(noofscanpoints=100000)
      double precision deltaw,w1(bignumber),conv(bignumber)
      double precision mygamma,wave2ev
      parameter(wave2ev=8065.46)
!     mygamma=4.0d-3*wave2ev
      mygamma=10.0
!     mygamma=4.0d-3 in eV unit, convert to wavenumber by multiple wave2ev
      
      deltaw=(wend-wbegin)/dfloat(noofscanpoints)
      do n=1,noofscanpoints
      w1(n)=wbegin+n*deltaw
      conv(n)=0.0
      enddo
      do m=1,weigenv
      do k=1,noofscanpoints
!     print *,'m=',m,'k=',k
      conv(k)=conv(k)+IRint(m)/((w1(k)-wavenr(m))**2+mygamma**2)
!     print *,'w1=',w1(k),' conv(k)=',conv(k)
      enddo
      enddo
      
      do k=1,noofscanpoints
      write(*,*) w1(k),conv(k)
      enddo
      
      return
      end subroutine

[ Last edited by snoopyzhao on 2010-5-16 at 16:10 ]
赞一下(1人) 回复此楼
7楼2010-05-16 08:53:12
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
这个可以手工输入相关的参数：输入文件名，输出文件名，起始波数和终止波数
CODE:
      program CONVOLUTE
      implicit none
      integer arbitrary
      parameter(arbitrary=3500)
      double precision wavenr(arbitrary),IRint(arbitrary)
      integer weigenv
!     wavenumber start and finish
      double precision wbegin,wend
      character*80 input, output
      
      write(*,'(a,$)') 'input file name: '
      read(*, '(a)') input
      write(*,'(a,$)') 'output file name: '
      read(*, '(a)') output
      write(*,'(a,$)') 'start of wavenumber: '
      read(*,*) wbegin
      write(*,'(a,$)') 'end of wavenumber: '
      read(*,*) wend
      
      call readfreq(input,wavenr,IRint,weigenv,wbegin,wend)
      
      call convolution(output,wbegin,wend,wavenr,IRint,weigenv)
      stop
      end
      
      subroutine readfreq(fname,wavenr,IRint,weigenv,wbegin,wend)
!      read in eigenfrequencies and IR intensities
      implicit none
      integer arbitrary
      parameter(arbitrary=3500)
      double precision wavenr(arbitrary),IRint(arbitrary)
      double precision wbegin,wend
      character*80 fname
!      print *,'opening the file'
      integer i,reason,weigenv
      double precision wavetmp, inttmp
      open (unit=3,file=fname,status='OLD')
      i=0
!      print *,'entering do statement'
      do
      read(3,*,IOSTAT=reason) wavetmp,inttmp
      if (reason>0) then
        write(*,*) 'reason>0, i.e. somethings wrong'
        stop
      endif
      if (reason<0) then
        write(*,*) 'reason<0, reached the end of file'
        close(3)
        return
      endif
      if(wavetmp.gt.wbegin .and. wavetmp .lt. wend) then
        i=i+1
        wavenr(i)=wavetmp
        IRint(i)=inttmp
        write(*,*) 'eigenfreq: ',wavenr(i),' IR intensity: ',
     &             IRint(i),' i = ',i
        weigenv=i
      endif
      end do
      return
!      print *,'end of subroutine'
      end subroutine
      
      
      subroutine convolution(fname,wbegin,wend,wavenr,IRint,weigenv)
      implicit none
      integer bignumber,arbitrary
      parameter(bignumber=10000000,arbitrary=3500)
      double precision wbegin,wend,wavenr(arbitrary),IRint(arbitrary)
      integer noofscanpoints,n,m,k,weigenv
      parameter(noofscanpoints=100000)
      double precision deltaw,w1(bignumber),conv(bignumber)
      double precision mygamma,wave2ev
      character*80 fname
      parameter(wave2ev=8065.46)
!      mygamma=4.0d-3*wave2ev
      mygamma=10.0
!      mygamma=4.0d-3 in eV unit, convert to wavenumber by multiple wave2ev
      
      deltaw=(wend-wbegin)/dfloat(noofscanpoints)
      do n=1,noofscanpoints
      w1(n)=wbegin+n*deltaw
      conv(n)=0.0
      enddo
      do m=1,weigenv
      do k=1,noofscanpoints
!      print *,'m=',m,'k=',k
      conv(k)=conv(k)+IRint(m)/((w1(k)-wavenr(m))**2+mygamma**2)
!      print *,'w1=',w1(k),' conv(k)=',conv(k)
      enddo
      enddo
      
      open(unit=1,file=fname,status='unknown')
      do k=1,noofscanpoints
      write(1,*) w1(k),conv(k)
      enddo
      close(1)
      
      return
      end subroutine
赞一下 回复此楼
8楼2010-05-16 10:40:42
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

snoopyzhao

至尊木虫 (职业作家)
★
jjdg(金币+1):感谢参与！ 2010-05-16 10:56:03
sci_papers(金币+10):再奖励10个金币,其实程序中可以设置半峰宽,和起始波数和终止波数也可以.我现在就是批量处理文件.都在一定的半宽和波段下,如果需要其他的,我在修改这个程序即可.十分感谢 2010-05-16 14:36:04
我不懂这个专业的东西。看了一下 Swizard 的说明书，似乎需要指定半峰宽，但我似乎没有在原程序中看到……
赞一下(1人) 回复此楼
9楼2010-05-16 10:41:50
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

sci_papers

银虫 (正式写手)
引用回帖:
Originally posted by snoopyzhao at 2010-05-16 10:41:50:
我不懂这个专业的东西。看了一下 Swizard 的说明书，似乎需要指定半峰宽，但我似乎没有在原程序中看到……

再麻烦问下您,我看我程序的展宽语句怎么和Swizard 中的高斯或者洛伦茨展宽方程式不一样呀,难道我这个展宽程序不是那两个?之前别人告诉我说这个就是高斯展宽.可高斯展宽是

而我的程序
conv(k)=conv(k)+IRint(m)/((w1(k)-wavenr(m))**2+mygamma**2)
这明显不同哦.纳闷
赞一下 回复此楼
10楼2010-05-16 15:42:16
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
相关版块跳转 我要订阅楼主 sci_papers 的主题更新
121/2返回列表12下一页
普通表情 龙 兔 虎 猫 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 0856调剂 +7 刘梦微 2026-02-28 7/350 2026-03-02 14:11 by liyongv
[考研] 338求调剂 +3 18162027187 2026-03-02 3/150 2026-03-02 13:12 by houyaoxu
[考研] 材料与化工328求调剂 +3 。，。，。，。i 2026-03-02 3/150 2026-03-02 13:09 by houyaoxu
[考研] 化工270求调剂 +8 什么名字qwq 2026-03-02 8/400 2026-03-02 13:03 by houyaoxu
[考研] 291 求调剂 +3 化工2026届毕业� 2026-03-02 3/150 2026-03-02 12:55 by houyaoxu
[考研] 26考研报考西工大材料308分求调剂 +4 weizhong123 2026-03-01 4/200 2026-03-02 12:46 by 无际的草原
[基金申请] 面上模板改不了页边距吧？ +6 ieewxg 2026-02-25 7/350 2026-03-02 12:44 by stidwellNK
[考研] 哈工大计算机刘劼团队招生 +4 hit_aiot 2026-03-01 6/300 2026-03-02 11:53 by 一声问好
[考研] 求调剂 +3 熬夜的猫头鹰 2026-03-02 3/150 2026-03-02 11:45 by 刘兵
[考研] 化工专硕342，一志愿大连理工大学，求调剂 +6 kyf化工 2026-02-28 7/350 2026-03-02 10:56 by 无际的草原
[考研] 材料调剂 +6 爱擦汗的可乐冰 2026-02-28 7/350 2026-03-02 10:42 by Jy?
[考研] 275求调剂 +3 L-xin? 2026-03-01 6/300 2026-03-02 10:22 by 热情沙漠
[考研] 调剂 +3 13853210211 2026-03-02 4/200 2026-03-02 10:16 by 13853210211
[考研] 材料工程269求调剂 +3 白刺玫 2026-03-02 3/150 2026-03-02 09:25 by 一休哥FU
[考研] 材料化工调剂 +12 今夏不夏 2026-03-01 13/650 2026-03-01 23:32 by L135790
[考研] 一志愿中南大学理学化学 +4 15779376950 2026-03-01 5/250 2026-03-01 19:00 by Fff-1
[考研] 298求调剂 +9 人间唯你是清欢 2026-02-28 12/600 2026-03-01 14:23 by Ducount.Y
[考研] 317一志愿华南理工电气工程求调剂 +6 Soliloquy_Q 2026-02-28 11/550 2026-03-01 11:14 by 歌liekkas
[论文投稿] 求助coordination chemistry reviews 的写作模板 10+3 ljplijiapeng 2026-02-27 4/200 2026-03-01 09:07 by babero
[考研] 085600材料工程一志愿中科大总分312求调剂 +8 吃宵夜1 2026-02-28 10/500 2026-02-28 20:27 by L135790
信息提示
关闭
请填处理意见
关闭