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

24小时热门版块排行榜    

小木虫论坛-学术科研互动平台 » 计算模拟区 » 程序语言 » Fortran » 【求助】帮忙改写展宽程序
51/1返回列表
查看: 1509  |  回复: 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

至尊木虫 (职业作家)
★
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的回帖
查看全部 12 个回答

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的回帖
查看全部 12 个回答
普通表情 龙 兔 虎 猫 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 0857调剂 +4 一ll半 2026-02-28 5/250 2026-03-02 02:33 by 908055542
[考研] 279求调剂 +3 dua1 2026-03-01 4/200 2026-03-02 00:23 by 大脸蛋子
[考研] 284求调剂 +8 天下熯 2026-02-28 8/400 2026-03-02 00:15 by 暮雨星晴
[考研] 求调剂 +5 yunziaaaaa 2026-03-01 6/300 2026-03-01 23:57 by ccp273206157
[考研] 0805总分292，求调剂 +7 幻想之殇 2026-03-01 7/350 2026-03-01 21:22 by 公瑾逍遥
[考研] 化工299分求调剂 一志愿985落榜 +5 嘻嘻(*^ω^*) 2026-03-01 5/250 2026-03-01 19:47 by 无际的草原
[考研] 291分工科求调剂 +9 science饿饿 2026-03-01 10/500 2026-03-01 18:55 by 18137688336
[考研] 材料学调剂 +9 提神豆沙包 2026-02-28 11/550 2026-03-01 18:15 by ms629
[考研] 281求调剂 +4 2026计算机_诚心 2026-03-01 7/350 2026-03-01 17:20 by 2026计算机_诚心
[考研] 0856材料求调剂 +4 麻辣鱿鱼 2026-02-28 4/200 2026-03-01 16:51 by caszguilin
[考研] 化工专硕342，一志愿大连理工大学，求调剂 +3 kyf化工 2026-02-28 4/200 2026-03-01 16:49 by yywzz
[考研] 285求调剂 +8 满头大汗的学生 2026-02-28 8/400 2026-03-01 16:47 by caszguilin
[考研] 求调剂 +6 repeatt?t 2026-02-28 6/300 2026-03-01 14:37 by Sakura绘
[考研] 295复试调剂 +3 简木ChuFront 2026-03-01 3/150 2026-03-01 14:27 by zzxw520th
[考研] 317一志愿华南理工电气工程求调剂 +6 Soliloquy_Q 2026-02-28 11/550 2026-03-01 11:14 by 歌liekkas
[考研] 寻找调剂 +4 LYidhsjabdj 2026-02-28 4/200 2026-03-01 10:56 by sunny81
[考博] 博士自荐 +4 kkluvs 2026-02-28 4/200 2026-03-01 10:19 by 馥安馥安
[论文投稿] Optics letters投稿被拒求助 30+3 luckyry 2026-02-26 4/200 2026-03-01 09:06 by babero
[考研] 307求调剂 +4 73372112 2026-02-28 6/300 2026-03-01 00:04 by ll247
[考研] 264求调剂 +3 巴拉巴拉根556 2026-02-28 3/150 2026-02-28 21:31 by gaoxiaoniuma
信息提示
关闭
请填处理意见
关闭