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
|
SUBROUTINE INITSV (INDEPS)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
COMMON / SOLV / FEPSI,RDS,DISEX2,NSPA,NPSX,NPS2X,NDEN,
1 COSURF(3,LENABC), SRAD(NUMATM),ABCMAT(LENAB2),
2 TM(3,3,NUMATM),QDEN(MAXDEN),DIRTM(3,NPPA),
3 BH(LENABC)
4 /SOLVI/ IATSP(LENABC+1),NAR(LENABC), NNX(2,NUMATM)
x /SOLVPS/ NPS, NPS2
COMMON /DIRVEC/ DIRVEC(3,NPPA), NN(3,NUMATM)
COMMON /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
1 NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
2 NCLOSE,NOPEN,NDUMY,FRACT
DIMENSION RVDW(53), USEVDW(53), DIRSM(3,NPPA), DIRSMH(3,NPPA/3)
COMMON /CHANEL/ IFILES(30)
EQUIVALENCE(IW,IFILES(6))
EQUIVALENCE (ABCMAT(1),DIRSM)
EQUIVALENCE(DIRSMH, ABCMAT(3*NPPA+1))
CHARACTER KEYWRD*241, ELEMNT(53)*2
COMMON /KEYWRD/ KEYWRD
DATA RVDW /1.08D0, 1.D0, 1.80D0, 999.D0, 999.D0, 1.53D0, 1.48D0,
1 1.36D0, 1.30D0, 999.D0, 2.30D0, 999.D0, 2.05D0, 2.10D0,
2 1.75D0, 1.70D0, 1.65D0, 999.D0, 2.80D0, 2.75D0, 999.D0,
3 999.D0, 999.D0, 999.D0, 999.D0, 999.D0, 999.D0, 999.D0,
4 999.D0, 999.D0, 999.D0, 999.D0, 999.D0, 999.D0, 1.80D0,
5 999.D0, 999.D0, 999.D0, 999.D0, 999.D0, 999.D0, 999.D0,
6 999.D0, 999.D0, 999.D0, 999.D0, 999.D0, 999.D0, 999.D0,
7 999.D0, 999.D0, 999.D0, 2.05D0 /
DATA ELEMNT/'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 '/
DO 10 I=1,53
10 USEVDW(I)=RVDW(I)
EPSI=READA(KEYWRD,INDEPS)
FEPSI=(EPSI-1.D0)/(EPSI+0.5D0)
NPS=0
IW=6
NDEN=3*NORBS-2*NUMAT
MAXNPS=SQRT(2*LENAB2+0.251)-NDEN-0.5
MAXNPS=MIN(MAXNPS,LENABC)
* WRITE(IW,*) 'MAXIMUM NUMBER OF SEGMENTS ALLOWED:',MAXNPS
IF ((NDEN*(NDEN+1))/2 .GT. LENAB2) THEN
WRITE(IW,*) 'PARAMETER LENABC IS TOO SMALL FOR THIS SYSTEM'
STOP 'PARAMETER LENABC IS TOO SMALL FOR THIS SYSTEM'
ENDIF
RSOLV=1.D0
INRSOL=INDEX(KEYWRD,'RSOLV=')
IF (INRSOL .NE. 0) THEN
RSOLV=READA(KEYWRD,INRSOL)
END IF
IF (RSOLV .LT. 0.) STOP ' RSOLV MUST NOT BE NEGATIVE'
DELSC=RSOLV
INDELS=INDEX(KEYWRD,'DELSC=')
IF (INDELS .NE. 0) THEN
DELSC=READA(KEYWRD,INDELS)
END IF
IF (DELSC .LT. 0.1D0) WRITE(IW,*) ' DELSC TOO SMALL: SET TO 0.1'
IF (DELSC .GT. RSOLV+0.5D0) STOP ' DELSC UNREASONABLY LARGE'
RDS=MAX(DELSC,0.1D0)
DISEX=2.D0
INDISE=INDEX(KEYWRD,'DISEX=')
IF (INDISE .NE. 0) THEN
DISEX=READA(KEYWRD,INDISE)
END IF
DO 20 I=1,NUMAT
IAT=NAT(I)
IF (IAT .GT. 53) THEN
STOP 'MISSING VAN DER WAALS RADIUS'
ELSE
AVDW=USEVDW(IAT)
IF (AVDW .GT. 10.D0) STOP 'MISSING VAN DER WAALS RADIUS'
END IF
SRAD(I)=AVDW+RSOLV
20 CONTINUE
NSPA=60
IF(INDEX(KEYWRD,'NSPA=').NE.0)
1 NSPA=NINT(READA(KEYWRD,INDEX(KEYWRD,'NSPA')))
X0=LOG(NSPA*0.1D0-0.199999D0)
Z3=LOG(3.D0)
Z4=LOG(4.D0)
I4=INT(X0/Z4)
NPS2=0
DO 7 I=0,I4
X=X0-I*Z4
N=3**INT(X/Z3)*4**I
7 IF(N.GT.NPS2)NPS2=N
NPS=NPS2/3
IF(MOD(NPS2,3).NE.0)NPS=NPS2/4
NPS2=10*NPS2+2
NPS=MAX(12,NPS*10+2)
CALL DVFILL(NPS2,DIRSM)
CALL DVFILL(NPS,DIRSMH)
NPS=-NPS
DISEX2=(4*(1.5D0+RSOLV-RDS)*DISEX)**2/NSPA
CALL DVFILL(NPPA,DIRVEC)
RETURN
END
|
