1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
SUBROUTINE DATIN
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
CHARACTER NUMBRS(0:9)*1, PARTYP(25)*5, FILES*64, DUMMY*50,
1 KEYWRD*241, TEXT*50, TXTNEW*50, ELEMNT(107)*2,
2 GETNAM*80
COMMON /ATHEAT/ ATHEAT
1 /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
2 NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
3 NCLOSE,NOPEN,NDUMY,FRACT
COMMON /ATOMIC/ EISOL(107),EHEAT(107)
COMMON /KEYWRD/ KEYWRD
DIMENSION IJPARS(5,1000), PARSIJ(1000)
SAVE NUMBRS, PARTYP, ELEMNT
DATA NUMBRS/' ','1','2','3','4','5','6','7','8','9'/
DATA PARTYP/'USS ','UPP ','UDD ','ZS ','ZP ','ZD ',
1 'BETAS','BETAP','BETAD','GSS ','GSP ','GPP ','GP2 ',
2 'HSP ','AM1 ','EXPC ','GAUSS','ALP ','GSD ','GPD ',
3 'GDD ','FN1 ','FN2 ','FN3 ','ORB '/
DATA (ELEMNT(I),I=1,107)/'H ','HE',
1 'LI','BE','B ','C ','N ','O ','F ','NE',
2 'NA','MG','AL','SI','P ','S ','CL','AR',
3 'K ','CA','SC','TI','V ','CR','MN','FE','CO','NI','CU',
4 'ZN','GA','GE','AS','SE','BR','KR',
5 'RB','SR','Y ','ZR','NB','MO','TC','RU','RH','PD','AG',
6 'CD','IN','SN','SB','TE','I ','XE',
7 'CS','BA','LA','CE','PR','ND','PM','SM','EU','GD','TB','DY',
8 'HO','ER','TM','YB','LU','HF','TA','W ','RE','OS','IR','PT',
9 'AU','HG','TL','PB','BI','PO','AT','RN',
1 'FR','RA','AC','TH','PA','U ','NP','PU','AM','CM','BK','CF','XX',
2 'FM','MD','CB','++','+','--','-','TV'/
I=INDEX(KEYWRD,'EXTERNAL=')+9
J=INDEX(KEYWRD(I:),' ')+I-1
FILES=GETNAM(KEYWRD(I:J))
WRITE(6,'(//5X,'' PARAMETER TYPE ELEMENT PARAMETER'')')
OPEN(14,STATUS='UNKNOWN',FILE=FILES)
I=0
NPARAS=0
10 READ(14,'(A40)',ERR=90,END=90)TEXT
NPARAS=NPARAS+1
IF(TEXT.EQ.' ')GOTO 90
IF(INDEX(TEXT,'END').NE.0)GOTO 90
ILOWA = ICHAR('a')
ILOWZ = ICHAR('z')
ICAPA = ICHAR('A')
************************************************************************
DO 20 I=1,50
ILINE=ICHAR(TEXT(I:I))
IF(ILINE.GE.ILOWA.AND.ILINE.LE.ILOWZ) THEN
TEXT(I:I)=CHAR(ILINE+ICAPA-ILOWA)
ENDIF
20 CONTINUE
************************************************************************
IF(INDEX(TEXT,'END') .NE. 0) GOTO 90
DO 30 J=1,25
IF(J.GT.21) THEN
IT=INDEX(TEXT,'FN')
TXTNEW = TEXT(1:IT+2)
IF(INDEX(TXTNEW,PARTYP(J)) .NE. 0) GOTO 40
ENDIF
IF(INDEX(TEXT,PARTYP(J)) .NE. 0) GOTO 40
30 CONTINUE
WRITE(6,'('' FAULTY LINE:'',A)')TXTNEW
WRITE(6,'('' FAULTY LINE:'',A)')TEXT
WRITE(6,'('' NAME NOT FOUND'')')
STOP
40 IPARAM=J
IF(IPARAM.GT.21) THEN
I=INDEX(TEXT,'FN')
KFN=READA(TEXT,I+3)
ELSE
KFN=0
I=INDEX(TEXT,PARTYP(J))
ENDIF
K=INDEX(TEXT(I:),' ')+1
DUMMY=TEXT(K:)
TEXT=DUMMY
DO 50 J=1,107
50 IF(INDEX(TEXT,' '//ELEMNT(J)) .NE. 0) GOTO 60
WRITE(6,'('' ELEMENT NOT FOUND '')')
WRITE(6,*)' FAULTY LINE: "'//TEXT//'"'
STOP
60 IELMNT=J
PARAM=READA(TEXT,INDEX(TEXT,ELEMNT(J)))
DO 70 I=1,LPARS
IF(IJPARS(1,I).EQ.KFN.AND.IJPARS(2,I).EQ.IELMNT.AND.
1IJPARS(3,I).EQ.IPARAM) GOTO 80
70 CONTINUE
LPARS=LPARS+1
I=LPARS
80 IJPARS(1,I)=KFN
IJPARS(2,I)=IELMNT
IJPARS(3,I)=IPARAM
PARSIJ(I)=PARAM
GOTO 10
90 CONTINUE
IF(NPARAS.EQ.0)THEN
WRITE(6,'(//10X,A)')' EXTERNAL PARAMETERS FILE MISSING OR EMPTY
1'
STOP
ENDIF
CLOSE(14)
DO 120 J=1,107
DO 110 K=1,25
DO 100 I=1,LPARS
IPARAM=IJPARS(3,I)
KFN=IJPARS(1,I)
IELMNT=IJPARS(2,I)
IF(IPARAM.NE.K) GOTO 100
IF(IELMNT.NE.J) GOTO 100
PARAM=PARSIJ(I)
IF(KFN.NE.0)THEN
WRITE(6,'(10X,A6,11X,A2,F17.6)')
1PARTYP(IPARAM)(:3)//NUMBRS(KFN)//' ',
2ELEMNT(IELMNT),PARAM
ELSE
WRITE(6,'(10X,A6,11X,A2,F17.6)')
1PARTYP(IPARAM)//NUMBRS(KFN),
2ELEMNT(IELMNT),PARAM
ENDIF
CALL UPDATE(IPARAM,IELMNT,PARAM,KFN)
100 CONTINUE
110 CONTINUE
120 CONTINUE
CALL MOLDAT(1)
CALL CALPAR
ATHEAT=0.D0
ETH=0.D0
DO 130 I=1,NUMAT
NI=NAT(I)
ATHEAT=ATHEAT+EHEAT(NI)
130 ETH=ETH+EISOL(NI)
ATHEAT=ATHEAT-ETH*23.061D0
RETURN
END
|
