24小时热门版块排行榜    

Znn3bq.jpeg
查看: 4308  |  回复: 25
【奖励】 本帖被评价17次,作者qli0218增加金币 13.25
当前只显示满足指定条件的回帖,点击这里查看本话题的所有回帖

qli0218

木虫 (小有名气)


[资源] 【分享】DOSCAR数据整理小程序

我在作DOS图的时候一点点导数据确实很麻烦,于是自己编了个小程序,在我笔记本里的F90编的,和大家分享一下,要是有什么建议尽管提,我在Polish一下。
我算的是一个原子的DOS是分1000行的,取自己感兴趣的一组或多组轨道分析,自动将0点调节为费米能级。输出的文件就可以直接导入到Origion里作图了,我暂时没用到自旋,所以就没考虑,也没计算,两列里直接取一列了。

希望大家指点

程序:
PROGRAM DOSCAR
IMPLICIT NONE
REAL::R,E,E1
INTEGER::J,I,N,N1,NUM
REAL,DIMENSION(0:18)::X
OPEN(1,FILE='DOSCAR',STATUS='OLD',ACCESS='SEQUENTIAL',FORM='FORMATTED',ACTION='READ')
OPEN(10,FILE='DOSE.DAT',STATUS='REPLACE',ACCESS='SEQUENTIAL',FORM='FORMATTED')
READ(1,'(I4)'),J
DO I=1,4
  READ(1,*)
END DO
READ(1,'(42X,F11.8)'),E
WRITE(*,'("系统中有元素",I2,"个,费米能级为",F9.5)')J,E
!WRITE(10,*),J,E
DO I=1,1001
  READ(1,*)
END DO
PRINT*,'请输入要分析的原子序数:'
READ(*,*),E1
PRINT*,'请输入要分析的轨道:(s轨道(1);p轨道(2);d轨道(4)及合轨道(数字加和))'
READ*,N1
N=1
DO
  NUM=0
  DO J=1,1000
    READ(1,'(4X,F7.3,18(2X,E10.4E2))'),(X(I),I=0,18)
    X(0)=X(0)-E
    IF(N==E1)  THEN
        SELECT CASE(N1)
        CASE (1) !S
          WRITE(10,'(1X,F7.3,1(2X,F7.4))')X(0),X(1)
        CASE (2) !P
          WRITE(10,'(1X,F7.3,3(2X,F7.4))')X(0),(X(I),I=3,8,2)
        CASE (3) !S+P
          WRITE(10,'(1X,F7.3,4(2X,F7.4))')X(0),(X(I),I=1,8,2)
        CASE (4) !D
          WRITE(10,'(1X,F7.3,5(2X,F7.4))')X(0),(X(I),I=9,18,2)
        CASE (5) !S+D
          WRITE(10,'(1X,F7.3,6(2X,F7.4))')X(0),X(1),(X(I),I=9,18,2)
        CASE (6) !P+D
          WRITE(10,'(1X,F7.3,8(2X,F7.4))')X(0),(X(I),I=3,18,2)
        CASE (7) !S+P+D
          WRITE(10,'(1X,F7.3,9(2X,F7.4))')X(0),(X(I),I=1,18,2)
        END SELECT
        NUM=1
        END IF
  END DO
  IF(NUM==0) READ(1,*)
  IF(NUM==1) EXIT
  N=N+1
END DO
CLOSE(1)
CLOSE(10)
END



[ Last edited by mazuju028 on 2010-11-28 at 22:52 ]
回复此楼

» 收录本帖的淘帖专辑推荐

vasp 程序与脚本 计算-vasp

» 猜你喜欢

» 本主题相关价值贴推荐,对您同样有帮助:

已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

★★★★★ 五星级,优秀推荐

超强~~~感谢~~~先保存下来,慢慢学~
23楼2011-05-19 08:40:46
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
查看全部 26 个回答

qli0218

木虫 (小有名气)


自己坐沙发了,欢迎大家提意见,Copy完了别忘评分,嘿嘿
2楼2009-03-24 07:00:18
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

hdh912

金虫 (正式写手)


★★★ 三星级,支持鼓励

虽然不用VASP 鼓励感谢下
3楼2009-03-24 15:07:01
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖

hakuna

木虫 (知名作家)


★★★★★ 五星级,优秀推荐

*****鼓励原创*****
6楼2009-03-27 21:22:37
已阅   回复此楼   关注TA 给TA发消息 送TA红花 TA的回帖
☆ 无星级 ★ 一星级 ★★★ 三星级 ★★★★★ 五星级
普通表情 高级回复 (可上传附件)
最具人气热帖推荐 [查看全部] 作者 回/看 最后发表
[考研] 295分求调剂 +4 ?要上岸? 2026-04-17 4/200 2026-04-17 16:46 by wutongshun
[教师之家] 山东双非院校考核超级无底线,领导幸灾乐祸,教师遭殃恐 +4 qut2026 2026-04-11 8/400 2026-04-17 16:10 by 会飞的猪157
[考研] 322求调剂 +6 tekuzu 2026-04-17 6/300 2026-04-17 13:48 by Espannnnnol
[考研] 291求调剂 +9 关忆北. 2026-04-14 9/450 2026-04-16 22:49 by cfdbai
[考研] 294求调剂 +14 淡然654321 2026-04-15 14/700 2026-04-16 21:01 by lpl364211
[考研] 一志愿A区211,22408 321求调剂 +6 随心所欲☆ 2026-04-15 7/350 2026-04-15 21:45 by lbsjt
[考研] 通信工程求调剂!!! +6 zlb770521 2026-04-14 6/300 2026-04-15 20:00 by 学员JpLReM
[考研] 0854调剂 +13 长弓傲 2026-04-12 16/800 2026-04-15 13:45 by fenglj492
[考研] 化工学硕294分,求导师收留 +32 yzyzx 2026-04-12 36/1800 2026-04-14 17:45 by lhj2009
[考研] 考研调剂 +13 长弓傲 2026-04-13 14/700 2026-04-14 14:44 by zs92450
[考研] 297求调剂 +23 ORCHID1 2026-04-10 26/1300 2026-04-14 13:52 by 陈皮皮
[考研] 085600材料与化工329分求调剂 +24 叶zilin 2026-04-13 25/1250 2026-04-14 09:20 by 试管破裂
[考研] 305求调剂 +8 玛卡巴卡boom 2026-04-11 8/400 2026-04-14 09:04 by pengliang8036
[考研] 300分求调剂 (085501机械专硕,本科扬大) +9 xu@841019 2026-04-11 10/500 2026-04-14 08:48 by 木木mumu~
[考研] 考研求调剂 +12 子木呐 2026-04-12 13/650 2026-04-14 01:19 by 王珺璞
[考研] 2026硕士调剂_能动_河南农业大学 +4 河南农业大学-能 2026-04-12 4/200 2026-04-13 22:01 by bljnqdcc
[考研] +10 李多米lee. 2026-04-12 11/550 2026-04-12 22:58 by yuyin1233
[考研] 调剂求助 +6 果然有我 2026-04-11 7/350 2026-04-11 16:22 by 明月此时有
[考研] 求调剂 +3 胃痉挛累了 2026-04-11 5/250 2026-04-11 14:13 by luhong1990
[考研] 0854调剂 +5 音像店听花鼓戏 2026-04-10 5/250 2026-04-11 10:49 by qingpingzhu
信息提示
请填处理意见