quantum_package/plugins/Casino/save_for_casino.irp.f

subroutine save_casino
 use bitmasks
 implicit none
 character*(128) :: message
 integer                        :: getUnitAndOpen, iunit
 integer, allocatable           :: itmp(:)
 integer                        :: n_ao_new
 double precision, allocatable              :: rtmp(:)
 PROVIDE ezfio_filename

 iunit = getUnitAndOpen('gwfn.data','w')
 print *, 'Title?'
 read(*,*) message
 write(iunit,'(A)') trim(message)
 write(iunit,'(A)') ''
 write(iunit,'(A)') 'BASIC_INFO'
 write(iunit,'(A)') '----------'
 write(iunit,'(A)') 'Generated by:'
 write(iunit,'(A)') 'Quantum package'
 write(iunit,'(A)') 'Method:'
 print *, 'Method?'
 read(*,*) message
 write(iunit,'(A)') trim(message)
 write(iunit,'(A)') 'DFT Functional:'
 write(iunit,'(A)') 'none'
 write(iunit,'(A)') 'Periodicity:'
 write(iunit,'(A)') '0'
 write(iunit,'(A)') 'Spin unrestricted:'
 write(iunit,'(A)') '.false.'
 write(iunit,'(A)') 'nuclear-nuclear repulsion energy (au/atom):'
 write(iunit,*) nuclear_repulsion
 write(iunit,'(A)') 'Number of electrons per primitive cell:'
 write(iunit,*) elec_num
 write(iunit,*) ''


 write(iunit,*) 'GEOMETRY'
 write(iunit,'(A)') '--------'
 write(iunit,'(A)') 'Number of atoms:'
 write(iunit,*) nucl_num
 write(iunit,'(A)') 'Atomic positions (au):'
 integer                        :: i
 do i=1,nucl_num
   write(iunit,'(3(1PE20.13))') nucl_coord(i,1:3)
 enddo
 write(iunit,'(A)') 'Atomic numbers for each atom:'
 ! Add 200 if pseudopotential
 allocate(itmp(nucl_num))
 do i=1,nucl_num
   itmp(i) = int(nucl_charge(i))
 enddo
 write(iunit,'(8(I10))') itmp(1:nucl_num)
 deallocate(itmp)
 write(iunit,'(A)') 'Valence charges for each atom:'
 write(iunit,'(4(1PE20.13))') nucl_charge(1:nucl_num)
 write(iunit,'(A)') ''


 write(iunit,'(A)') 'BASIS SET'
 write(iunit,'(A)') '---------'
 write(iunit,'(A)') 'Number of Gaussian centres'
 write(iunit,*) nucl_num
 write(iunit,'(A)') 'Number of shells per primitive cell'
 integer :: icount
 icount = 0
 do i=1,ao_num
  if (ao_l(i) == ao_power(i,1)) then
    icount += 1
  endif
 enddo
 write(iunit,*) icount
 write(iunit,'(A)') 'Number of basis functions (''AO'') per primitive cell'
 icount = 0
 do i=1,ao_num
  if (ao_l(i) == ao_power(i,1)) then
    icount += 2*ao_l(i)+1
  endif
 enddo
 n_ao_new = icount
 write(iunit,*) n_ao_new
 write(iunit,'(A)') 'Number of Gaussian primitives per primitive cell'
 allocate(itmp(ao_num))
 integer :: l
 l=0
 do i=1,ao_num
   if (ao_l(i) == ao_power(i,1)) then
     l += 1
     itmp(l) = ao_prim_num(i)
   endif
 enddo
 write(iunit,'(8(I10))') sum(itmp(1:l))
 write(iunit,'(A)') 'Highest shell angular momentum (s/p/d/f... 1/2/3/4...)'
 write(iunit,*) maxval(ao_l(1:ao_num))+1
 write(iunit,'(A)') 'Code for shell types (s/sp/p/d/f... 1/2/3/4/5...)'
 l=0
 do i=1,ao_num
   if (ao_l(i) == ao_power(i,1)) then
     l += 1
     if (ao_l(i) > 0) then
       itmp(l) = ao_l(i)+2
     else
       itmp(l) = ao_l(i)+1
     endif
   endif
 enddo
 write(iunit,'(8(I10))') itmp(1:l)
 write(iunit,'(A)') 'Number of primitive Gaussians in each shell'
 l=0
 do i=1,ao_num
   if (ao_l(i) == ao_power(i,1)) then
     l += 1
     itmp(l) = ao_prim_num(i)
   endif
 enddo
 write(iunit,'(8(I10))') itmp(1:l)
 deallocate(itmp)
 write(iunit,'(A)') 'Sequence number of first shell on each centre'
 allocate(itmp(nucl_num))
 l=0
 icount = 1
 itmp(icount) = 1
 do i=1,ao_num
  if (ao_l(i) == ao_power(i,1)) then
    l = l+1
    if (ao_nucl(i) == icount) then
      continue
    else if (ao_nucl(i) == icount+1) then
      icount += 1
      itmp(icount) = l
    else
      print *, 'Problem in order of centers of basis functions'
      stop 1
    endif
  endif
 enddo
 ! Check
 if (icount /= nucl_num) then
   print *,  'Error :'
   print *,  ' icount :', icount
   print *,  ' nucl_num:', nucl_num
   stop 2
 endif
 write(iunit,'(8(I10))') itmp(1:nucl_num)
 deallocate(itmp)
 write(iunit,'(A)') 'Exponents of Gaussian primitives'
 allocate(rtmp(ao_num))
 l=0
 do i=1,ao_num
   if (ao_l(i) == ao_power(i,1)) then
     do j=1,ao_prim_num(i)
       l+=1
       rtmp(l) = ao_expo(i,ao_prim_num(i)-j+1)
     enddo
   endif
 enddo
 write(iunit,'(4(1PE20.13))') rtmp(1:l)
 write(iunit,'(A)') 'Normalized contraction coefficients'
 l=0
 integer :: j
 do i=1,ao_num
   if (ao_l(i) == ao_power(i,1)) then
     do j=1,ao_prim_num(i)
       l+=1
       rtmp(l) = ao_coef_normalized(i,ao_prim_num(i))
     enddo
   endif
 enddo
 write(iunit,'(4(1PE20.13))') rtmp(1:l)
 deallocate(rtmp)
 write(iunit,'(A)') 'Position of each shell (au)'
 l=0
 do i=1,ao_num
   if (ao_l(i) == ao_power(i,1)) then
     write(iunit,'(3(1PE20.13))') nucl_coord( ao_nucl(i), 1:3 )
   endif
 enddo
 write(iunit,'(A)') 
 

 write(iunit,'(A)') 'MULTIDETERMINANT INFORMATION'
 write(iunit,'(A)') '----------------------------'
 write(iunit,'(A)') 'GS'
 write(iunit,'(A)') 'ORBITAL COEFFICIENTS'
 write(iunit,'(A)') '------------------------'

 ! Transformation cartesian -> spherical
 double precision :: tf2(6,5), tf3(10,7), tf4(15,9)
 integer :: check2(3,6), check3(3,10),  check4(3,15)
 check2(:,1)  = (/ 2, 0, 0 /)
 check2(:,2)  = (/ 1, 1, 0 /)
 check2(:,3)  = (/ 1, 0, 1 /)
 check2(:,4)  = (/ 0, 2, 0 /)
 check2(:,5)  = (/ 0, 1, 1 /)
 check2(:,6)  = (/ 0, 0, 2 /)

 check3(:,1)  = (/ 3, 0, 0 /)
 check3(:,2)  = (/ 2, 1, 0 /)
 check3(:,3)  = (/ 2, 0, 1 /)
 check3(:,4)  = (/ 1, 2, 0 /)
 check3(:,5)  = (/ 1, 1, 1 /)
 check3(:,6)  = (/ 1, 0, 2 /)
 check3(:,7)  = (/ 0, 3, 0 /)
 check3(:,8)  = (/ 0, 2, 1 /)
 check3(:,9)  = (/ 0, 1, 2 /)
 check3(:,10) = (/ 0, 0, 3 /)

 check4(:,1)  = (/ 4, 0, 0 /)
 check4(:,2)  = (/ 3, 1, 0 /)
 check4(:,3)  = (/ 3, 0, 1 /)
 check4(:,4)  = (/ 2, 2, 0 /)
 check4(:,5)  = (/ 2, 1, 1 /)
 check4(:,6)  = (/ 2, 0, 2 /)
 check4(:,7)  = (/ 1, 3, 0 /)
 check4(:,8)  = (/ 1, 2, 1 /)
 check4(:,9)  = (/ 1, 1, 2 /)
 check4(:,10) = (/ 1, 0, 3 /)
 check4(:,11) = (/ 0, 4, 0 /)
 check4(:,12) = (/ 0, 3, 1 /)
 check4(:,13) = (/ 0, 2, 2 /)
 check4(:,14) = (/ 0, 1, 3 /)
 check4(:,15) = (/ 0, 0, 4 /)

! tf2 = (/
!    -0.5, 0, 0, -0.5, 0, 1.0, &
!    0, 0, 1.0, 0, 0, 0, &
!    0, 0, 0, 0, 1.0, 0, &
!    0.86602540378443864676, 0, 0, -0.86602540378443864676, 0, 0, &
!    0, 1.0, 0, 0, 0, 0, &
!  /)
!  tf3 = (/
!    0, 0, -0.67082039324993690892, 0, 0, 0, 0, -0.67082039324993690892, 0, 1.0, &
!    -0.61237243569579452455, 0, 0, -0.27386127875258305673, 0, 1.0954451150103322269, 0, 0, 0, 0, &
!    0, -0.27386127875258305673, 0, 0, 0, 0, -0.61237243569579452455, 0, 1.0954451150103322269, 0, &
!    0, 0, 0.86602540378443864676, 0, 0, 0, 0, -0.86602540378443864676, 0, 0, &
!    0, 0, 0, 0, 1.0, 0, 0, 0, 0, 0, &
!    0.790569415042094833, 0, 0, -1.0606601717798212866, 0, 0, 0, 0, 0, 0, &
!    0, 1.0606601717798212866, 0, 0, 0, 0, -0.790569415042094833, 0, 0, 0, &
!  /)
!  tf4 = (/
!    0.375, 0, 0, 0.21957751641341996535, 0, -0.87831006565367986142, 0, 0, 0, 0, 0.375, 0, -0.87831006565367986142, 0, 1.0, &
!    0, 0, -0.89642145700079522998, 0, 0, 0, 0, -0.40089186286863657703, 0, 1.19522860933439364, 0, 0, 0, 0, 0, &
!    0, 0, 0, 0, -0.40089186286863657703, 0, 0, 0, 0, 0, 0, -0.89642145700079522998, 0, 1.19522860933439364, 0, &
!    -0.5590169943749474241, 0, 0, 0, 0, 0.9819805060619657157, 0, 0, 0, 0, 0.5590169943749474241, 0, -0.9819805060619657157, 0, 0, &
!    0, -0.42257712736425828875, 0, 0, 0, 0, -0.42257712736425828875, 0, 1.1338934190276816816, 0, 0, 0, 0, 0, 0, &
!    0, 0, 0.790569415042094833, 0, 0, 0, 0, -1.0606601717798212866, 0, 0, 0, 0, 0, 0, 0, &
!    0, 0, 0, 0, 1.0606601717798212866, 0, 0, 0, 0, 0, 0, -0.790569415042094833, 0, 0, 0, &
!    0.73950997288745200532, 0, 0, -1.2990381056766579701, 0, 0, 0, 0, 0, 0, 0.73950997288745200532, 0, 0, 0, 0, &
!    0, 1.1180339887498948482, 0, 0, 0, 0, -1.1180339887498948482, 0, 0, 0, 0, 0, 0, 0, 0, &
!  /)
!
  

 allocate(rtmp(ao_num*mo_tot_num))
 l=0
 do i=1,mo_tot_num
   do j=1,ao_num
     l += 1
     rtmp(l) = mo_coef(j,i)
   enddo
 enddo
 write(iunit,'(4(1PE20.13))') rtmp(1:l)
 deallocate(rtmp)
 close(iunit) 
end

program prog_save_casino
  call save_casino
end