mirror of
https://code.it4i.cz/sccs/easyconfigs-it4i.git
synced 2025-04-17 12:10:50 +01:00
416 lines
16 KiB
Fortran
Executable File
416 lines
16 KiB
Fortran
Executable File
! Compilation, e.g.: ifort -o dirac_mointegral_export dirac_mointegral_export.F90 -i8
|
|
!
|
|
! Copyright (c) 2010 by the authors of DIRAC.
|
|
! All Rights Reserved.
|
|
!
|
|
! This source code is part of the DIRAC program package.
|
|
! It is provided under a written license and may be used,
|
|
! copied, transmitted, or stored only in accordance to the
|
|
! conditions of that written license.
|
|
!
|
|
! In particular, no part of the source code or compiled modules may
|
|
! be distributed outside the research group of the license holder.
|
|
! This means also that persons (e.g. post-docs) leaving the research
|
|
! group of the license holder may not take any part of Dirac,
|
|
! including modified files, with him/her, unless that person has
|
|
! obtained his/her own license.
|
|
!
|
|
! For information on how to get a license, as well as the
|
|
! author list and the complete list of contributors to the
|
|
! DIRAC program, see: http://dirac.chem.vu.nl
|
|
|
|
module dirac_mointegral_export
|
|
|
|
! Written by Lucas Visscher, VU University Amsterdam, December 2009, July 2010
|
|
|
|
implicit none
|
|
|
|
integer, parameter :: filenumber_1e = 21
|
|
integer, parameter :: filenumber_2e = 22
|
|
integer, parameter :: filenumber_nw = 23
|
|
integer, parameter :: filenumber_55 = 55
|
|
integer, parameter :: filenumber_56 = 56
|
|
logical, parameter :: generate_full_list = .true.
|
|
! The target variable should involve into an input option, for now we have no input since mrcc
|
|
! is presently the only code that is supported (the interface to nwchem is in an experimental stage)
|
|
character(10) :: target = 'mrcc'
|
|
|
|
type SpinorInformation
|
|
|
|
integer :: irrep
|
|
integer :: abelian_irrep
|
|
integer :: occupation
|
|
integer :: index
|
|
real(8) :: energy
|
|
|
|
end type SpinorInformation
|
|
|
|
integer :: number_of_spinors, number_of_electrons, number_of_irreps, number_of_abelian_irreps
|
|
real(8) :: core_energy
|
|
integer, allocatable :: kramer_to_spinor(:)
|
|
integer, allocatable :: multiplication_table(:,:)
|
|
integer :: irrep_occupation(128)
|
|
type(SpinorInformation), allocatable :: spinor(:)
|
|
|
|
public initialize, write_mrcc_fort55, write_mrcc_fort56
|
|
private process_1e, process_2e, make_index_to_occupied_first, irrep_reordered
|
|
|
|
contains
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
subroutine initialize ()
|
|
|
|
integer :: number_of_kramerspairs, i, j
|
|
character(10) :: date_of_generation
|
|
character(8) :: time_of_generation
|
|
logical :: breit_included
|
|
character(14) :: representation_name
|
|
|
|
open (filenumber_1e, file='MRCONEE', Form='UNFORMATTED')
|
|
read (filenumber_1e) number_of_spinors, &
|
|
breit_included, &
|
|
core_energy
|
|
read (filenumber_1e) number_of_irreps,(representation_name,i=1,number_of_irreps), &
|
|
(irrep_occupation(i),i=1,number_of_irreps)
|
|
read (filenumber_1e) number_of_abelian_irreps
|
|
|
|
! count total number of electrons
|
|
number_of_electrons = 0
|
|
do i = 1, number_of_irreps
|
|
number_of_electrons = number_of_electrons + irrep_occupation(i)
|
|
end do
|
|
|
|
allocate (multiplication_table(2*number_of_abelian_irreps,2*number_of_abelian_irreps))
|
|
allocate (spinor(number_of_spinors))
|
|
allocate (kramer_to_spinor(-number_of_spinors/2:number_of_spinors/2))
|
|
|
|
read (filenumber_1e) ((multiplication_table(i,j),i=1,2*number_of_abelian_irreps),j=1,2*number_of_abelian_irreps)
|
|
read (filenumber_1e) (spinor(i)%irrep,spinor(i)%abelian_irrep,spinor(i)%energy,i=1,number_of_spinors)
|
|
|
|
! create indices for optional reordering according to occupation
|
|
call make_index_to_occupied_first ()
|
|
|
|
write (*,*) " Initialized reading from MRCONEE"
|
|
write (*,*) " Core energy: ", core_energy
|
|
write (*,*) " Breit interaction: ", breit_included
|
|
|
|
open (filenumber_2e, file='MDCINT', Form='UNFORMATTED')
|
|
read (filenumber_2e) date_of_generation, &
|
|
time_of_generation, &
|
|
number_of_kramerspairs, &
|
|
(kramer_to_spinor(i),kramer_to_spinor(-i),i=1,number_of_spinors/2)
|
|
|
|
if (2 * number_of_kramerspairs /= number_of_spinors ) then
|
|
write (*,*) number_of_spinors, number_of_kramerspairs
|
|
stop 'inconsistent MRCONEE and MDCINT files'
|
|
end if
|
|
write (*,*) " Initialized reading from MDCINT"
|
|
write (*,*) " MDCINT created: ",date_of_generation," ",time_of_generation
|
|
|
|
end subroutine
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
|
|
subroutine process_1e
|
|
|
|
integer :: i, j
|
|
real(8), allocatable :: integral(:,:,:)
|
|
|
|
allocate (integral(number_of_spinors,number_of_spinors,2))
|
|
read (filenumber_1e) ((integral(i,j,1),integral(i,j,2),i=1,number_of_spinors),j=1,number_of_spinors)
|
|
|
|
select case (target)
|
|
|
|
case ('mrcc')
|
|
do i = 1, number_of_spinors
|
|
do j = 1, number_of_spinors
|
|
if (abs(integral(i,j,1)) > 1.E-16 ) &
|
|
write (filenumber_55,'(E28.20,4i4)') integral(i,j,1), &
|
|
i, &
|
|
j, &
|
|
0, &
|
|
0
|
|
end do
|
|
end do
|
|
|
|
case ('nwchem')
|
|
|
|
do i = 1, number_of_spinors
|
|
do j = 1, number_of_spinors
|
|
if (abs(integral(i,j,1)) > 1.E-16 .or. abs(integral(i,j,2)) > 1.E-16) &
|
|
write (filenumber_nw,'(2E28.20,4i4)') &
|
|
integral(i,j,1), &
|
|
integral(i,j,2), &
|
|
i, &
|
|
j, &
|
|
0, &
|
|
0
|
|
end do
|
|
end do
|
|
end select
|
|
|
|
deallocate (integral)
|
|
|
|
end subroutine
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
subroutine process_2e
|
|
|
|
integer :: nonzero, ikr, jkr, inz
|
|
integer, allocatable :: indk(:), indl(:)
|
|
real(8), allocatable :: integral(:)
|
|
|
|
allocate (integral(number_of_spinors**2))
|
|
allocate (indk(number_of_spinors**2))
|
|
allocate (indl(number_of_spinors**2))
|
|
|
|
select case (target)
|
|
|
|
case ('mrcc')
|
|
|
|
do
|
|
read (filenumber_2e) ikr, jkr, nonzero, (indk(inz), indl(inz), inz=1, nonzero), (integral(inz), inz=1, nonzero)
|
|
if (ikr == 0) exit
|
|
do inz = 1, nonzero
|
|
write (filenumber_55,'(E28.20,4i4)') integral(inz), &
|
|
kramer_to_spinor(ikr), &
|
|
kramer_to_spinor(jkr), &
|
|
kramer_to_spinor(indk(inz)), &
|
|
kramer_to_spinor(indl(inz))
|
|
! make also kramers-related integral if desired
|
|
! note that we assume real integrals, in which case the kr integral is identical
|
|
if (generate_full_list) &
|
|
write (filenumber_55,'(E28.20,4i4)') integral(inz), &
|
|
kramer_to_spinor(-ikr), &
|
|
kramer_to_spinor(-jkr), &
|
|
kramer_to_spinor(-indk(inz)), &
|
|
kramer_to_spinor(-indl(inz))
|
|
end do
|
|
end do
|
|
|
|
case ('nwchem')
|
|
|
|
do
|
|
read (filenumber_2e) ikr, jkr, nonzero, (indk(inz), indl(inz), inz=1, nonzero), (integral(inz), inz=1, nonzero)
|
|
if (ikr == 0) exit
|
|
do inz = 1, nonzero
|
|
write (filenumber_nw,'(E28.20,4i4)') integral(inz), &
|
|
kramer_to_spinor(ikr), &
|
|
kramer_to_spinor(jkr), &
|
|
kramer_to_spinor(indk(inz)), &
|
|
kramer_to_spinor(indl(inz))
|
|
! make also kramers-related integral if desired
|
|
! note that we assume real integrals, in which case the kr integral is identical
|
|
if (generate_full_list) &
|
|
write (filenumber_nw,'(E28.20,4i4)') integral(inz), &
|
|
kramer_to_spinor(-ikr), &
|
|
kramer_to_spinor(-jkr), &
|
|
kramer_to_spinor(-indk(inz)), &
|
|
kramer_to_spinor(-indl(inz))
|
|
end do
|
|
end do
|
|
|
|
end select
|
|
|
|
deallocate(integral)
|
|
deallocate(indk)
|
|
deallocate(indl)
|
|
|
|
|
|
end subroutine
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
integer function irrep_reordered (irrep)
|
|
|
|
integer, intent(in) :: irrep
|
|
|
|
! Reorder the irreps such that boson irreps are given first and fermion irreps follow
|
|
|
|
if (irrep > number_of_abelian_irreps) then
|
|
irrep_reordered = irrep - number_of_abelian_irreps
|
|
else
|
|
irrep_reordered = irrep + number_of_abelian_irreps
|
|
end if
|
|
|
|
end function
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
subroutine make_index_to_occupied_first
|
|
|
|
integer :: index, i, j, n
|
|
|
|
! We may want to reorder spinors such that we have all occupied first, create index for that
|
|
index = 0
|
|
do i = 1, number_of_irreps
|
|
n = 0
|
|
do j = 1, number_of_spinors
|
|
if (spinor(j)%irrep == i) then
|
|
n = n + 1
|
|
if (n <= irrep_occupation(i)) then
|
|
index = index + 1
|
|
spinor(j)%index = index
|
|
spinor(j)%occupation = 1
|
|
end if
|
|
end if
|
|
end do
|
|
end do
|
|
do i = 1, number_of_irreps
|
|
n = 0
|
|
do j = 1, number_of_spinors
|
|
if (spinor(j)%irrep == i) then
|
|
n = n + 1
|
|
if (n > irrep_occupation(i)) then
|
|
index = index + 1
|
|
spinor(j)%index = index
|
|
spinor(j)%occupation = 0
|
|
end if
|
|
end if
|
|
end do
|
|
end do
|
|
|
|
end subroutine
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
subroutine write_mrcc_fort55
|
|
|
|
! Write mrcc integral file fort.55.
|
|
! Note that it is no longer necessary to reorder the spinors to occupied first, kept the code as an example
|
|
! to show how this can be done.
|
|
|
|
integer :: i, j
|
|
integer, allocatable :: number_of_spinors_in_irrep(:)
|
|
integer, allocatable :: reordered_multiplication_table(:,:)
|
|
! type(SpinorInformation), allocatable :: reordered_spinor(:)
|
|
|
|
allocate (number_of_spinors_in_irrep(number_of_abelian_irreps))
|
|
allocate (reordered_multiplication_table(2*number_of_abelian_irreps,2*number_of_abelian_irreps))
|
|
|
|
! Count the number of spinors in each irrep
|
|
number_of_spinors_in_irrep(:) = 0
|
|
do i = 1, number_of_spinors
|
|
number_of_spinors_in_irrep(spinor(i)%abelian_irrep) = number_of_spinors_in_irrep(spinor(i)%abelian_irrep) + 1
|
|
end do
|
|
|
|
! Reorder to list the boson irreps first
|
|
do j = 1, 2 * number_of_abelian_irreps
|
|
do i = 1, 2 * number_of_abelian_irreps
|
|
reordered_multiplication_table(irrep_reordered(i), irrep_reordered(j)) = irrep_reordered(multiplication_table(i,j))
|
|
end do
|
|
end do
|
|
spinor(:)%abelian_irrep = spinor(:)%abelian_irrep + number_of_abelian_irreps
|
|
|
|
! allocate (reordered_spinor(number_of_spinors))
|
|
! Reorder to place occupied orbitals first
|
|
! do i = 1, number_of_spinors
|
|
! reordered_spinor(spinor(i)%index) = spinor(i)
|
|
! end do
|
|
|
|
open (filenumber_55, file='fort.55', Form='FORMATTED')
|
|
write (filenumber_55,'(2i6)') number_of_spinors, number_of_electrons
|
|
! write (filenumber_55,'(8i6)') (reordered_spinor(i)%abelian_irrep,i=1,number_of_spinors)
|
|
write (filenumber_55,'(8i6)') (spinor(i)%abelian_irrep,i=1,number_of_spinors)
|
|
write (filenumber_55,'(2i6)') -3
|
|
write (filenumber_55,'(2i6)') 2 * number_of_abelian_irreps
|
|
do j = 1, 2 * number_of_abelian_irreps
|
|
write (filenumber_55,'(8i6)') (reordered_multiplication_table(i,j),i=1,2*number_of_abelian_irreps)
|
|
end do
|
|
! temporary fix (adding two zeroes) as the 2009 version of mrcc appears to always want to read 4 irreps
|
|
write (filenumber_55,'(8i6)') (number_of_spinors_in_irrep(i),i=1,number_of_abelian_irreps),0,0
|
|
! call process_2e
|
|
! call process_1e
|
|
write (filenumber_55,'(E28.20,4i4)') core_energy,0,0,0,0
|
|
close (filenumber_55, status='keep')
|
|
|
|
deallocate (multiplication_table)
|
|
deallocate (reordered_multiplication_table)
|
|
! deallocate (reordered_spinor)
|
|
|
|
end subroutine
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
subroutine write_mrcc_fort56
|
|
|
|
! Write a sample mrcc input file fort.56.
|
|
! We will default the excitation level to doubles, this can be changed by the user
|
|
|
|
integer :: i
|
|
|
|
! open (filenumber_56, file='fort.56', Form='FORMATTED')
|
|
|
|
! First line of the input contains all the options, we specify the default values for a closed shell CCSD. Has to be modified by the user.
|
|
! Second line of the input is a comment line with the names of all of the options. Taken from the 2010 version of mrcc.
|
|
! write (filenumber_56,'(A)') " 2 0 0 0 1 0 0 1 0 0 1 0 1 0 0 8 0 0 0.00 0 7500 0 0.0E-00"
|
|
! write (filenumber_56,'(A)') "ex.lev,nsing,ntrip, rest,method,dens,conver,symm, diag, CS ,spatial, HF, ndoub,nacto,nactv, tol, maxex, sacc, freq, dboc, mem, locno, eps"
|
|
|
|
! Third line of the input contains a string with occupation numbers.
|
|
! write (filenumber_56,'(10000i2)') (spinor(i)%occupation,i=1,number_of_spinors)
|
|
|
|
! close (filenumber_56, status='keep')
|
|
|
|
open (filenumber_56, file='MINP', Form='FORMATTED')
|
|
write (filenumber_56,'(A)') "iface=dirac"
|
|
write (filenumber_56,'(A)') "calc=CCSD"
|
|
write (filenumber_56,'(A)') "mem=7500MB"
|
|
write (filenumber_56,'(A)') "refdet=vector"
|
|
write (filenumber_56,'(10000i2)') (spinor(i)%occupation,i=1,number_of_spinors)
|
|
close (filenumber_56, status='keep')
|
|
|
|
end subroutine
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
subroutine write_nwchem_file
|
|
|
|
|
|
! Should still be tuned to Karols preferences...
|
|
|
|
integer :: i, j
|
|
|
|
open (filenumber_nw, file='mo_integrals', Form='FORMATTED')
|
|
write (filenumber_nw,'(2i6)') number_of_spinors, number_of_electrons
|
|
write (filenumber_nw,'(8i6)') (spinor(i)%abelian_irrep,i=1,number_of_spinors)
|
|
write (filenumber_nw,'(2i6)') 2 * number_of_abelian_irreps
|
|
do j = 1, 2 * number_of_abelian_irreps
|
|
write (filenumber_nw,'(8i6)') (multiplication_table(i,j),i=1,2*number_of_abelian_irreps)
|
|
end do
|
|
write (filenumber_nw,'(E28.20)') core_energy
|
|
call process_1e
|
|
call process_2e
|
|
close (filenumber_nw, status='keep')
|
|
|
|
deallocate (multiplication_table)
|
|
|
|
end subroutine
|
|
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
end module
|
|
|
|
program make_interface_files
|
|
|
|
use dirac_mointegral_export
|
|
|
|
call initialize
|
|
select case (target)
|
|
case ('mrcc')
|
|
write (*,*) ' Writing sample MINP CCSD input file for mrcc...'
|
|
call write_mrcc_fort56
|
|
write (*,*) ' MINP file ready: can be modified by user'
|
|
write (*,*) ' Writing fort.55 interface file for mrcc...'
|
|
call write_mrcc_fort55
|
|
write (*,*) ' fort.55 file ready'
|
|
case ('nwchem')
|
|
write (*,*) ' Writing interface file for nwchem...'
|
|
call write_nwchem_file
|
|
write (*,*) ' nwchem file ready'
|
|
end select
|
|
|
|
end
|