SUBROUTINE slth(XD,VXD) c tag='LSTH PES of H2+H. [P. Siegbahn, B. Liu, D.G. Truhlar and C.J.-2345678 c $Horowitz, JCP 68, 2457(1978)' c XD refers to the three hh distances. IMPLICIT REAL*8 (A-H,O-Z) DIMENSION XD(3) COMMON/VCOM/C,A,A1,F,FNS,F1,F2,F3,AN1,AN2,AN3,AN4,B1,B2,B3,W1, 1 W2,W3,D1,D2,D3,D4,XL1,XL2 DIMENSION X(3),S1(3),S2(3),S3(3) X(1)=SNGL(XD(1)) X(2)=SNGL(XD(2)) X(3)=SNGL(XD(3)) C E LLONDON C *************************************************************** C TYPE 2 2 FORMAT('ENTERING SLTH') EF1=EXP(F*X(1)) EF2=EXP(F*X(2)) EF3=EXP(F*X(3)) X21=X(1)*X(1) X22=X(2)*X(2) X23=X(3)*X(3) T1=C*(A+X(1)+A1*X21)/EF1 T2=C*(A+X(2)+A1*X22)/EF2 T3=C*(A+X(3)+A1*X23)/EF3 CALL VH2(X,S1,S2,S3) XQ1=S1(1)+T1 XQ2=S2(1)+T2 XQ3=S3(1)+T3 XJ1=S1(1)-T1 XJ2=S2(1)-T2 XJ3=S3(1)-T3 XQ=(XQ1+XQ2+XQ3)/2. XJ=SQRT(((XJ1-XJ2)**2+(XJ2-XJ3)**2+(XJ3-XJ1)**2)/8.) ELOND=XQ-XJ C ENS WNT=(X(1)-X(2))*(X(2)-X(3))*(X(3)-X(1)) WN=ABS(WNT) WN2=WN*WN WN3=WN2*WN WN4=WN3*WN WN5=WN4*WN R=X(1)+X(2)+X(3) R2=R*R R3=R2*R C EXNS=EXP(FNS*R3) C ENS=(AN1*WN2+AN2*WN3+AN3*WN4+AN4*WN5)/EXNS EXNS=EXP(-FNS*R3) ENS=(AN1*WN2+AN2*WN3+AN3*WN4+AN4*WN5)*EXNS CCCCCC CCCCCC NONLINEAR CORRECTIONS CCCCCC COS=(X21+X22+X23)/2. COS1=(X21-COS)/X(2)/X(3) COS2=(X22-COS)/X(1)/X(3) COS3=(X23-COS)/X(1)/X(2) WB=COS1+COS2+COS3+1. WB2=WB*WB WB3=WB2*WB WB4=WB3*WB EXF1=EXP(-F1*R) EXF2=EXP(-F2*R2) EXF3=EXP(-F3*R) EB1T=(B1+B2*R)*EXF1 EB3T=(XL1+XL2*R2)*EXF3 EB1=WB*(EB1T+EB3T) EB2=(WB2*W1+WB3*W2+WB4*W3)*EXF2 EQ=(X(1)-X(2))**2+(X(2)-X(3))**2+(X(3)-X(1))**2 RI=1./X(1)+1./X(2)+1./X(3) EB4A=WB*D1*EXF1+WB2*D2*EXF2 EB4B=D3*EXF1+D4*EXF2 EB4=EB4A*RI+EB4B*WB*EQ E=ELOND+ENS+EB1+EB2+EB4 E=E*627.510 VX=E/23.06+4.7466 VXD=DBLE(VX) RETURN END C ***************************************************************** SUBROUTINE VH2(X,S1,S2,S3) IMPLICIT REAL*8 (A-H,O-Z) COMMON/POTCOM/C6,C8,RKW(87),EKW(87),WKW(87) DIMENSION X(3),S1(3),S2(3),S3(3) IF (X(1).GT.10.) CALL VBIGR(X(1),S1) IF (X(1).GT.10.) GO TO 2 CALL SPLID2(87,RKW,EKW,WKW,1,X(1),S1) 2 IF (X(2).GT.10.) CALL VBIGR(X(2),S2) IF (X(2).GT.10.) GO TO 3 CALL SPLID2(87,RKW,EKW,WKW,1,X(2),S2) 3 IF(X(3).GT.10.) CALL VBIGR(X(3),S3) IF(X(3).GT.10.) RETURN CALL SPLID2(87,RKW,EKW,WKW,1,X(3),S3) RETURN END C ************************************************************* SUBROUTINE VBIGR(X,S) IMPLICIT REAL*8 (A-H,O-Z) COMMON/POTCOM/C6,C8,RKW(87),EKW(87),WKW(87) DIMENSION S(3) X2=X*X X3=X2*X X6=X3*X3 C8A=C8/X2 S(1)=-(C6+C8A)/X6 S(2)=(C6*6.+C8A*8.)/X6/X RETURN END C ************************************************************** SUBROUTINE SPLID2(N,X,F,W,IJ,Y,TAB) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION X(3),F(3),W(3),TAB(3) IF(Y-X(1))10,10,20 10 I=1 GO TO 30 20 IF(Y-X(N))15,40,40 40 I=N-1 GO TO 30 15 I=0 DO 25 K=1,N IF(X(K).GT.Y) GO TO 30 25 I=I+1 30 MI=(I-1)*IJ+1 KI=MI+IJ FLK=X(I+1)-X(I) A=(W(MI)*(X(I+1)-Y)**3 + W(KI)*(Y-X(I))**3)/(6.*FLK) B=(F(KI)/FLK-W(KI)*FLK/6.)*(Y-X(I)) C=(F(MI)/FLK-FLK*W(MI)/6.)*(X(I+1)-Y) TAB(1)=A+B+C A=(W(KI)*(Y-X(I))**2-W(MI)*(X(I+1)-Y)**2)/(2.*FLK) B=(F(KI)-F(MI))/FLK C=FLK*(W(MI)-W(KI))/6. TAB(2)=A+B+C TAB(3)=(W(MI)*(X(I+1)-Y)+W(KI)*(Y-X(I)))/FLK RETURN END BLOCK DATA IMPLICIT REAL*8 (A-H,O-Z) COMMON/POTCOM/C6,C8,RKW(87),EKW(87),WKW(87) COMMON/VCOM/C,A,A1,F,FN,FB1,FB2,FB3,XN1,XN2,XN3,XN4,B1,B2, 1 B3,G1,G2,G3,D1,D2,D3,D4,XL1,XL2 DATA C6,C8/6.89992032,219.9997304/ DATA C,A,A1,F/-1.2148730613,-1.514663474,-1.46,2.088442/ DATA FN,XN1,XN2,XN3,XN4/.0035,.0012646477,-.0001585792, 1 .0000079707,-.0000001151/ DATA FB1,B1,B2/.52,3.0231771503,-1.08935219/ DATA FB2,G1,G2,G3/.052,1.7732141742,-2.0979468223,-3.9788502171/ DATA D1,D2,D3,D4/.4908116374,-.8718696387,.1612118092,-.127373 1 11045/ DATA FB3,XL2,XL1/.79,.9877930913,-13.3599568553/ DATA (RKW(I),I=1,40)/ 1.400000000E+00,.4500000000E+00,.5000000000E+00,.550000000E+00, 2.600000000E+00,.6500000000E+00,.7000000000E+00,.750000000E+00, 3.800000000E+00,.9000000000E+00,.1000000000E+01,.110000000E+01, 4.1200000000E+01,.1300000000E+01,.1350000000E+01,.1390000000E+01, 5.1400000000E+01,.1401000010E+01,.1401099990E+01,.1410000000E+01, 6.1450000000E+01,.1500000000E+01,.1600000000E+01,.1700000000E+01, 7.1800000000E+01,.1900000000E+01,.2000000000E+01,.2100000000E+01, 8.2200000000E+01,.2300000000E+01,.2400000000E+01,.2500000000E+01, 9.2600000000E+01,.2700000000E+01,.2800000000E+01,.2900000000E+01, 9.3000000000E+01,.3100000000E+01,.3200000000E+01,.3300000000E+01/ DATA(RKW(I),I=41,87)/ 1.3400000000E+01,.3500000000E+01,.3600000000E+01,.3700000000E+01, 2.3800000000E+01,.3900000000E+01,.4000000000E+01,.4100000000E+01, 3.4200000000E+01,.4300000000E+01,.4400000000E+01,.4500000000E+01, 4.4600000000E+01,.4700000000E+01,.4800000000E+01,.4900000000E+01, 5.5000000000E+01,.5100000000E+01,.5200000000E+01,.5300000000E+01, 6.5400000000E+01,.5500000000E+01,.5600000000E+01,.5700000000E+01, 7.5800000000E+01,.5900000000E+01,.6000000000E+01,.6100000000E+01, 8.6200000000E+01,.6300000000E+01,.6400000000E+01,.6500000000E+01, 9.6600000000E+01,.6700000000E+01,.6800000000E+01,.6900000000E+01, 9.7000000000E+01,.7200000000E+01,.7400000000E+01,.7600000000E+01, 1.7800000000E+01,.8000000000E+01,.8250000000E+01,.8500000000E+01, 2.9000000000E+01,.9500000000E+01,.1000000000E+02/ DATA(EKW(I),I=1,40)/ 1.879796188E+00,.649071056E+00,.473372447E+00,.337228924E+00, 2.230365628E+00,.145638432E+00,.779738117E-01,.236642733E-01, 3-.200555771E-01,-.836421044E-01,-.124538356E+00,-.150056027E+00, 4-.164934012E+00,-.172345701E+00,-.173962500E+00,-.174451499E+00, 5-.174474200E+00,-.174474400E+00,-.174474400E+00,-.174459699E+00, 6-.174055600E+00,-.172853502E+00,-.168579707E+00,-.162456813E+00, 7-.155066822E+00,-.146849432E+00,-.138131041E+00,-.129156051E+00, 8-.120123163E+00,-.111172372E+00,-.102412583E+00,-.939271927E-01, 9-.857809026E-01,-.780163108E-01,-.706699181E-01,-.637640270E-01, 9-.573117349E-01,-.513184414E-01,-.457831464E-01,-.407002530E-01/ DATA(EKW(I),I=41,87)/ 1-.360577581E-01,-.318401624E-01,-.280271683E-01,-.245977718E-01, 2-.215296753E-01,-.187966785E-01,-.163688812E-01,-.142246837E-01, 3-.123370858E-01,-.106809878E-01,-.923028934E-02,-.796819096E-02, 4-.687029215E-02,-.591779314E-02,-.509229414E-02,-.437819496E-02, 5-.376259562E-02,-.323089623E-02,-.277399691E-02,-.237999732E-02, 6-.204229767E-02,-.175209799E-02,-.150299828E-02,-.128989853E-02, 7-.110689874E-02,-.949798920E-03,-.814999069E-03,-.700199190E-03, 8-.602999302E-03,-.516199400E-03,-.446599479E-03,-.386399548E-03, 9-.332799617E-03,-.290599668E-03,-.246599722E-03,-.215399753E-03, 9-.188899784E-03,-.143399836E-03,-.108599875E-03,-.867998994E-04, 1-.681999214E-04,-.527999393E-04,-.403999540E-04,-.313999636E-04, 2-.184999787E-04,-.120999861E-04,-.909998949E-05/ DATA(WKW(I),I=1,40)/ 1.308019605E+02,.214419954E+02,.154937452E+02,.115151545E+02, 2.871827707E+01,.673831756E+01,.527864661E+01,.419929947E+01, 3.333940643E+01,.219403463E+01,.149861953E+01,.103863661E+01, 4.730647471E+00,.518552387E+00,.441110777E+00,.383461006E+00, 5.373946396E+00,.358559402E+00,.372215569E+00,.356670198E+00, 6.312744133E+00,.261523038E+00,.180817537E+00,.124665543E+00, 7.807794104E-01,.486562494E-01,.251952492E-01,.452257820E-02, 8-.854560161E-02,-.196001146E-01,-.276538076E-01,-.344244662E-01, 9-.381080935E-01,-.421628973E-01,-.441600287E-01,-.454966841E-01, 9-.460129217E-01,-.458513118E-01,-.453815149E-01,-.440623159E-01/ DATA(WKW(I),I=41,87)/ 1-.426089183E-01,-.404417185E-01,-.383839285E-01,-.361823035E-01, 2-.336666088E-01,-.302110314E-01,-.286090554E-01,-.255125522E-01, 3-.233005599E-01,-.201850499E-01,-.191990995E-01,-.161784216E-01, 4-.146071006E-01,-.126330766E-01,-.110605069E-01,-.996481997E-02, 5-.818014482E-02,-.765454189E-02,-.608163613E-02,-.575887028E-02, 6-.466284400E-02,-.408972107E-02,-.363824334E-02,-.295728079E-02, 7-.259261281E-02,-.221225014E-02,-.193837141E-02,-.203425060E-02, 8-.484614204E-03,-.226728547E-02,-.766232140E-03,-.307779418E-03, 9-.196264565E-02,+.131836977E-02,-.223083472E-02,-.750220030E-04, 9-.289074004E-03,-.220265690E-03,-.434861384E-03,+.971346041E-05, 1-.839919101E-04,-.153745275E-03,-.369227366E-04,-.249634065E-04, 2-.290482724E-04,-.148433244E-04,+.682166282E-05/ END c **