69 lines
2.4 KiB
Fortran
69 lines
2.4 KiB
Fortran
SUBROUTINE VRTP(IDERIV,R,P)
|
|
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
|
|
DIMENSION P(1)
|
|
C
|
|
C *****************************************************************
|
|
C * IF POTENTIAL IS --NOT-- EXPANDED IN ANGULAR FUNCTIONS, I.E., *
|
|
C * MXSYM.LE.0, THIS ROUTINE MUST SUPPLY THE POTENTIAL AND *
|
|
C * ITS 1ST AND 2ND DERIVATIVE (IDERIV=0,1,2, RESPECTIVELY). *
|
|
C * EVALUATE POTENTIAL AT ANGLES SPECIFIED IN COMMON /ANGLES/ *
|
|
C * ITYPE=1: COSANG(1) IS THETA *
|
|
C * ITYPE=2: COSANG(1) IS THETA, COSANG(2) IS VIB COORD *
|
|
C * ITYPE=3: COSANG(1),COSANG(2) ARE THETAS, COSANG(3) IS PHI *
|
|
C * SINCE IHOMO/ICNSYM CANNOT BE DETERMINED BY IOSBGP WITHOUT *
|
|
C * ANGULAR TERMS, THEY MAY BE READ IN &POTL OR SET HERE IN *
|
|
C * /ANGLES/. VALUES SET HERE OVERRIDE &POTL INPUT. *
|
|
C * IF NOT SET, DEFAULT VALUES WILL BE IHOMO=ICNSYM=1 *
|
|
C * POTENTIAL, RETURNED IN P(1), MUST BE MULTIPLIED BY 'FACTOR' *
|
|
C * (SET IN IOSBIN AND PASSED IN /ANGLES/) TO COUNTER LOWEST *
|
|
C * ANGULAR FUNCTION (ITYPE DEPENDENT) WHICH MULTIPLIES IT. *
|
|
C * INITIALIZATION CALL (IDERIV.LT.0) MAY SET AND/OR USE *
|
|
C * RM=R AND EPSIL=P(1) *
|
|
C *****************************************************************
|
|
C
|
|
COMMON /ANGLES/COSANG(7),FACTOR,IHOMO,ICNSYM,IHOMO2,ICNSY2
|
|
C
|
|
IF (IDERIV.LT.0) THEN
|
|
IHOMO=2
|
|
IHOMO2=1
|
|
WRITE(6,*) ' This is the CO2 - CO PES '
|
|
c
|
|
RETURN
|
|
ENDIF
|
|
IF (IDERIV.GT.1) STOP
|
|
C
|
|
P(1)=(POTFUN(R,COSANG(1),COSANG(2),COSANG(3)))*FACTOR
|
|
|
|
WRITE(2,101) R,COSANG(1),COSANG(2),COSANG(3),P(1)
|
|
101 format(5f12.4)
|
|
|
|
|
|
RETURN
|
|
END
|
|
C---------------------------------------------------
|
|
|
|
FUNCTION POTFUN(R,T1,T2,PHI)
|
|
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
|
|
COMMON /ANGLES/COSANG(7),FACTOR,IHOMO,ICNSYM,IHOMO2,ICNSY2
|
|
!dimension xi(4)
|
|
character (len=40) :: NAME1
|
|
real*8 :: xi(4),V,pii,th1,th2,phi,ang2boh
|
|
!real*8 r,t1,t2,phi,v,ang2boh
|
|
ang2boh=1.889726d0
|
|
pii = dacos(-1d0)
|
|
|
|
NAME1='PES-CO2-CO-2892'
|
|
xi(1)=R/ang2boh
|
|
!xi(1)=r
|
|
xi(2)=COSANG(1)
|
|
xi(3)=COSANG(2)
|
|
xi(4)=COSANG(3)
|
|
!xi(2)=dcos(th1*pii/180.d0)
|
|
!xi(3)=dcos(th2*pii/180.d0)
|
|
xi(4)=xi(4)*(180.d0/pii)
|
|
call PES(xi, V, NAME1, 0, 0)
|
|
POTFUN=V
|
|
RETURN
|
|
END
|
|
|