comp-chem/cp2k
1
0
Fork 0
mirror of https://github.com/cp2k/cp2k.git synced 2026-07-27 21:55:16 -04:00
Code Issues Projects Releases Packages Wiki Activity Actions

added subroutine init_cphi

Browse source 
svn-origin-rev: 28
This commit is contained in:
Gloria Tabacchi 2001-07-01 17:40:32 +00:00
parent e5beee892c
commit eefe706cb0
1 changed files with 52 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

60
src/pol_setup.F
View file

@ -24,12 +24,13 @@ MODULE pol_setup
USE atomic_kinds, ONLY : kind_info_type
USE basis_set_types, ONLY : read_basis_set, allocate_basis_set, &
deallocate_basis_set
deallocate_basis_set, gto_basis_set_type
USE force_fields, ONLY : ATOMNAMESLENGTH
USE global_types, ONLY: global_environment_type
USE kinds, ONLY : dbl
USE interactions, ONLY : exp_radius
USE molecule_types , ONLY : molecule_type, read_basis_type
USE orbital_pointers, ONLY: coset,nco,ncoset,nso
USE particle_types, ONLY : particle_type
USE string_utilities, ONLY : str_search
USE termination, ONLY : stop_memory, stop_program
@ -160,13 +161,13 @@ MODULE pol_setup
nkind = number_of_kinds
IF (nkind >= 0) THEN
ALLOCATE (ki ( nkind ),STAT=istat)
ALLOCATE (ki(nkind),STAT=istat)
IF (istat /= 0) CALL stop_memory("allocate_pol_basis_info","ki(nkind)",0)
DO ikind=1,nkind
NULLIFY ( ki ( ikind ) % aux_basis_set )
NULLIFY ( ki ( ikind ) % orb_basis_set )
NULLIFY ( ki ( ikind ) % atom_list )
NULLIFY ( ki ( ikind ) % elec_conf )
NULLIFY (ki ( ikind ) % aux_basis_set)
NULLIFY (ki ( ikind ) % orb_basis_set)
NULLIFY (ki ( ikind ) % atom_list)
NULLIFY (ki ( ikind) % elec_conf)
END DO
ELSE
CALL stop_program("allocate_pol_basis_info",&
@ -204,12 +205,14 @@ MODULE pol_setup
string=molinfo(ikind)%aname
itype = str_search(atom_names,nt,string)
CALL get_atom_list(ki(ikind),part,itype)
CALL get_atom_list(ki(ikind),part,itype,ikind)
CALL allocate_basis_set(ki(ikind)%orb_basis_set)
CALL read_basis_set(ki(ikind)%element_symbol,ki(ikind)%orb_basis_set_name, &
ki(ikind)%orb_basis_set, globenv)
CALL init_cphi(ki(ikind)% orb_basis_set)
CALL get_radii(ki(ikind), moliNFo(ikind)%eps)
@ -218,13 +221,14 @@ MODULE pol_setup
END SUBROUTINE initialize_pol_basis_info
!------------------------------------------------------------------------------!
SUBROUTINE get_atom_list(ki,part,itype)
SUBROUTINE get_atom_list(ki,part,itype,ikind)
IMPLICIT NONE
TYPE(kind_info_type), INTENT(inout) :: ki
TYPE(particle_type), DIMENSION(:), INTENT(inout) :: part
INTEGER, INTENT(in) :: itype
INTEGER, INTENT(in) :: ikind
! locals
INTEGER :: isos,i,icount
icount=0
@ -237,6 +241,7 @@ MODULE pol_setup
icount=0
DO i=1, SIZE(part)
IF (part(i)%prop%ptype==itype) THEN
part(i) % kind = ikind
icount=icount+1
ki%atom_list(icount)=i
ENDIF
@ -343,6 +348,45 @@ MODULE pol_setup
END SUBROUTINE get_rcutsq_cgf
! *****************************************************************************
SUBROUTINE init_cphi(orb_basis_set)
! Purpose: Initialize the matrices for the transformation of primitive
! Cartesian Gaussian-type functions to contracted Cartesian
! (cphi) Gaussian-type functions.
! ***************************************************************************
TYPE(gto_basis_set_type), POINTER :: orb_basis_set
! *** Local variables ***
INTEGER :: first_cgf,first_sgf,icgf,ico,ipgf,iset,ishell,l,n,ncgf,nsgf
! ---------------------------------------------------------------------------
! *** Build the Cartesian transformation matrix "cphi" ***
DO iset=1,orb_basis_set%nset
n = ncoset(orb_basis_set%lmax(iset))
DO ishell=1,orb_basis_set%nshell(iset)
DO icgf=orb_basis_set%first_cgf(ishell,iset),&
orb_basis_set%last_cgf(ishell,iset)
ico = coset(orb_basis_set%lx(icgf),&
orb_basis_set%ly(icgf),&
orb_basis_set%lz(icgf))
DO ipgf=1,orb_basis_set%npgf(iset)
orb_basis_set%cphi(ico,icgf) = orb_basis_set%gcc(ipgf,ishell,iset)
ico = ico + n
END DO
END DO
END DO
END DO
END SUBROUTINE init_cphi
!------------------------------------------------------------------------------!
END MODULE pol_setup