24小时热门版块排行榜

返回列表

【奖励】本帖被评价17次，作者qli0218增加金币 13.25 个

当前只显示满足指定条件的回帖，点击这里查看本话题的所有回帖

qli0218

木虫 (小有名气)

应助: 0 (幼儿园)
贵宾: 0.008
金币: 1998.9
帖子: 295
在线: 179.8小时
虫号: 555287

[资源] 【分享】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 ]

回复此楼