program ima_vrb
implicit none
real fac
integer ::i,N
integer:: a,freqn
character*9 :: filename
character :: accu
character*13::filename1,out_file1,out_file2
integer , allocatable :: E1(:),AN1(:),E(:),AN(:)
real, allocatable :: x1(:),y1(:),z1(:)
real, allocatable :: x(:),y(:),z(:)
real, allocatable :: x2(:),y2(:),z2(:)
real, allocatable :: x3(:),y3(:),z3(:)
write(*,*)
write(*,*) '******* Gaussian imaginary frequencies ********'
write(*,*) '*********** Written by Mu yuewen ************'
write(*,*)
write(*,*) 'Please ensure files freq_xyz.in and freq_mod.in existing'
write(*,*) 'Please select the imaginary frequencies to modify'
write(*,*)'choices:123,12,1,2,3,23,0 and other number to get parameters'
read(*,*) freqn
write(*,*) 'Please enter the modify factor'
read(*,*) fac
write(*,*) 'fac=',fac
write(*,*) 'please enter the output file name(.gjf)'
read(*,*) filename
write(*,*) 'please choose the accuracy,coarse[c] or fine[f] or ultrafine[u]'
read(*,*) accu
filename1=trim(filename)//'.gjf'
open(unit=5,file=filename1,status='new')
if(freqn/=123.and.freqn/=12.and.freqn/=1.and.freqn/=2.and.freqn/=3.and.freqn/=23.and.freqn/=0) goto 20
open(unit=3,file='freq_xyz.in',status='old')
open(unit=4,file='freq_mod.in',status='old')
N=-1
do while(eof(3)/=.true.)
read(3,*)
N=N+1
enddo
allocate(E1(N),AN1(N),x1(N),y1(N),z1(N))
allocate(E(N),AN(N),x(N),y(N),z(N))
allocate(x2(N),y2(N),z2(N))
allocate(x3(N),y3(N),z3(N))
rewind(3)
read(3,*) out_file1
read(4,*) out_file2
if(out_file1/=out_file2) stop
do i=1,N
read(3,*) AN(i),E(i), a, x(i),y(i),z(i)
read(4,*) AN1(i),E1(i), x1(i),y1(i),z1(i), x2(i),y2(i),z2(i), x3(i),y3(i),z3(i)
if (E(i)/=E1(i).OR.AN(i)/=AN1(i)) stop
enddo
select case(freqn)
case(123)
do i=1,N
x(i)=x(i)+(x1(i)+x2(i)+x3(i))*fac
y(i)=y(i)+(y1(i)+y2(i)+y3(i))*fac
z(i)=z(i)+(z1(i)+z2(i)+z3(i))*fac
enddo
case(12)
do i=1,N
x(i)=x(i)+(x1(i)+x2(i))*fac
y(i)=y(i)+(y1(i)+y2(i))*fac
z(i)=z(i)+(z1(i)+z2(i))*fac
enddo
case(1)
do i=1,N
x(i)=x(i)+x1(i)*fac
y(i)=y(i)+y1(i)*fac
z(i)=z(i)+z1(i)*fac
enddo
case(2)
do i=1,N
x(i)=x(i)+x2(i)*fac
y(i)=y(i)+y2(i)*fac
z(i)=z(i)+z2(i)*fac
enddo
case(3)
do i=1,N
x(i)=x(i)+x3(i)*fac
y(i)=y(i)+y3(i)*fac
z(i)=z(i)+z3(i)*fac
enddo
case(23)
do i=1,N
x(i)=x(i)+(x2(i)+x3(i))*fac
y(i)=y(i)+(y2(i)+y3(i))*fac
z(i)=z(i)+(z2(i)+z3(i))*fac
enddo
case(0)
goto 20
case default
stop
end select
20 continue
write(5,*)"%chk=pvdf_.chk"
write(5,*)"%mem=800mb"
write(5,*)"%nproc=4"
select case(accu)
case('c')
write(5,*)"#p opt=(maxcycle=500)freq b3pw91/6-31g(d) "
case('u')
write(5,*)"#p opt=(verytight,maxcycle=200,cartesian) freq"
write(5,*) "scf=(nosymm,maxcycle=200,conver=10) int=ultrafine b3pw91/6-31g(d)"
case('f')
write(5,*)"#p opt=(tight,maxcycle=300) freq scf=(nosymm,maxcycle=200) int=ultrafine "
write(5,*) "b3pw91/6-31g(d)"
case default
stop
end select
write(5,*)
write(5,200) trim(out_file1),'(freq_',freqn,',',fac,')',n,'atoms'
200 format ( A,A,I3,A,F4.2,A,2x,i3,2x,a)
write(5,*)
write(5,*)"0 1"
do i=1,N
write(5,100) E(i), x(i),y(i),z(i)
100 format (2X, I2,2X,F12.7,2X,F12.7,2X,F12.7)
enddo
close(5)
close(3)
close(4)
deallocate (E1,AN1,x1,y1,z1)
deallocate (E,AN,x,y,z)
deallocate (x2,y2,z2)
deallocate (x3,y3,z3)
stop
end
https://blog.sciencenet.cn/blog-588243-481925.html
上一篇:
dmol 结构沿虚频方向移动 dmol_ima_freq_car.f90下一篇:
Fortran 读取外部变量