mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-16 19:50:50 +01:00
1318 lines
46 KiB
Fortran
1318 lines
46 KiB
Fortran
************************************************************************
|
|
subroutine geomoptdrv(minpfile)
|
|
************************************************************************
|
|
* Driver for geometry optimization;
|
|
* parameters, specific arrays and types are declared in modul optim
|
|
************************************************************************
|
|
use optim
|
|
implicit none
|
|
integer :: minpfile,natoms,natwdummy
|
|
integer :: npara ! number of parameters
|
|
integer :: nopt ! number of parameters to optimize
|
|
integer :: nonred,ndeloc
|
|
integer :: nintcoord ! number of internal coordinates
|
|
character(len=4) :: geom,unitc ! type of geometry (zmat/xyz) and its unit (Angstrom/Bohr)
|
|
character(len=6) :: molden
|
|
character(len=8) :: gopt,optalg,c8
|
|
logical :: lmolden ! Is molden file requested?
|
|
logical :: lcomp ! whether the energy is composite or not
|
|
|
|
double precision :: fgoal,optetol,optgtol,optstol
|
|
double precision :: au ! scaling factor for coordinates au=1 for Bohr and au=ang2bohr for Angstrom
|
|
integer :: optmaxit,maxfun,plevel,lnum
|
|
integer :: istat
|
|
logical :: bool ! whether or not the optimization succeeded
|
|
character(len=4) :: c4
|
|
character(len=16) :: c16
|
|
character*16 coord_sys
|
|
|
|
|
|
|
|
integer i
|
|
type(coord_sys_type) :: csys
|
|
double precision, allocatable :: Bmatrix_ric(:,:) !B matrix for redundant internal coordinates
|
|
double precision, allocatable :: Gmat(:,:)
|
|
double precision, allocatable :: Umatrix(:,:)
|
|
|
|
|
|
|
|
#if !defined (gfortran) && !defined (G95)
|
|
integer*4 system
|
|
external system
|
|
#endif
|
|
|
|
interface
|
|
|
|
subroutine read_MINP(minpfile,geom,
|
|
$ gopt,npara,pname,fgopt,igopt,cgopt,nopt,
|
|
$ natwdummy,natoms,atnums,au)
|
|
implicit none
|
|
integer,intent(in) :: minpfile
|
|
character(len=4),intent(in) :: geom
|
|
character(len=8),intent(in) :: gopt
|
|
integer,intent(out) :: npara ! # parameters defined in the Z-matrix, or 3 x number of atoms in case of Cartesian cs
|
|
integer,intent(out) :: nopt ! # parameters to be optimized
|
|
character(len=*),dimension(:),intent(out) :: pname ! name of the parameters
|
|
double precision,dimension(:),intent(out) :: fgopt ! value of parameters
|
|
integer,dimension(:),intent(out) :: igopt ! whether or not the given parameter should be optimized
|
|
character(len=2),dimension(:),intent(out) :: cgopt ! to hold the special marks '++', '--', or ' '
|
|
integer,intent(out) :: natwdummy,natoms ! # atoms and # atoms including dummies
|
|
integer,dimension(:),intent(out) ::atnums ! atomic numbers
|
|
double precision,intent(in) :: au ! scaling factor for coordinates au=1 for Bohr and au=ang2bohr for Angstrom
|
|
end subroutine read_MINP
|
|
|
|
subroutine geomopt(minpfile,geom,npara,pname,fgopt,igopt,cgopt,
|
|
$ nopt,optalg,fgoal,ftol,gtol,xtol,maxiter,maxfun,plevel,
|
|
$ Hessian,lmolden,bool,natwdummy,natoms,nintcoord,intcoords,rim,
|
|
$ au,lcomp,csys) !HB
|
|
use optim, only: coord_sys_type
|
|
implicit none
|
|
integer,intent(in) :: minpfile
|
|
integer,intent(in) :: npara,nopt
|
|
character(len=4),intent(in) :: geom
|
|
logical,intent(in) :: lcomp !HB
|
|
character(len=*),dimension(:),intent(in) :: pname ! name of the parameters to be optimized
|
|
double precision,dimension(:),intent(inout) :: fgopt ! value of parameters to be optimized
|
|
integer,dimension(:),intent(in) :: igopt ! whether or not the given parameter should be optimized
|
|
type(coord_sys_type) csys
|
|
character(len=2),dimension(:),intent(in) :: cgopt ! to hold the special marks '++', '--', or ' '
|
|
character(len=8),intent(in) :: optalg
|
|
double precision,intent(in) :: fgoal
|
|
double precision,intent(in) :: ftol
|
|
double precision,intent(in) :: gtol
|
|
double precision,intent(in) :: xtol
|
|
integer,intent(in) :: maxiter
|
|
integer,intent(in) :: maxfun
|
|
integer,intent(in) :: plevel
|
|
double precision,dimension(:,:),intent(in) :: Hessian
|
|
logical,intent(in) :: lmolden ! write molden file?
|
|
logical,intent(inout) :: bool ! whether or not the optimization succeeded
|
|
integer,intent(in) :: natwdummy,natoms ! # atoms and # atoms including dummies
|
|
integer,intent(in) :: nintcoord ! # internal coordinates
|
|
double precision, dimension(nintcoord),intent(inout) :: intcoords ! csonti
|
|
integer,dimension(5,nintcoord),intent(in) :: rim ! red_int_matrix
|
|
double precision,intent(in) :: au ! scaling factor for coordinates au=1 for Bohr and au=ang2bohr for Angstrom
|
|
end subroutine geomopt
|
|
|
|
subroutine MINP_zmat2cart(atsymbol,coordxyz,natwdummy,natoms)
|
|
implicit none
|
|
character(len=2),dimension(:),intent(in) :: atsymbol
|
|
double precision,dimension(:,:),intent(in) :: coordxyz
|
|
integer,intent(out) :: natwdummy,natoms ! # atoms and # atoms including dummies
|
|
end subroutine MINP_zmat2cart
|
|
|
|
end interface
|
|
|
|
call getkey('coord_sys',9,coord_sys,16)
|
|
csys%name=coord_sys
|
|
! take the parameters from the MINP file
|
|
call getkey('gopt',4,gopt,8)
|
|
if(gopt.ne.'off ') then
|
|
write(*,*)'gopt is on: ',gopt
|
|
else
|
|
write(*,*)'gopt is off: ',gopt
|
|
write(*,*)'you should not be here - csonti from geomopt'
|
|
endif
|
|
|
|
|
|
call getkey('verbosity',9,c4,4)
|
|
read(c4,'(i4)') plevel
|
|
call getkey('optalg',6,optalg,8)
|
|
call getkey('optmaxit',8,c8,8)
|
|
read(c8, '(i4)') optmaxit
|
|
call getkey('oniom',5,c8,8)
|
|
lcomp=.false.
|
|
if(trim(c8).ne.'off') lcomp=.true.
|
|
|
|
maxfun = optmaxit*15 ! this is quite arbitrary but should be fine in most situations
|
|
|
|
call getkey('optetol',7,c16,16)
|
|
read(c16, *) optetol
|
|
call getkey('optgtol',7,c16,16)
|
|
read(c16, *) optgtol
|
|
call getkey('optstol',7,c16,16)
|
|
read(c16, *) optstol
|
|
|
|
lmolden = .False.
|
|
call getkey('molden',6,molden,6)
|
|
if(molden.eq.'on ') lmolden=.True.
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
istat=system('cp MINP MINP.init')
|
|
if(istat.ne.0) then
|
|
write(6,*) 'Error while copying MINP to MINP.init'
|
|
stop
|
|
endif
|
|
|
|
C Check geometry type and unit
|
|
call getkey('geom',4,geom,4)
|
|
if(geom.ne.'xyz '.and.
|
|
$ geom.ne.'zmat'.and.
|
|
$ geom.ne.'tmol'.and.
|
|
$ geom.ne.'mol ') call unknown('geom',4)
|
|
|
|
call getkey('unit',4,unitc,4) ! whether coordinates are in Angstrom or Bohr
|
|
if(unitc .eq. 'bohr') then
|
|
au = 1.d0 ! no scaling
|
|
elseif(unitc .eq. 'angs') then
|
|
au = ang2bohr
|
|
endif
|
|
|
|
call get_natoms(minpfile,geom,natwdummy,natoms) ! number of atoms
|
|
|
|
if(geom.eq.'zmat') then ! convert it to Cartesian
|
|
allocate(alloc_atsymbols(natwdummy)) !csonti allocate
|
|
allocate(alloc_coords(3,natwdummy))
|
|
|
|
open(minpfile,file='MINP')
|
|
call getkeym('geom',4,c4,4)
|
|
call zmattocart(alloc_coords,natwdummy,alloc_atsymbols) ! it gets the Cartesian-coordinates from the Z-matrix
|
|
close(minpfile)
|
|
|
|
call MINP_zmat2cart(alloc_atsymbols,alloc_coords,natwdummy, ! it change the Z-matrix to Cartesian in the file MINP
|
|
$ natoms)
|
|
if(allocated(alloc_atsymbols)) deallocate(alloc_atsymbols)
|
|
if(allocated(alloc_coords)) deallocate(alloc_coords)
|
|
|
|
istat=system('test -e MINP.header')
|
|
if(istat.eq.0) then
|
|
istat=system('test -e MINP.footer')
|
|
if(istat.eq.0) then
|
|
istat=system('cat MINP.footer >> MINP.header')
|
|
istat=system('mv MINP.header MINP')
|
|
istat=system('rm -f MINP.footer')
|
|
endif
|
|
istat=system('rm -f MINP.header')
|
|
endif
|
|
geom='xyz '
|
|
endif !end of conversion, MINP contains Cartesians and MINP.init contains zmat
|
|
|
|
istat=system('test -e DIIS.geo')
|
|
if(istat.eq.0) istat=system('rm -f DIIS.geo')
|
|
istat=system('test -e DIISE.geo')
|
|
if(istat.eq.0) istat=system('rm -f DIISE.geo')
|
|
istat=system('test -e DIISG.geo')
|
|
if(istat.eq.0) istat=system('rm -f DIISG.geo')
|
|
|
|
allocate(alloc_atnums(natoms))
|
|
allocate(alloc_pname(natoms))
|
|
allocate(alloc_fgopt(3*natoms))
|
|
allocate(alloc_igopt(3*natoms))
|
|
allocate(alloc_cgopt(3*natoms))
|
|
|
|
call read_MINP(minpfile,geom,gopt,npara,
|
|
$ alloc_pname,alloc_fgopt,alloc_igopt,alloc_cgopt,
|
|
$ nopt,natwdummy,natoms,alloc_atnums,au)
|
|
|
|
call build_coordinate_system(natoms,alloc_fgopt,csys,alloc_atnums)
|
|
|
|
if(optalg.eq.'l-bfgs ') then
|
|
allocate(alloc_hessian(csys%ncoord,1))
|
|
else
|
|
allocate(alloc_hessian(csys%ncoord,csys%ncoord)) ! csonti allocate initial Hessian matrix
|
|
endif
|
|
|
|
alloc_hessian=0.0d0
|
|
call build_hessian(natoms,alloc_atnums,csys,alloc_hessian,
|
|
& 'lindh ')
|
|
|
|
! Write internal coordinates
|
|
call wrt_intcoords(csys%ncoord,csys%coord)
|
|
|
|
bool=.False.
|
|
call geomopt(minpfile,geom,npara,alloc_pname,alloc_fgopt,
|
|
$ alloc_igopt,alloc_cgopt,nopt,optalg,fgoal,optetol,
|
|
$ optgtol,optstol,optmaxit,maxfun,plevel,alloc_hessian,
|
|
$ lmolden,bool,natwdummy,natoms,csys%ncoord,
|
|
$ csys%coord,csys%rim,au,lcomp,csys)
|
|
|
|
if(bool) then
|
|
istat=system('mv MINP.tmp MINP.opt')
|
|
if(istat.ne.0) then
|
|
write(6,*) 'Error while renaming MINP.tmp to MINP.opt'
|
|
stop
|
|
endif
|
|
endif
|
|
|
|
! remove temp files
|
|
istat=system('test -e MINP.header')
|
|
if(istat.eq.0) istat=system('rm -f MINP.header')
|
|
istat=system('test -e MINP.footer')
|
|
if(istat.eq.0) istat=system('rm -f MINP.footer')
|
|
|
|
if(allocated(alloc_hessian)) deallocate(alloc_hessian) !csonti deallocate
|
|
if(allocated(Bmatrix_ric)) deallocate(Bmatrix_ric)
|
|
if(allocated(Umatrix)) deallocate(Umatrix)
|
|
if(allocated(alloc_atnums)) deallocate(alloc_atnums)
|
|
if(allocated(alloc_pname)) deallocate(alloc_pname)
|
|
if(allocated(alloc_fgopt)) deallocate(alloc_fgopt)
|
|
if(allocated(alloc_igopt)) deallocate(alloc_igopt)
|
|
if(allocated(alloc_cgopt)) deallocate(alloc_cgopt)
|
|
if(allocated(alloc_intcoords)) deallocate(alloc_intcoords)
|
|
if(allocated(alloc_coords)) deallocate(alloc_coords)
|
|
if(allocated(alloc_rim)) deallocate(alloc_rim)
|
|
call dealloc_coord_sys(csys)
|
|
|
|
return
|
|
end subroutine geomoptdrv
|
|
************************************************************************
|
|
|
|
************************************************************************
|
|
subroutine get_natoms(minpfile,geom,natwdummy,natoms)
|
|
************************************************************************
|
|
* It returns the number of atoms including dummies (natwdummy)
|
|
* and the number of atoms without dummies (natoms)
|
|
************************************************************************
|
|
implicit none
|
|
integer,intent(in) :: minpfile
|
|
character(len=4),intent(in) :: geom
|
|
integer,intent(out) :: natwdummy,natoms ! # atoms and # atoms including dummies
|
|
!local
|
|
integer :: check
|
|
character(len=512) :: line,stmp
|
|
logical :: lgeom = .False.
|
|
character(len=10) :: str10
|
|
|
|
natoms=0
|
|
natwdummy=0
|
|
check = 0
|
|
|
|
line=''
|
|
stmp=adjustl(trim(line))
|
|
|
|
if(geom.eq.'zmat') then
|
|
call ZMAT()
|
|
elseif(geom.eq.'xyz ') then
|
|
call Cartesian()
|
|
else
|
|
write(*,*) 'Not supported geometry specification'
|
|
write(*,*) 'Only Z-matrix and Cartesian coordinates are allowed.'
|
|
call mrccend(1)
|
|
endif
|
|
|
|
! ******************************************************************
|
|
contains
|
|
! ******************************************************************
|
|
|
|
! ******************************************************************
|
|
subroutine ZMAT
|
|
! ******************************************************************
|
|
implicit none
|
|
|
|
open(minpfile,file='MINP',status='old')
|
|
|
|
do while (check.eq.0 .and. stmp(1:4).ne.'geom')
|
|
read(minpfile,200,iostat=check) line ! lines before keyword geom
|
|
stmp=adjustl(trim(line))
|
|
if(stmp(1:4).eq.'geom') lgeom=.True.
|
|
enddo
|
|
|
|
if(lgeom) then
|
|
do while (check.eq.0 .and. trim(line).ne.'') ! Z-matrix definition part of geometry specification
|
|
read(minpfile,200,iostat=check) line
|
|
stmp = adjustl(trim(line))
|
|
call lowercase(stmp,stmp,2)
|
|
natwdummy=natwdummy+1
|
|
if(stmp(1:1).ne.'x' .or. stmp(2:2).eq.'e') natoms=natoms+1
|
|
if(stmp(1:1).eq.' ') then
|
|
natoms=natoms-1
|
|
natwdummy=natwdummy-1
|
|
endif
|
|
enddo
|
|
|
|
endif ! lgeom
|
|
|
|
close(minpfile)
|
|
|
|
200 format(a512)
|
|
end subroutine ZMAT
|
|
! ******************************************************************
|
|
|
|
! ******************************************************************
|
|
subroutine Cartesian()
|
|
|
|
use optim, only: integer_, str_cut
|
|
implicit none
|
|
!local
|
|
character(len=512) :: stra
|
|
character(len=512) :: strsy ! temporary string for atom's symbol or number
|
|
integer :: i
|
|
|
|
line=''
|
|
stmp=adjustl(trim(line))
|
|
|
|
open(minpfile,file='MINP',status='old')
|
|
|
|
do while (check.eq.0 .and. stmp(1:4).ne.'geom')
|
|
read(minpfile,200,iostat=check) line ! lines before keyword geom
|
|
stmp=adjustl(trim(line))
|
|
if(stmp(1:4).eq.'geom') lgeom=.True.
|
|
enddo
|
|
|
|
if(lgeom) then
|
|
read(minpfile,200,iostat=check) line ! number of atoms
|
|
stmp=adjustl(trim(line))
|
|
natwdummy = integer_(stmp)
|
|
|
|
read(minpfile,200,iostat=check) line ! title line of geom. spec.
|
|
stmp=adjustl(trim(line))
|
|
|
|
do i=1,natwdummy ! read Cartesian coordinates including dummies
|
|
read(minpfile,200,iostat=check) line
|
|
line = adjustl(trim(line))
|
|
call str_cut(line,' ',strsy,stra)
|
|
stmp = adjustl(trim(strsy)) ! atomic symbol/number (dummy symbol X handled - no atomic number for dummies!!!)
|
|
call lowercase(stmp,stmp,2)
|
|
if(stmp(1:1).ne.'x' .or. stmp(2:2).eq.'e') natoms=natoms+1
|
|
|
|
enddo
|
|
endif ! lgeom
|
|
|
|
close(minpfile)
|
|
|
|
200 format(a512)
|
|
end subroutine Cartesian
|
|
! ******************************************************************
|
|
|
|
end subroutine get_natoms
|
|
************************************************************************
|
|
|
|
************************************************************************
|
|
subroutine MINP_zmatvars(atsymbol,coordxyz,zpname,zpvalue)
|
|
************************************************************************
|
|
* It determines the variables defined in the Z-matrix
|
|
************************************************************************
|
|
use optim, only: double_, str_cut, cfillzero
|
|
implicit none
|
|
double precision,dimension(:,:),intent(in) :: coordxyz
|
|
character(len=2),dimension(:),intent(in) :: atsymbol
|
|
character(len=*),dimension(:),intent(out) :: zpname
|
|
double precision,dimension(:),intent(out) :: zpvalue
|
|
!local
|
|
integer :: check
|
|
integer,parameter :: minpfile=68,mheaderf=80,mfooterf=81
|
|
character(len=512) :: line,stmp
|
|
character(len=512) :: stra,strb
|
|
integer :: i,j,l
|
|
logical :: lgeom = .False.
|
|
integer :: natwdummy,natoms ! # atoms and # atoms including dummies
|
|
integer :: nzp ! # of Z-matrix parameters
|
|
character(len=10) :: str10
|
|
|
|
|
|
natoms=0
|
|
natwdummy=0
|
|
nzp = 0
|
|
check = 0
|
|
|
|
line=''
|
|
stmp=adjustl(trim(line))
|
|
|
|
open(minpfile,file='MINP',status='old')
|
|
open(mheaderf,file='MINP.header',status='unknown')
|
|
open(mfooterf,file='MINP.footer',status='unknown')
|
|
|
|
do while (check.eq.0 .and. stmp(1:4).ne.'geom')
|
|
read(minpfile,200,iostat=check) line ! lines before keyword geom
|
|
stmp=adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
if(stmp(1:4).eq.'geom') then
|
|
lgeom=.True.
|
|
else
|
|
write(mheaderf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
if(lgeom) then
|
|
do while (check.eq.0 .and. trim(line).ne.'') ! Z-matrix definition part of geometry specification
|
|
read(minpfile,200,iostat=check) line
|
|
stmp = adjustl(trim(line))
|
|
call lowercase(stmp,stmp,2)
|
|
natwdummy=natwdummy+1
|
|
if(stmp(1:1).ne.'x' .or. stmp(2:2).eq.'e') natoms=natoms+1
|
|
if(stmp(1:1).eq.' ') then
|
|
natoms=natoms-1
|
|
natwdummy=natwdummy-1
|
|
endif
|
|
enddo
|
|
|
|
line='%' ! It is just a trick so that the routine continues file reading
|
|
|
|
do while (check.eq.0 .and. trim(line).ne.'') ! definition of Z-matrix variables
|
|
read(minpfile,200,iostat=check) line
|
|
if(trim(line).ne.'') then
|
|
nzp = nzp+1 ! number of parameters in the Z-matrix
|
|
call str_cut(line,'=',stra,strb)
|
|
zpname(nzp) = stra ! name of the parameter in the Z-matrix
|
|
! call str_dtest(strb,fgopt(npara),lopt,mark)
|
|
zpvalue(nzp) = double_(strb)
|
|
endif
|
|
enddo
|
|
endif ! lgeom
|
|
|
|
|
|
do while (check.eq.0 .and. trim(line).ne.'') ! definition of Z-matrix variables
|
|
read(minpfile,200,iostat=check) line
|
|
enddo
|
|
|
|
|
|
|
|
write(mheaderf,'(a)') 'geom=xyz' ! write Cartesian coords
|
|
write(str10,'(i10)') natoms
|
|
write(mheaderf,'(a)') adjustl(str10)
|
|
write(mheaderf,'(a)') ''
|
|
|
|
do i=1,natoms
|
|
write(mheaderf,"(a2,3f20.10)")
|
|
$ adjustl(atsymbol(i)),(coordxyz(j,i),j=1,3)
|
|
enddo
|
|
write(mheaderf,'(a)') ''
|
|
|
|
do while (check.eq.0) ! lines after geometry specification
|
|
line=''
|
|
read(minpfile,200,iostat=check) line
|
|
if(check .eq. 0) then
|
|
stmp = adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
write(mfooterf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
|
|
close(mheaderf)
|
|
close(mfooterf)
|
|
close(minpfile)
|
|
|
|
200 format(a512)
|
|
|
|
end subroutine MINP_zmatvars
|
|
************************************************************************
|
|
|
|
************************************************************************
|
|
subroutine MINP_zmat2cart(atsymbol,coordxyz,natwdummy,natoms)
|
|
************************************************************************
|
|
* It converts MINP with geom. spec. in ZMAT
|
|
* to
|
|
* MINP with geom. spec. in Cartesian
|
|
************************************************************************
|
|
use optim, only: double_, str_cut, cfillzero
|
|
implicit none
|
|
double precision,dimension(:,:),intent(in) :: coordxyz
|
|
character(len=2),dimension(:),intent(in) :: atsymbol
|
|
integer,intent(in) :: natwdummy,natoms ! # atoms and # atoms including dummies
|
|
!local
|
|
integer :: check
|
|
integer,parameter :: minpfile=68,mheaderf=80,mfooterf=81
|
|
character(len=512) :: line,stmp
|
|
character(len=512) :: stra,strb
|
|
integer :: i,j,l
|
|
logical :: lgeom = .False.
|
|
character(len=10) :: str10
|
|
|
|
|
|
check = 0
|
|
|
|
line=''
|
|
stmp=adjustl(trim(line))
|
|
|
|
open(minpfile,file='MINP',status='old')
|
|
open(mheaderf,file='MINP.header',status='unknown')
|
|
open(mfooterf,file='MINP.footer',status='unknown')
|
|
|
|
do while (check.eq.0 .and. stmp(1:4).ne.'geom')
|
|
read(minpfile,200,iostat=check) line ! lines before keyword geom
|
|
stmp=adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
if(stmp(1:4).eq.'geom') then
|
|
lgeom=.True.
|
|
else
|
|
write(mheaderf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
if(lgeom) then
|
|
do while (check.eq.0 .and. trim(line).ne.'') ! Z-matrix definition part of geometry specification
|
|
read(minpfile,200,iostat=check) line
|
|
enddo
|
|
|
|
line='%' ! It is just a trick so that the routine continues file reading
|
|
|
|
do while (check.eq.0 .and. trim(line).ne.'') ! definition of Z-matrix variables
|
|
read(minpfile,200,iostat=check) line
|
|
enddo
|
|
endif ! lgeom
|
|
|
|
|
|
write(mheaderf,'(a)') 'geom=xyz' ! write Cartesian coords
|
|
write(str10,'(i10)') natoms
|
|
write(mheaderf,'(a)') adjustl(str10)
|
|
write(mheaderf,'(a)') ''
|
|
|
|
do i=1,natoms
|
|
write(mheaderf,"(a2,3f20.10)")
|
|
$ adjustl(atsymbol(i)),(coordxyz(j,i),j=1,3)
|
|
enddo
|
|
write(mheaderf,'(a)') ''
|
|
|
|
do while (check.eq.0) ! lines after geometry specification
|
|
line=''
|
|
read(minpfile,200,iostat=check) line
|
|
if(check .eq. 0) then
|
|
stmp = adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
write(mfooterf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
|
|
close(mheaderf)
|
|
close(mfooterf)
|
|
close(minpfile)
|
|
|
|
200 format(a512)
|
|
|
|
end subroutine MINP_zmat2cart
|
|
************************************************************************
|
|
|
|
|
|
************************************************************************
|
|
subroutine read_MINP(minpfile,geom,
|
|
$ gopt,npara,pname,fgopt,igopt,cgopt,nopt,
|
|
$ natwdummy,natoms,atnums,au)
|
|
|
|
************************************************************************
|
|
*
|
|
************************************************************************
|
|
use optim
|
|
implicit none
|
|
integer,intent(in) :: minpfile
|
|
character(len=4),intent(in) :: geom
|
|
character(len=8),intent(in) :: gopt
|
|
integer,intent(out) :: npara ! # parameters defined in the Z-matrix, or 3*natoms in Cartesian
|
|
integer,intent(out) :: nopt ! # parameters to be optimized
|
|
character(len=*),dimension(:),intent(out) :: pname ! name of the parameters
|
|
double precision,dimension(:),intent(out) :: fgopt ! value of parameters
|
|
integer,dimension(:),intent(out) :: igopt ! whether or not the given parameter should be optimized
|
|
character(len=2),dimension(:),intent(out) :: cgopt ! to hold the special marks '++', '--', or ' '
|
|
integer,intent(out) :: natwdummy,natoms ! # atoms and # atoms including dummies
|
|
integer,dimension(:),intent(out) ::atnums ! atomic numbers
|
|
double precision,intent(in) :: au ! scaling factor for coordinates au=1 for Bohr and au=ang2bohr for Angstrom
|
|
!locals
|
|
integer :: check
|
|
character(len=512) :: line,stmp
|
|
character(len=2) :: mark = ' '
|
|
logical :: lgeom = .False.,lopt=.True.
|
|
|
|
natoms=0
|
|
natwdummy=0
|
|
npara = 0
|
|
check = 0
|
|
|
|
if(geom.eq.'zmat') then
|
|
call ZMAT()
|
|
elseif(geom.eq.'xyz ') then
|
|
call Cartesian()
|
|
else
|
|
write(*,*) 'Not supported geometry specification'
|
|
write(*,*) 'Only Z-matrix and Cartesian coordinates are allowed.'
|
|
call mrccend(1)
|
|
endif
|
|
|
|
|
|
! ******************************************************************
|
|
contains ! read_MINP
|
|
! ******************************************************************
|
|
|
|
! ******************************************************************
|
|
subroutine ZMAT()
|
|
implicit none
|
|
!local
|
|
character(len=512) :: stra,strb
|
|
integer :: i,l
|
|
integer,parameter :: nparamax=150 ! csonti remove constraint
|
|
|
|
line=''
|
|
stmp=adjustl(trim(line))
|
|
|
|
open(minpfile,file='MINP',status='old')
|
|
open(mheaderf,file='MINP.header',status='unknown')
|
|
open(mfooterf,file='MINP.footer',status='unknown')
|
|
|
|
do while (check.eq.0 .and. stmp(1:4).ne.'geom')
|
|
read(minpfile,200,iostat=check) line ! lines before keyword geom
|
|
stmp=adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
write(mheaderf,'(a)') stmp(1:l)
|
|
if(stmp(1:4).eq.'geom') lgeom=.True.
|
|
enddo
|
|
|
|
if(lgeom) then
|
|
do while (check.eq.0 .and. trim(line).ne.'') ! Z-matrix definition part of geometry specification
|
|
read(minpfile,200,iostat=check) line
|
|
stmp = adjustl(trim(line))
|
|
call lowercase(stmp,stmp,2)
|
|
natwdummy=natwdummy+1
|
|
if(stmp(1:1).ne.'x' .or. stmp(2:2).eq.'e') natoms=natoms+1
|
|
enddo
|
|
|
|
line='%' ! It is just a trick so that the routine continues file reading
|
|
|
|
nopt=0
|
|
do while (check.eq.0 .and. trim(line).ne.'') ! definition of Z-matrix variables
|
|
read(minpfile,200,iostat=check) line
|
|
if(trim(line).ne.'') then
|
|
npara=npara+1
|
|
call str_cut(line,'=',stra,strb)
|
|
pname(npara) = stra
|
|
if(gopt.eq.'freeze ') then ! global freeze
|
|
lopt = .False.
|
|
else
|
|
lopt = .True.
|
|
endif
|
|
mark = ' '
|
|
call str_dtest(strb,fgopt(npara),lopt,mark)
|
|
cgopt(npara)=mark
|
|
if(.not.lopt) then
|
|
igopt(npara)=0
|
|
else
|
|
igopt(npara)=1
|
|
nopt=nopt+1
|
|
endif
|
|
endif
|
|
enddo
|
|
endif ! lgeom
|
|
|
|
do while (check.eq.0) ! lines after geometry specification
|
|
line=''
|
|
read(minpfile,200,iostat=check) line
|
|
if(check .eq. 0) then
|
|
stmp = adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
write(mfooterf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
|
|
close(mheaderf)
|
|
close(mfooterf)
|
|
close(minpfile)
|
|
|
|
200 format(a512)
|
|
write(*,*) 'this is the end!'
|
|
call mrccend(1)
|
|
|
|
end subroutine ZMAT
|
|
! ******************************************************************
|
|
|
|
! ******************************************************************
|
|
subroutine Cartesian()
|
|
implicit none
|
|
!local
|
|
character(len=512) :: stra,strb
|
|
character(len=512) :: strsy ! temporary string for atom's symbol or number
|
|
character(len=512),dimension(3) :: scoord ! temporary strings for the atom's x,y,z-coords
|
|
integer :: i,j,k,l
|
|
|
|
line=''
|
|
stmp=adjustl(trim(line))
|
|
|
|
open(minpfile,file='MINP',status='old')
|
|
open(mheaderf,file='MINP.header',status='unknown')
|
|
open(mfooterf,file='MINP.footer',status='unknown')
|
|
|
|
do while (check.eq.0 .and. stmp(1:4).ne.'geom')
|
|
read(minpfile,200,iostat=check) line ! lines before keyword geom
|
|
stmp=adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
write(mheaderf,'(a)') stmp(1:l)
|
|
if(stmp(1:4).eq.'geom') lgeom=.True.
|
|
enddo
|
|
|
|
if(lgeom) then
|
|
read(minpfile,200,iostat=check) line ! number of atoms
|
|
stmp=adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
write(mheaderf,'(a)') stmp(1:l)
|
|
natwdummy = integer_(stmp)
|
|
|
|
|
|
read(minpfile,200,iostat=check) line ! title line of geom. spec.
|
|
stmp=adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
write(mheaderf,'(a)') stmp(1:l)
|
|
|
|
nopt=0
|
|
do i=1,natwdummy ! read Cartesian coordinates including dummies
|
|
read(minpfile,200,iostat=check) line
|
|
line = adjustl(trim(line))
|
|
call str_cut(line,' ',strsy,stra)
|
|
pname(i) = adjustl(trim(strsy)) ! atomic symbol/number (dummy symbol X handled - no atomic number for dummies!!!)
|
|
stmp = pname(i)
|
|
atnums(i) = get_atomic_number(pname(i))
|
|
call lowercase(stmp,stmp,2)
|
|
if(stmp(1:1).ne.'x' .or. stmp(2:2).eq.'e') natoms=natoms+1
|
|
|
|
stra = adjustl(trim(stra))
|
|
call str_cut(stra,' ',scoord(1),strb)
|
|
strb = adjustl(trim(strb))
|
|
call str_cut(strb,' ',scoord(2),stra)
|
|
stra = adjustl(trim(stra))
|
|
call str_cut(stra,' ',scoord(3),strb)
|
|
|
|
do j=1,3
|
|
if(gopt.eq.'freeze ') then ! global freeze
|
|
lopt = .False.
|
|
else
|
|
lopt = .True.
|
|
endif
|
|
mark = ' '
|
|
call str_dtest(scoord(j),fgopt(npara+j),lopt,mark)
|
|
fgopt(npara+j) = fgopt(npara+j)*au !scale to Bohr
|
|
cgopt(npara+j)=mark
|
|
if(.not.lopt) then
|
|
igopt(npara+j)=0
|
|
else
|
|
igopt(npara+j)=1
|
|
nopt=nopt+1
|
|
endif
|
|
enddo !j
|
|
npara=npara+3
|
|
|
|
enddo
|
|
endif ! lgeom
|
|
|
|
do while (check.eq.0) ! lines after geometry specification
|
|
line=''
|
|
read(minpfile,200,iostat=check) line
|
|
if(check .eq.0) then
|
|
stmp = adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
write(mfooterf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
|
|
close(mheaderf)
|
|
close(mfooterf)
|
|
close(minpfile)
|
|
|
|
200 format(a512)
|
|
|
|
|
|
end subroutine Cartesian
|
|
! ******************************************************************
|
|
|
|
end subroutine read_MINP
|
|
************************************************************************
|
|
|
|
************************************************************************
|
|
subroutine geomopt(minpfile,geom,npara,pname,fgopt,igopt,cgopt,
|
|
$ nopt,optalg,fgoal,ftol,gtol,xtol,maxiter,maxfun,plevel,
|
|
$ Hessian,lmolden,bool,natwdummy,natoms,nintcoord,intcoords,
|
|
$ rim,au,lcomp,csys)
|
|
************************************************************************
|
|
use optim
|
|
implicit none
|
|
integer,intent(in) :: minpfile
|
|
integer,intent(in) :: npara,nopt
|
|
character(len=4),intent(in) :: geom
|
|
character(len=*),dimension(:),intent(in):: pname ! name of the parameters to be optimized
|
|
double precision,dimension(:),intent(inout) :: fgopt ! parameter array to be optimized, Cartesian coordinates are in row-major order (x1,y1,z1,x2,y2,..)
|
|
integer,dimension(:),intent(in) :: igopt ! whether or not the given parameter should be optimized
|
|
character(len=2),dimension(:),intent(in) :: cgopt ! to hold the special marks '++', '--', or ' '
|
|
character(len=8),intent(in) :: optalg
|
|
double precision,intent(in) :: fgoal
|
|
type(coord_sys_type) csys
|
|
! ***
|
|
! simplex parameters
|
|
! ftol -> convergence criterion for the function values
|
|
! gtol -> convergence criterion for the function values
|
|
! xtol -> convergence criterion for the function arguments
|
|
! maxiter -> maximum number of iterations allowed
|
|
! maxfun -> maximum number of function evaluations allowed
|
|
! plevel -> determine the amount of information to be printed (the larger the more)
|
|
! bool -> whether or not the optimization succeeded
|
|
! finit -> initial value of f2min
|
|
! fopt -> minimal value of f2min
|
|
! iter -> number of iterations performed
|
|
! nfeval -> number of function evaluations performed
|
|
! ***
|
|
double precision,intent(in) :: ftol
|
|
double precision,intent(in) :: gtol
|
|
double precision,intent(in) :: xtol
|
|
integer,intent(in) :: maxiter
|
|
integer,intent(in) :: maxfun
|
|
integer,intent(in) :: plevel
|
|
double precision,dimension(:,:),intent(in) :: Hessian
|
|
double precision,allocatable :: iHessian(:,:)
|
|
logical,intent(in) :: lmolden ! write molden file?
|
|
logical,intent(inout) :: bool ! whether or not the optimization succeeded
|
|
! end simplex parameters
|
|
|
|
integer,intent(in) :: natwdummy,natoms ! # atoms and # atoms including dummies
|
|
integer,intent(in) :: nintcoord ! # internal coordinates
|
|
double precision, dimension(nintcoord),intent(inout) :: intcoords ! csonti
|
|
integer,dimension(5,nintcoord),intent(in) :: rim ! red_int_matrix
|
|
double precision,intent(in) :: au ! scaling factor for coordinates au=1 for Bohr and au=ang2bohr for Angstrom
|
|
|
|
|
|
!local
|
|
integer :: ipara,ndim,iter,nfeval,ngeval,i
|
|
double precision para(nopt),finit,fopt,gradient(nopt)
|
|
logical, parameter :: logopt=.False. ! whether the parameter space's logarithm is taken or not
|
|
logical, dimension(nopt) :: lns ! to take notes of the parameter's sign before log()
|
|
logical lcomp
|
|
!
|
|
! initial guess for the parameters to be optimized
|
|
|
|
ipara=0
|
|
do i=1,npara
|
|
if(igopt(i).gt.0) then
|
|
ipara=ipara+1
|
|
para(ipara)=fgopt(i)
|
|
endif
|
|
enddo
|
|
|
|
! end initial guess for the parameters to be optimized
|
|
|
|
! taking the logarithm of the arguments if the optimization takes place
|
|
! in that space
|
|
! if (logopt) call log_trans(para,lns)
|
|
|
|
!***********************************************************************
|
|
|
|
write(*,1003)
|
|
write(*,'(21x,a)') 'Geometry Optimization has started'
|
|
write(*,*) ''
|
|
|
|
if(plevel>=3) call pretty_print_intcoords(csys)
|
|
|
|
if(optalg.eq.'simplex ') then
|
|
finit = goalfunc(para)! initial function value csonti include in simplex as a return value like in bfgs!!!
|
|
|
|
call simplex(goalfunc,para,ftol,xtol,maxiter,maxfun,
|
|
$ fopt,iter,nfeval,plevel,bool)
|
|
elseif(optalg.eq.'rfo ') then
|
|
call bfgs_rfo(mrccEGrad,intcoords,Hessian,ftol,gtol,
|
|
$ xtol,maxiter,maxfun,finit,fopt,iter,nfeval,ngeval,
|
|
$ plevel,lmolden,bool,csys)
|
|
elseif(optalg.eq.'l-bfgs ') then
|
|
allocate(ihessian(size(hessian,1),1))
|
|
do i=1,size(hessian,1)
|
|
ihessian(i,1)=1.0d0/hessian(i,1)
|
|
enddo
|
|
call lbfgs(mrccEGrad,intcoords,Hessian,ftol,gtol,xtol,
|
|
$ maxiter,maxfun,finit,fopt,iter,nfeval,ngeval,
|
|
$ plevel,lmolden,bool,20,csys)
|
|
deallocate(ihessian)
|
|
elseif(optalg.eq.'bfgs ') then
|
|
call bfgs_b(mrccEGrad,intcoords,Hessian,
|
|
$ ftol,gtol,xtol,maxiter,maxfun,
|
|
$ finit,fopt,iter,nfeval,ngeval,plevel,lmolden,bool,csys)
|
|
else
|
|
write(*,*) 'This is impossible ... (csonti)'
|
|
endif
|
|
|
|
write(*,1003)
|
|
write(*,*) ''
|
|
write(*,'(a40,f17.8)') 'Initial function value:',finit
|
|
write(*,*) ''
|
|
write(*,'(a40,f17.8)') 'Optimal function value:',fopt
|
|
write(*,'(a42,d16.3)') 'Energy tolerance:',ftol
|
|
write(*,'(a42,d16.3)') 'Gradient tolerance:',gtol
|
|
write(*,'(a42,d16.3)') 'Step tolerance:',xtol
|
|
write(*,'(a42,i8)') 'Number of iterations:',iter
|
|
write(*,'(a42,i8)') 'Number of function evaluations:',nfeval
|
|
write(*,'(a42,i8)') 'Number of gradient evaluations:',nfeval
|
|
write(*,*) ''
|
|
if (bool) then
|
|
write(*,'(15x,a)')'Geometry Optimization has ended successfully'
|
|
else
|
|
write(*,'(21x,a)')'Geometry Optimization has failed'
|
|
endif
|
|
write(*,1003)
|
|
1003 format(1x,70('%'))
|
|
|
|
if(plevel>=3) call pretty_print_intcoords(csys)
|
|
|
|
return
|
|
|
|
! ******************************************************************
|
|
contains !geomopt
|
|
! ******************************************************************
|
|
subroutine mrccEGrad(csys,mrccegrad_arr)
|
|
! ******************************************************************
|
|
! * it executes MRCC and returns both the gradient and the energy
|
|
! ******************************************************************
|
|
implicit none
|
|
type(coord_sys_type) :: csys
|
|
double precision :: mrccEGrad_arr(csys%ncoord+1) ! the last element is the energy!
|
|
!local
|
|
integer i
|
|
! coordinate transformation matrix
|
|
double precision, dimension(3,3) :: transf_m
|
|
integer gradfile
|
|
double precision, allocatable :: gradvec(:)
|
|
double precision, allocatable :: gradInStdT(:,:)
|
|
! ******************************************************************
|
|
|
|
mrccegrad_arr=0.0d0
|
|
|
|
allocate(gradvec(3*csys%natoms))
|
|
allocate(gradInStdT(csys%natoms_original,3))
|
|
|
|
! write MINP file
|
|
if(geom.eq.'zmat') then
|
|
call update_MINP_ZMAT(csys%coord) ! csonti attention
|
|
elseif(geom.eq.'xyz ') then
|
|
call update_MINP_Cart(csys%natoms_original,csys%cart_coord,au)
|
|
call wrt_intcoords(csys%ncoord,csys%coord)
|
|
else
|
|
write(*,*) 'Not supported geometry specification'
|
|
write(*,*)'Only Z-matrix and Cartesian coordinates are allowed.'
|
|
call mrccend(1)
|
|
endif
|
|
|
|
! execute MRCC and extract energy
|
|
if(lcomp) then !HB
|
|
call composite(.true.)
|
|
else
|
|
call spoint(.true.)
|
|
endif
|
|
mrccEGrad_arr(csys%ncoord+1) = get_last_energy()
|
|
|
|
! transform MRCC gradient
|
|
call getvar('ten ',transf_m)
|
|
|
|
gradfile=99
|
|
open(gradfile,file='GRAD',status='old',form='unformatted')
|
|
do i=1,natoms
|
|
read(gradfile)
|
|
$ gradInStdT(i,1),gradInStdT(i,2),gradInStdT(i,3)
|
|
enddo
|
|
close(gradfile)
|
|
|
|
gradvec=0.0d0
|
|
call dgemm('t','t',3,csys%natoms_original,3,1.d0,transf_m,3,
|
|
& gradInStdT,csys%natoms_original,0.d0,gradvec,3)
|
|
|
|
call transform_grad(csys%natoms,gradvec,mrccegrad_arr,
|
|
& csys)
|
|
|
|
deallocate(gradvec)
|
|
deallocate(gradInStdT)
|
|
|
|
return
|
|
|
|
end subroutine
|
|
|
|
! ******************************************************************
|
|
double precision function mrccE(para) ! this will be removed/or not csonti it depends on the implementation of numerical grads
|
|
! ******************************************************************
|
|
! * it executes MRCC and returns an energy,
|
|
! * and it also updates the MINP file
|
|
! ******************************************************************
|
|
implicit none
|
|
double precision, dimension(:), intent(inout) :: para
|
|
|
|
if(geom.eq.'zmat') then
|
|
call update_MINP_ZMAT(para)
|
|
elseif(geom.eq.'xyz ') then
|
|
call update_MINP_Cart(natoms,para,au)
|
|
else
|
|
write(*,*) 'Not supported geometry specification'
|
|
write(*,*) 'Only Z-matrix and Cartesian coordinates are allowed.'
|
|
call mrccend(1)
|
|
endif
|
|
|
|
! execute MRCC and extract energy
|
|
if(lcomp) then !HB
|
|
call composite(.true.)
|
|
else
|
|
call spoint(.true.)
|
|
endif
|
|
mrccE = get_last_energy()
|
|
|
|
return
|
|
|
|
end function mrccE
|
|
! ******************************************************************
|
|
|
|
! ******************************************************************
|
|
double precision function goalfunc(para)
|
|
! ******************************************************************
|
|
implicit none
|
|
double precision, dimension(:), intent(inout) :: para
|
|
double precision :: res
|
|
|
|
res = mrccE(para)
|
|
if(dabs(fgoal).lt.1d-10) then
|
|
goalfunc = res
|
|
else
|
|
goalfunc = dabs(fgoal-res)
|
|
endif
|
|
return
|
|
end function goalfunc
|
|
! ******************************************************************
|
|
|
|
|
|
! ******************************************************************
|
|
function fnumgrad(args)
|
|
! ******************************************************************
|
|
! * a simple two-point/central difference numerical gradient code
|
|
! * it calls function mrccE
|
|
! ******************************************************************
|
|
use optim
|
|
implicit none
|
|
double precision, dimension(:), intent(inout) :: args
|
|
double precision, dimension(size(args)) :: fnumgrad
|
|
!local
|
|
integer :: i,j,ndim,gradfile
|
|
double precision, dimension(:), allocatable :: e, eb
|
|
double precision :: eps,x0
|
|
|
|
allocate(e(size(args)))
|
|
allocate(eb(size(args)))
|
|
|
|
eps = sqrt ( epsilon_() ) ! square-root of machine epsilon
|
|
ndim = size(args)
|
|
do i=1,ndim
|
|
fnumgrad(i) = 0.d0
|
|
enddo
|
|
|
|
x0 = mrccE(args)
|
|
|
|
do i=1,ndim
|
|
do j=1,ndim
|
|
if( j .eq. i ) then
|
|
e(j) = args(j)+eps
|
|
eb(j) = args(j)-eps
|
|
else
|
|
e(j) = args(j)
|
|
eb(j) = args(j)
|
|
endif
|
|
enddo
|
|
fnumgrad(i) = (mrccE(e) - x0 ) / eps
|
|
! fnumgrad(i) = (mrccE(e) - mrccE(eb)) / (2*eps)
|
|
enddo
|
|
|
|
gradfile=99
|
|
|
|
open(gradfile,file='GRAD',status='unknown',form='unformatted')
|
|
do i=1,ndim
|
|
write(gradfile) fnumgrad(i)
|
|
enddo
|
|
close(gradfile)
|
|
|
|
! just a test
|
|
open(gradfile,file='GRAD',status='old',form='unformatted')
|
|
read(gradfile) (fnumgrad(i), i=1,ndim)
|
|
close(gradfile)
|
|
|
|
deallocate(e)
|
|
deallocate(eb)
|
|
|
|
return
|
|
end function fnumgrad
|
|
! ******************************************************************
|
|
|
|
! ******************************************************************
|
|
subroutine update_MINP_ZMAT(para)
|
|
! ******************************************************************
|
|
! * it updates the MINP file (Z-matrix version)
|
|
! ******************************************************************
|
|
implicit none
|
|
|
|
double precision, dimension(:), intent(inout) :: para
|
|
integer :: ipara,check,i,l
|
|
character(len=512) :: line,stmp
|
|
|
|
! do i=1,nopt ! test the parameters to be optimized
|
|
! write(*,*) i, para(i)
|
|
! enddo
|
|
|
|
ipara=0
|
|
do i=1,npara ! total parameters in Z-mat
|
|
if(igopt(i).gt.0) then
|
|
ipara=ipara+1
|
|
fgopt(i)=para(ipara)
|
|
endif
|
|
enddo
|
|
|
|
|
|
open(minpfile,file='MINP',status='old')
|
|
open(minptmpf,file='MINP.tmp',status='unknown')
|
|
open(mheaderf,file='MINP.header',status='old')
|
|
open(mfooterf,file='MINP.footer',status='old')
|
|
|
|
check = 0 ! MINP lines before geom spec
|
|
do while (check.eq.0)
|
|
line = ''
|
|
read(mheaderf,204,iostat=check) line
|
|
stmp = adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
if(check.eq.0) then
|
|
write(minpfile,'(a)') stmp(1:l)
|
|
write(minptmpf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
! do i=1,ilb ! lines before geom spec
|
|
! write(minpfile,'(a)') adjustl(trim(kwlines(i)))
|
|
! write(minptmpf,'(a)') adjustl(trim(kwlines(i)))
|
|
! enddo
|
|
|
|
do i=1,npara ! ZMAT geom spec part of MINP
|
|
write(minpfile,'(a)',advance='no') adjustl(trim(pname(i)))
|
|
write(minpfile,'(3a)',advance='no') ' ='
|
|
write(minpfile,101) fgopt(i)
|
|
|
|
write(minptmpf,'(a)',advance='no') adjustl(trim(pname(i)))
|
|
write(minptmpf,'(3a)',advance='no') ' ='
|
|
if(cgopt(i).eq.' ') then
|
|
write(minptmpf,101) fgopt(i)
|
|
else
|
|
write(minptmpf,103) fgopt(i),cgopt(i)
|
|
|
|
endif
|
|
enddo
|
|
|
|
write(minpfile,*)
|
|
write(minptmpf,*)
|
|
|
|
check = 0
|
|
do while (check.eq.0) ! MINP lines after geom spec
|
|
line = ''
|
|
read(mfooterf,204,iostat=check) line
|
|
stmp = adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
if(check.eq.0) then
|
|
write(minpfile,'(a)') stmp(1:l)
|
|
write(minptmpf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
! do i=ilb+1,ilb+ila-1 ! lines after geom spec
|
|
! write(minpfile,'(a)') adjustl(trim(kwlines(i)))
|
|
! write(minptmpf,'(a)') adjustl(trim(kwlines(i)))
|
|
! enddo
|
|
|
|
close(mheaderf)
|
|
close(mfooterf)
|
|
close(minpfile)
|
|
close(minptmpf)
|
|
|
|
100 format(1000i5)
|
|
101 format(1000f22.12)
|
|
102 format(i5,a2)
|
|
103 format(f22.12,a2)
|
|
204 format(a512)
|
|
! end update MINP
|
|
return
|
|
end subroutine update_MINP_ZMAT
|
|
! ******************************************************************
|
|
|
|
! ******************************************************************
|
|
subroutine update_MINP_Cart(natoms,para,au)
|
|
! ******************************************************************
|
|
! * it updates the MINP file (Cartesian version)
|
|
! ******************************************************************
|
|
implicit none
|
|
integer :: natoms
|
|
double precision, intent(inout) :: para(3*natoms)
|
|
double precision, intent(in) :: au ! to backscale the coordinates
|
|
integer :: ipara,check,i,j,k,l,npara
|
|
character(len=512) :: line,stmp
|
|
|
|
npara=3*natoms
|
|
! do i=1,nopt ! test the parameters to be optimized
|
|
! write(*,*) i, para(i)
|
|
! enddo
|
|
|
|
ipara=0
|
|
do i=1,npara ! total parameters in Cartesian, 3*natoms
|
|
if(igopt(i).gt.0) then
|
|
ipara=ipara+1
|
|
fgopt(i)=para(ipara)
|
|
endif
|
|
enddo
|
|
|
|
! write(*,*) 'npara: ',npara
|
|
|
|
open(minpfile,file='MINP',status='old')
|
|
open(minptmpf,file='MINP.tmp',status='unknown')
|
|
open(mheaderf,file='MINP.header',status='old')
|
|
open(mfooterf,file='MINP.footer',status='old')
|
|
|
|
check = 0 ! MINP lines before geom spec
|
|
do while (check.eq.0)
|
|
line = ''
|
|
read(mheaderf,204,iostat=check) line
|
|
stmp = adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
if(check.eq.0) then
|
|
write(minpfile,'(a)') stmp(1:l)
|
|
write(minptmpf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
do i=1,npara,3 ! MINP geom spec
|
|
k = (i-1)/3 + 1
|
|
write(minpfile,'(10a)',advance='no') adjustl(trim(pname(k)))
|
|
write(minptmpf,'(10a)',advance='no') adjustl(trim(pname(k)))
|
|
|
|
do j=0,2
|
|
write(minpfile,101,advance='no') fgopt(i+j)*1.d0/au
|
|
|
|
if(cgopt(i+j).eq.' ') then
|
|
write(minptmpf,101,advance='no') fgopt(i+j)*1.d0/au
|
|
else
|
|
write(minptmpf,103,advance='no')
|
|
$ fgopt(i+j)*1.d0/au,cgopt(i+j)
|
|
endif
|
|
enddo
|
|
|
|
write(minpfile,'(a)') ''
|
|
write(minptmpf,'(a)') ''
|
|
|
|
enddo
|
|
|
|
check = 0
|
|
do while (check.eq.0) ! MINP lines after geom spec
|
|
line = ''
|
|
read(mfooterf,204,iostat=check) line
|
|
stmp = adjustl(trim(line))
|
|
l = len_trim(stmp)
|
|
if(check.eq.0) then
|
|
write(minpfile,'(a)') stmp(1:l)
|
|
write(minptmpf,'(a)') stmp(1:l)
|
|
endif
|
|
enddo
|
|
|
|
close(mheaderf)
|
|
close(mfooterf)
|
|
close(minpfile)
|
|
close(minptmpf)
|
|
|
|
100 format(1000i5)
|
|
101 format(1000f22.12)
|
|
102 format(i5,a2)
|
|
103 format(f22.12,a2)
|
|
204 format(a512)
|
|
|
|
! end update MINP
|
|
return
|
|
end subroutine update_MINP_Cart
|
|
! ******************************************************************
|
|
|
|
|
|
************************************************************************
|
|
C
|
|
end subroutine geomopt
|
|
C
|
|
************************************************************************
|
|
|
|
|
|
|
|
************************************************************************
|