TABLE OF CONTENTS


ABINIT/m_abimover [ Modules ]

[ Top ] [ Modules ]

NAME

 m_abimover

FUNCTION

 This module contains definition the types abimover, mttk, abiforstr, delocint, and bonds
 and their related ini and free routines

COPYRIGHT

 Copyright (C) 2001-2018 ABINIT group (DCA, XG, GMR, SE, Mver, JJ)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .

SOURCE

18 #if defined HAVE_CONFIG_H
19 #include "config.h"
20 #endif
21 
22 #include "abi_common.h"
23 
24 module m_abimover
25 
26  use defs_basis
27  use m_abicore
28  use m_atomdata
29  use m_errors
30  use defs_abitypes
31 
32  use m_geometry,  only : acrossb
33 
34  implicit none
35 
36  private
37 
38  public :: abimover_ini
39  public :: abimover_destroy
40  public :: mttk_ini   ! initialize the object
41  public :: mttk_fin   ! Release memory
42  public :: abiforstr_ini  ! Initialize the object
43  public :: abiforstr_fin  ! Free memory
44  public :: delocint_ini  ! Initialize the delocint object
45  public :: delocint_fin  ! Free memory
46  public :: bonds_free
47  public :: bond_length
48  public :: print_bonds
49  public :: make_bonds_new
50  public :: calc_prim_int
51  public :: make_prim_internals
52 
53  integer,public, parameter :: mover_BEFORE=0
54  integer,public, parameter :: mover_AFTER=1

defs_mover/abimover_print [ Functions ]

[ Top ] [ Functions ]

NAME

 abimover_print

FUNCTION

 Print all the variables in a ab_mover

INPUTS

OUTPUT

SIDE EFFECTS

  ab_mover <type(abimover)> = The ab_mover to nullify

PARENTS

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

NOTES

  At present 29 variables are present in abimover
  if a new variable is added in abimover it should
  be added also for print here

SOURCE

895 subroutine abimover_print(ab_mover,iout)
896 
897 
898 !This section has been created automatically by the script Abilint (TD).
899 !Do not modify the following lines by hand.
900 #undef ABI_FUNC
901 #define ABI_FUNC 'abimover_print'
902 !End of the abilint section
903 
904  implicit none
905 
906 !Arguments ------------------------------------
907  integer,intent(in) :: iout
908  type(abimover),intent(inout) :: ab_mover
909 
910 !Local variables-------------------------------
911 !arrays
912 character(len=1200) :: message
913 character(len=110)   :: fmt
914 
915 ! ***************************************************************
916 
917  fmt='(a,e12.5,a,a,I5,a,a,I5,a,a,I5,a,a,I5,a,a,I5,a,a,I5,a,a,e12.5,a,a,e12.5,a,a,e12.5,a,a,e12.5,a,a,e12.5,a)'
918 
919  write(message,fmt)&
920 & 'Delta Time for IONs',ab_mover%dtion,ch10, &
921 & 'include a JELLium SLAB in the cell',ab_mover%jellslab,ch10, &
922 & 'Number of ATOMs',ab_mover%natom,ch10, &
923 & 'Number of CONstraint EQuations',ab_mover%nconeq,ch10, &
924 & 'Number of SYMmetry operations',ab_mover%nsym,ch10, &
925 & 'OPTimize the CELL shape and dimensions',ab_mover%optcell,ch10, &
926 & 'RESTART Xcart and Fred',ab_mover%restartxf,ch10, &
927 & 'Molecular Dynamics Initial Temperature',ab_mover%mdtemp(1),ch10, &
928 & 'Molecular Dynamics Final Temperature',ab_mover%mdtemp(2),ch10, &
929 & 'NOSE thermostat INERTia factor',ab_mover%noseinert,ch10, &
930 & 'STRess PRECONditioner',ab_mover%strprecon,ch10, &
931 & 'VIScosity',ab_mover%vis,ch10
932 
933 ! ! arrays
934 ! ! Indices of AToms that are FIXed
935 ! integer,  pointer :: iatfix(:,:)
936 ! ! SYMmetries, Anti-FerroMagnetic characteristics
937 ! integer,  pointer :: symafm(:)
938 ! ! SYMmetry in REaL space
939 ! integer,  pointer :: symrel(:,:,:)
940 ! Translation NON-Symmorphic vectors
941 ! real(dp),  pointer :: tnons(:,:)
942 ! ! Mass of each atom (NOT IN DTSET)
943 ! real(dp), pointer :: amass(:)
944 ! ! STRess TARGET
945 ! real(dp), pointer :: strtarget(:)
946 ! Filename for Hessian matrix
947 ! character(len=fnlen), pointer :: fnameabi_hes
948 
949  write(iout,*) 'CONTENT of ab_mover (scalar only)'
950  write(iout,'(a)') message
951 
952 end subroutine abimover_print

m_abimover/ab_xfh_type [ Types ]

[ Top ] [ m_abimover ] [ Types ]

NAME

 ab_xfh_type

FUNCTION

 Datatype with the old structure for storing history
 used in gstate and brdmin,delocint, and others

NOTES

 This is a transitional structure, to bridge between
 the old code and the new one base on abihist

SOURCE

325 type, public :: ab_xfh_type
326 
327  integer :: nxfh,nxfhr,mxfh
328    ! mxfh = last dimension of the xfhist array
329    ! nxfh = actual number of (x,f) history pairs, see xfhist array
330 
331  real(dp),allocatable :: xfhist(:,:,:,:)
332    ! xfhist(3,natom+4,2,mxfh) = (x,f) history array, also including rprim and stress
333 
334 end type ab_xfh_type

m_abimover/abiforstr [ Types ]

[ Top ] [ m_abimover ] [ Types ]

NAME

 abiforstr

FUNCTION

 Store forces, stress and energy, cartesian and reduced forces
 one scalar for energy and 6 element array for stress

NOTES

SOURCE

292 type, public :: abiforstr
293 
294   ! scalars
295   real(dp) :: etotal
296    ! Total energy
297 
298   ! arrays
299   real(dp),allocatable :: fcart(:,:)
300    ! Cartesian forces
301   real(dp),allocatable :: fred(:,:)
302    ! Reduced forces
303   real(dp) :: strten(6)
304     ! Stress tensor (Symmetrical 3x3 matrix)
305 
306 end type abiforstr

m_abimover/abiforstr_fin [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 abiforstr_fin

FUNCTION

 destructor function for abiforstr object

 INPUT
 forstr

OUTPUT

PARENTS

      mover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

1118 subroutine abiforstr_fin(forstr)
1119 
1120 
1121 !This section has been created automatically by the script Abilint (TD).
1122 !Do not modify the following lines by hand.
1123 #undef ABI_FUNC
1124 #define ABI_FUNC 'abiforstr_fin'
1125 !End of the abilint section
1126 
1127  type(abiforstr), intent(inout) :: forstr
1128 
1129  if(allocated(forstr%fcart))  then
1130     ABI_DEALLOCATE(forstr%fcart)
1131  end if
1132  if(allocated(forstr%fred))  then
1133     ABI_DEALLOCATE(forstr%fred)
1134  end if
1135 
1136 end subroutine abiforstr_fin

m_abimover/abiforstr_ini [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 abiforstr_ini

FUNCTION

 destructor function for abiforstr object

 INPUT
 forstr

OUTPUT

PARENTS

      mover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

1077 subroutine abiforstr_ini(forstr,natom)
1078 
1079 
1080 !This section has been created automatically by the script Abilint (TD).
1081 !Do not modify the following lines by hand.
1082 #undef ABI_FUNC
1083 #define ABI_FUNC 'abiforstr_ini'
1084 !End of the abilint section
1085 
1086  integer,intent(in)  :: natom
1087  type(abiforstr), intent(out) :: forstr
1088 
1089  ABI_ALLOCATE(forstr%fcart,(3,natom))
1090  ABI_ALLOCATE(forstr%fred,(3,natom))
1091 
1092 end subroutine abiforstr_ini

m_abimover/abimover [ Types ]

[ Top ] [ m_abimover ] [ Types ]

NAME

 abimover

FUNCTION

 This datatype has the purpose of store all the data taken
 usually from dtset (but not only) needed for the different predictors
 to update positions, acell, etc.

SOURCE

 70 type, public :: abimover
 71 
 72 ! scalars
 73 ! Delay of Permutation (Used by pred_langevin only)
 74 integer  :: delayperm
 75 ! DIIS memory (Used by pred_diisrelax only)
 76 integer  :: diismemory
 77 ! Geometry Optimization Precondition option
 78 integer  :: goprecon
 79 ! include a JELLium SLAB in the cell
 80 integer  :: jellslab
 81 ! Number of ATOMs
 82 integer  :: natom
 83 ! Number of CONstraint EQuations
 84 integer  :: nconeq
 85 ! Option to add strain when FREEZe DISPlacement
 86 integer :: ph_freez_disp_addStrain
 87 ! Option for the PHonon FREEZe DISPlacement AMPLitude 
 88 integer :: ph_freez_disp_option
 89 ! Number of PHonon FREEZe DISPlacement AMPLitude
 90 integer :: ph_freez_disp_nampl
 91 ! number of Shifts for the Qpoint Grid  (used for ionmov 26 and 27)
 92 integer  :: ph_nqshift
 93 ! Use by pred_isothermal only
 94 integer  :: nnos
 95 ! Number of SYMmetry operations
 96 integer  :: nsym
 97 ! Number of Types of atoms
 98 integer  :: ntypat
 99 ! OPTimize the CELL shape and dimensions
100 integer  :: optcell
101 ! RESTART Xcart and Fred
102 integer  :: restartxf
103 ! Sign of Permutation (Used by pred_langevin only)
104 integer  :: signperm
105 ! Ion movement
106 integer  :: ionmov
107 
108 ! Use by pred_isothermal only
109 real(dp) :: bmass
110 ! Delta Time for IONs
111 real(dp) :: dtion
112 ! Used by pred_langevin only
113 real(dp) :: friction
114 ! Used by pred_langevin only
115 real(dp) :: mdwall
116 ! Used by pred_nose only
117 real(dp) :: noseinert
118 ! STRess PRECONditioner
119 real(dp) :: strprecon
120 ! VIScosity
121 real(dp) :: vis
122 
123 ! arrays
124 ! Indices of AToms that are FIXed
125 integer,pointer  :: iatfix(:,:)         ! iatfix(3,natom)
126 ! SYMmetries, Anti-FerroMagnetic characteristics
127 integer,pointer  :: symafm(:)           ! symafm(nsym)
128 ! SYMmetry in REaL space
129 integer,pointer  :: symrel(:,:,:)       ! symrel(3,3,nsym)
130 ! Translation NON-Symmorphic vectors
131 real(dp),pointer :: tnons(:,:)          ! tnons(3,nsym)
132 ! TYPe of ATom
133 integer,pointer  :: typat(:)            ! typat(natom)
134 ! PRTint ATom LIST
135 integer,pointer  :: prtatlist(:)        ! prtatlist(natom)
136 ! Qpoint grid (used for ionmov 26 and 27)
137 integer,pointer  :: ph_ngqpt(:)         ! ph_ngqpt(3)
138 ! List of PHonon FREEZe DISPlacement AMPLitude
139 real(dp),pointer :: ph_freez_disp_ampl(:,:)
140 ! shift of the Qpoint Grid (used for ionmov 26 and 27)
141 real(dp),pointer :: ph_qshift(:,:)       ! 
142 ! amu input var for the current image
143 real(dp), pointer :: amu_curr(:)     ! amu_curr(ntypat)
144 ! Mass of each atom 
145 real(dp),pointer :: amass(:)            ! amass(natom)
146 ! Geometry Optimization Preconditioner PaRaMeters
147 real(dp),pointer :: goprecprm(:)
148 ! Molecular Dynamics Initial and Final Temperature
149 real(dp),pointer :: mdtemp(:)           ! mdtemp(2) (initial,final)
150 ! STRess TARGET
151 real(dp),pointer :: strtarget(:)        ! strtarget(6)
152 ! Use by pred_isothermal only
153 real(dp),pointer :: qmass(:)
154 ! Z number of each NUCLeus
155 real(dp),pointer :: znucl(:)            ! znucl(npsp)
156 
157 ! Filename for Hessian matrix
158 character(len=fnlen), pointer :: fnameabi_hes
159 ! Filename for _HIST file
160 character(len=fnlen), pointer :: filnam_ds(:)   ! dtfil%filnam_ds(5)
161 
162 end type abimover

m_abimover/abimover_destroy [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 abimover_destroy

FUNCTION

 Destroy the abimover structure

SIDE EFFECTS

  ab_mover <type(abimover)> = The abimover structure to be destroyed

PARENTS

      m_abimover,mover

SOURCE

828 subroutine abimover_destroy(ab_mover)
829 
830 !Arguments ------------------------------------
831 
832 !This section has been created automatically by the script Abilint (TD).
833 !Do not modify the following lines by hand.
834 #undef ABI_FUNC
835 #define ABI_FUNC 'abimover_destroy'
836 !End of the abilint section
837 
838  type(abimover),intent(inout) :: ab_mover
839 
840 ! ***************************************************************
841 
842  nullify(ab_mover%goprecprm)
843  nullify(ab_mover%iatfix)
844  nullify(ab_mover%mdtemp)
845  nullify(ab_mover%ph_ngqpt)
846  nullify(ab_mover%ph_freez_disp_ampl)
847  nullify(ab_mover%ph_qshift)
848 
849  nullify(ab_mover%prtatlist)
850  nullify(ab_mover%qmass)
851  nullify(ab_mover%strtarget)
852  nullify(ab_mover%symafm)
853  nullify(ab_mover%symrel)
854  nullify(ab_mover%tnons)
855  nullify(ab_mover%typat)
856  nullify(ab_mover%znucl)
857 
858  nullify(ab_mover%amu_curr)
859  ABI_FREE(ab_mover%amass)
860 
861  nullify(ab_mover%fnameabi_hes)
862  nullify(ab_mover%filnam_ds)
863 
864 end subroutine abimover_destroy

m_abimover/abimover_ini [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 abimover_ini

FUNCTION

 Initializes the abimover structure and the abimover_specs information

INPUTS

OUTPUT

NOTES

PARENTS

      mover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

429 subroutine abimover_ini(ab_mover,amu_curr,dtfil,dtset,specs)
430 
431 !Arguments ------------------------------------
432 
433 !This section has been created automatically by the script Abilint (TD).
434 !Do not modify the following lines by hand.
435 #undef ABI_FUNC
436 #define ABI_FUNC 'abimover_ini'
437 !End of the abilint section
438 
439 real(dp),target, intent(in) :: amu_curr(:)            ! amu_curr(ntype)  
440 type(abimover),intent(out) :: ab_mover
441 type(datafiles_type),target,intent(in) :: dtfil
442 type(dataset_type),target,intent(in) :: dtset
443 type(abimover_specs),intent(out) :: specs
444 
445 !Local variables-------------------------------
446 !scalars
447  integer :: iatom,natom
448  character(len=500) :: msg
449 !arrays
450 
451 ! ***************************************************************
452 
453 
454 !write(std_out,*) 'mover 01'
455 !###########################################################
456 !### 01. Initialization of ab_mover
457 
458 !Copy or create pointers for the information from the Dataset (dtset)
459 !to the ab_mover structure
460  natom=dtset%natom
461 
462  ab_mover%delayperm   =dtset%delayperm
463  ab_mover%diismemory  =dtset%diismemory
464  ab_mover%goprecon    =dtset%goprecon
465  ab_mover%jellslab    =dtset%jellslab
466  ab_mover%natom       =dtset%natom
467  ab_mover%nconeq      =dtset%nconeq
468  ab_mover%nnos        =dtset%nnos
469  ab_mover%nsym        =dtset%nsym
470  ab_mover%ntypat      =dtset%ntypat
471  ab_mover%optcell     =dtset%optcell
472  ab_mover%restartxf   =dtset%restartxf
473  ab_mover%signperm    =dtset%signperm
474  ab_mover%ionmov      =dtset%ionmov
475  ab_mover%bmass       =dtset%bmass
476  ab_mover%dtion       =dtset%dtion
477  ab_mover%friction    =dtset%friction
478  ab_mover%mdwall      =dtset%mdwall
479  ab_mover%noseinert   =dtset%noseinert
480  ab_mover%ph_nqshift  =dtset%ph_nqshift
481  ab_mover%strprecon   =dtset%strprecon
482  ab_mover%vis         =dtset%vis
483  ab_mover%ph_freez_disp_addStrain =dtset%ph_freez_disp_addStrain
484  ab_mover%ph_freez_disp_option    =dtset%ph_freez_disp_option
485  ab_mover%ph_freez_disp_nampl     =dtset%ph_freez_disp_nampl
486 
487  ab_mover%iatfix      =>dtset%iatfix(:,1:natom)
488  ab_mover%symafm      =>dtset%symafm
489  ab_mover%symrel      =>dtset%symrel
490  ab_mover%tnons       =>dtset%tnons
491  ab_mover%ph_ngqpt    =>dtset%ph_ngqpt
492  ab_mover%ph_qshift   =>dtset%ph_qshift
493  ab_mover%ph_freez_disp_ampl      =>dtset%ph_freez_disp_ampl
494  ab_mover%typat       =>dtset%typat(1:natom)
495  ab_mover%prtatlist   =>dtset%prtatlist(1:natom)
496  ab_mover%goprecprm   =>dtset%goprecprm
497  ab_mover%mdtemp      =>dtset%mdtemp
498  ab_mover%strtarget   =>dtset%strtarget
499  ab_mover%qmass       =>dtset%qmass
500  ab_mover%znucl       =>dtset%znucl
501 
502  ab_mover%amu_curr    =>amu_curr
503  ABI_ALLOCATE(ab_mover%amass,(natom))
504  do iatom=1,natom
505    ab_mover%amass(iatom)=amu_emass*amu_curr(dtset%typat(iatom))
506  end do
507 
508 !Filename for Hessian matrix (NOT IN DTSET)
509  ab_mover%fnameabi_hes =>dtfil%fnameabi_hes
510 !Filename for _HIST file
511  ab_mover%filnam_ds    =>dtfil%filnam_ds
512 
513 !!DEBUG
514 !call abimover_print(ab_mover,ab_out)
515 !!DEBUG
516 
517 !write(std_out,*) 'mover 02'
518 !###########################################################
519 !### 02. Particularities of each predictor
520 
521 !Default values first
522 !--------------------
523 
524 !acell and rprimd are never changed except if optcell/=0
525  if (ab_mover%optcell/=0)then
526    specs%isARused=.TRUE.
527  else
528    specs%isARused=.FALSE.
529  end if
530 
531 !Velocities are never change except for ionmov=1,6,7,8
532  specs%isVused=.FALSE.
533 
534 !In general convergence is needed
535  specs%isFconv=.TRUE.
536 
537 !specs%ncycle is 1 by default except for ionmov=1,9,14
538  specs%ncycle=1
539 
540 !specs%nhist is -1 by default store all the history
541  specs%nhist=-1
542 
543 !This is the initialization for ionmov==1
544 !-----------------------------------------
545  select case (ab_mover%ionmov)
546  case (1)
547    specs%ncycle=4 ! Number of internal cycles for first itime
548    specs%isFconv=.FALSE.     ! Convergence is not used for MD
549    specs%isVused=.TRUE. ! Velocities are used
550 !  TEMPORARLY optcell is not allow
551    specs%isARused=.FALSE.
552 !  Values use in XML Output
553    specs%type4xml='moldyn'
554    specs%crit4xml='none'
555 !  Name of specs%method
556    if (abs(ab_mover%vis)<=1.d-8) then
557      specs%method = 'Molecular dynamics without viscosity (vis=0)'
558    else
559      write(specs%method,'(a,1p,e12.5,a)')&
560      'Molecular dynamics with viscosity (vis=',ab_mover%vis,')'
561    end if
562 !  Number of history
563    specs%nhist = 6
564 !  This is the initialization for ionmov==2,3
565 !  -------------------------------------------
566  case (2,3)
567 !  Values use in XML Output
568    specs%type4xml='bfgs'
569    specs%crit4xml='tolmxf'
570 !  Name of specs%method
571    if (ab_mover%ionmov==2) then
572      specs%method = 'Broyden-Fletcher-Goldfard-Shanno method (forces)'
573    else
574      specs%method = 'Broyden-Fletcher-Goldfard-Shanno method (forces,Tot energy)'
575    end if
576 !  Number of history
577    specs%nhist = 3
578 !  This is the initialization for ionmov==4,5
579 !  -------------------------------------------
580  case (4,5)
581 !  Values use in XML Output
582    specs%type4xml='simple'
583    specs%crit4xml='tolmxf'
584 !  Name of specs%method
585    if (ab_mover%ionmov==4) then
586      specs%method = 'Conjugate gradient of potential and ionic degrees of freedom'
587    else
588      specs%method = 'Simple relaxation of ionic positions'
589    end if
590 !  Number of history
591    specs%nhist = 3
592 !  This is the initialization for ionmov==6
593 !  ------------------------------------------
594  case (6)
595    specs%isFconv=.FALSE.     ! Convergence is not used for MD
596 !  TEMPORARLY optcell is not allow
597    specs%isARused=.FALSE.
598    specs%isVused=.TRUE. ! Velocities are used
599 !  Values use in XML Output
600    specs%type4xml='verlet'
601    specs%crit4xml='tolmxf'
602 !  Name of specs%method
603    specs%method = 'Verlet algorithm for molecular dynamics'
604 !  Number of history
605    specs%nhist = 3
606 !  This is the initialization for ionmov==7
607 !  ------------------------------------------
608  case (7)
609 !  TEMPORARLY optcell is not allow
610    specs%isARused=.FALSE.
611    specs%isVused=.TRUE. ! Velocities are used
612 !  Values use in XML Output
613    specs%type4xml='verlet'
614    specs%crit4xml='tolmxf'
615 !  Name of specs%method
616    specs%method = 'Verlet algorithm blocking every atom where dot(vel,force)<0'
617 !  Number of history
618    specs%nhist = 3
619 !  This is the initialization for ionmov==8
620 !  ------------------------------------------
621  case (8)
622    specs%isVused=.TRUE.
623 !  TEMPORARLY optcell is not allow
624    specs%isARused=.FALSE.
625 !  Values use in XML Output
626    specs%type4xml='nose'
627    specs%crit4xml='tolmxf'
628 !  Name of specs%method
629    specs%method = 'Verlet algorithm with a nose-hoover thermostat'
630 !  Number of history
631    specs%nhist = 3
632 !  This is the initialization for ionmov==9
633 !  ------------------------------------------
634  case (9)
635 !  TEMPORARLY optcell is not allow
636    specs%isARused=.FALSE.
637    specs%isVused=.TRUE.  ! Velocities are used
638    specs%ncycle=3
639 !  Values use in XML Output
640    specs%type4xml='langevin'
641    specs%crit4xml='tolmxf'
642 !  Name of specs%method
643    specs%method = 'Langevin molecular dynamics'
644 !  Number of history
645    specs%nhist = 3
646 !  This is the initialization for ionmov==10 and 11
647 !  -------------------------------------------
648  case (10,11)
649 !  TEMPORARLY optcell is not allow
650    specs%isARused=.FALSE.
651 !  Values use in XML Output
652    if(ab_mover%ionmov==10)specs%type4xml='delocint'
653    if(ab_mover%ionmov==11)specs%type4xml='cg'
654    specs%crit4xml='tolmxf'
655 !  Name of specs%method
656    if(ab_mover%ionmov==10)specs%method = 'BFGS with delocalized internal coordinates'
657    if(ab_mover%ionmov==11)specs%method = 'Conjugate gradient with deloc. int. coord.'
658 !  Number of history
659    specs%nhist = 3
660 !  This is the initialization for ionmov==12
661 !  -------------------------------------------
662  case (12)
663 !  TEMPORARLY optcell is not allow
664    specs%isARused=.FALSE.
665    specs%isVused=.TRUE.  ! Velocities are used
666 !  Values use in XML Output
667    specs%isFconv=.FALSE.      ! Convergence is not used for MD
668    specs%type4xml='isokin'
669    specs%crit4xml='tolmxf'
670 !  Name of specs%method
671    specs%method = 'Isokinetic ensemble molecular dynamics'
672 !  Number of history
673    specs%nhist = 3
674 !  This is the initialization for ionmov==13
675 !  -------------------------------------------
676  case (13)
677 !  optcell is allow
678    specs%isARused=.TRUE. ! RPRIMD and ACELL may change
679    specs%isVused=.TRUE.  ! Velocities are used
680    specs%isFconv=.FALSE.      ! Convergence is not used for MD
681 !  Values use in XML Output
682    specs%type4xml='isother'
683    specs%crit4xml='tolmxf'
684 !  Name of specs%method
685    specs%method = 'Isothermal/isenthalpic ensemble molecular dynamics'
686 !  Number of history
687    specs%nhist = 3
688 !  This is the initialization for ionmov==14
689 !  -------------------------------------------
690  case (14)
691    specs%ncycle=16
692    specs%isFconv=.FALSE.     ! Convergence is not used for MD
693    specs%isVused=.TRUE. ! Velocities are used
694 !  TEMPORARLY optcell is not allow
695    specs%isARused=.FALSE.
696 !  Values use in XML Output
697    specs%type4xml='srkna14'
698    specs%crit4xml='tolmxf'
699 !  Name of specs%method
700    specs%method = 'Symplectic algorithm Runge-Kutta-Nystrom SRKNa14'
701 !  Number of history
702    specs%nhist = 3
703 
704 !  This is the initialization for ionmov==15
705 !  -------------------------------------------
706 case (15)
707 !  Values use in XML Output
708    specs%type4xml='FIRE'
709    specs%isVused=.TRUE.  ! Velocities are used
710    specs%isARused=.TRUE.
711    specs%crit4xml='tolmxf'
712 !  Name of specs%method
713    specs%method = 'Fast inertial relaxation engine'
714 !  Number of history
715    specs%nhist = 2
716 !  This is the initialization for ionmov==20
717 !  -------------------------------------------
718  case (20)
719 !  TEMPORARLY optcell is not allow
720    specs%isARused=.FALSE.
721 !  Values use in XML Output
722    specs%type4xml='diisrelax'
723    specs%crit4xml='tolmxf'
724 !  Name of specs%method
725    specs%method = 'Ionic positions relaxation using DIIS'
726 !  Number of history
727    specs%nhist = 3
728 !  This is the initialization for ionmov==21
729 !  -------------------------------------------
730  case (21)
731    specs%isARused=.TRUE.
732 !  Values use in XML Output
733    specs%type4xml='steepdesc'
734    specs%crit4xml='tolmxf'
735 !  Name of specs%method
736    specs%method = 'Steepest descend algorithm'
737 !  Number of history
738    specs%nhist = 3
739 !  This is the initialization for ionmov==22
740 !  -------------------------------------------
741  case (22)
742 !  Values use in XML Output
743    specs%type4xml='lbfgs'
744    specs%crit4xml='tolmxf'
745 !  Name of specs%method
746    specs%method = 'Limited-memory Broyden-Fletcher-Goldfard-Shanno method'
747 !  Number of history
748    specs%nhist = 3
749 !  This is the initialization for ionmov==23
750 !  -------------------------------------------
751  case (23)
752    specs%ncycle=2
753 !  TEMPORARLY optcell is not allow
754    specs%isARused=.FALSE.
755    specs%isVused=.TRUE.  ! Velocities are used
756 !  Values use in XML Output
757    specs%isFconv=.FALSE.      ! Convergence is not used for MD
758    specs%type4xml='isokin'
759    specs%crit4xml='tolmxf'
760 !  Name of specs%method
761    specs%method = 'Using LOTF Molecular dynamics'
762 !  Number of history
763    specs%nhist = 3
764 !  This is the initialization for ionmov==24
765 !  -------------------------------------------
766  case (24)
767    specs%ncycle=1
768 !  TEMPORARLY optcell is not allow
769    specs%isARused=.FALSE.
770    specs%isVused=.TRUE.  ! Velocities are used
771 !  Values use in XML Output
772    specs%isFconv=.FALSE.      ! Convergence is not used for MD
773    specs%type4xml='velver'
774    specs%crit4xml='none'
775 !  Name of specs%method
776    specs%method = 'Symplectic velocity verlet Molecular dynamics'
777 !  Number of history
778    specs%nhist = 3
779 !  This is the initialization for ionmov==25
780 !  -------------------------------------------
781  case (25)                ! Hybrid Monte Carlo algorithm (fixed lattice vectors)
782    specs%ncycle = 12      ! Number of internal cycles (10+2)
783    specs%isFconv=.FALSE.  ! Convergence is not used for Monte Carlo
784    specs%isVused=.TRUE.   ! Velocities are used for update of atomic positions
785 !  optcell is not allowed
786    specs%isARused=.FALSE.
787 !  Values use in XML Output
788    specs%type4xml='hmc'
789    specs%crit4xml='none'
790 !  Name of specs%method
791    specs%method = 'Hybrid Monte Carlo'
792 !  This is the initialization for ionmov==27
793 !  -------------------------------------------
794  case (27)                ! Generation of the training set for effective potential
795    specs%ncycle = 1       ! Number of internal cycles
796    specs%isFconv=.FALSE.  ! Convergence is not used
797    specs%isVused=.FALSE.   ! Velocities are not used for update of atomic positions
798 !  Values use in XML Output
799    specs%type4xml='TS'
800    specs%crit4xml='none'
801 !  Name of specs%method
802    specs%method = 'training set generator'
803 !  Number of history
804    specs%nhist = -1
805 case default
806    write(msg,"(a,i0)")"Wrong value for ionmov: ",ab_mover%ionmov
807  end select
808 end subroutine abimover_ini

m_abimover/abimover_specs [ Types ]

[ Top ] [ m_abimover ] [ Types ]


m_abimover/angle_ang [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 angle_ang

FUNCTION

INPUTS

OUTPUT

SOURCE

1958 pure function angle_ang(r1,r2,r3)
1959 
1960 
1961 !This section has been created automatically by the script Abilint (TD).
1962 !Do not modify the following lines by hand.
1963 #undef ABI_FUNC
1964 #define ABI_FUNC 'angle_ang'
1965 !End of the abilint section
1966 
1967  implicit none
1968 
1969 !Arguments ------------------------------------
1970 !scalars
1971  real(dp) :: angle_ang
1972 !arrays
1973  real(dp),intent(in) :: r1(3),r2(3),r3(3)
1974 
1975 !Local variables ------------------------------
1976 !scalars
1977  real(dp) :: cos_ang,n1,n2
1978 !arrays
1979  real(dp) :: rpt12(3),rpt32(3)
1980 
1981 !******************************************************************
1982  n1=bond_length(r1,r2)
1983  n2=bond_length(r3,r2)
1984 
1985  rpt12(:) = r1(:)-r2(:)
1986  rpt32(:) = r3(:)-r2(:)
1987 
1988  cos_ang = (rpt12(1)*rpt32(1)+rpt12(2)*rpt32(2)+rpt12(3)*rpt32(3))/n1/n2
1989 
1990  if (cos_ang > one - epsilon(one)*two) then
1991    cos_ang = one
1992  else if(cos_ang < -one + epsilon(one)*two) then
1993    cos_ang = -one
1994  end if
1995 
1996  angle_ang=acos(cos_ang)
1997 
1998 end function angle_ang

m_abimover/angle_dihedral [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 angle_dihedral

FUNCTION

INPUTS

OUTPUT

SOURCE

2013  function angle_dihedral(r1,r2,r3,r4)
2014 
2015 
2016 !This section has been created automatically by the script Abilint (TD).
2017 !Do not modify the following lines by hand.
2018 #undef ABI_FUNC
2019 #define ABI_FUNC 'angle_dihedral'
2020 !End of the abilint section
2021 
2022  implicit none
2023 
2024 !Arguments ------------------------------------
2025 !scalars
2026  real(dp) :: angle_dihedral
2027 !arrays
2028  real(dp),intent(in) :: r1(3),r2(3),r3(3),r4(3)
2029 
2030 !Local variables------------------------------------
2031 !scalars
2032  real(dp) :: cos_dihedral,dih_sign,n1,n2,sin_dihedral
2033 !arrays
2034  real(dp) :: cp1232(3),cp3432(3),cpcp(3),rpt12(3),rpt32(3),rpt34(3)
2035 
2036 !******************************************************************
2037 
2038  rpt12(:) = r1(:)-r2(:)
2039  rpt32(:) = r3(:)-r2(:)
2040  rpt34(:) = r3(:)-r4(:)
2041 
2042  call acrossb(rpt12,rpt32,cp1232)
2043  call acrossb(rpt34,rpt32,cp3432)
2044 
2045 !DEBUG
2046 !write(std_out,*) ' cos_dihedral : cp1232 = ', cp1232
2047 !write(std_out,*) ' cos_dihedral : cp3432 = ', cp3432
2048 !ENDDEBUG
2049 
2050  n1 = sqrt(cp1232(1)**2+cp1232(2)**2+cp1232(3)**2)
2051  n2 = sqrt(cp3432(1)**2+cp3432(2)**2+cp3432(3)**2)
2052 
2053  cos_dihedral = (cp1232(1)*cp3432(1)+cp1232(2)*cp3432(2)+cp1232(3)*cp3432(3))/n1/n2
2054 !we use complementary of standard angle, so
2055  cos_dihedral = -cos_dihedral
2056 
2057  call acrossb(cp1232,cp3432,cpcp)
2058  cpcp(:) = cpcp(:)/n1/n2
2059  sin_dihedral = -(cpcp(1)*rpt32(1)+cpcp(2)*rpt32(2)+cpcp(3)*rpt32(3))&
2060 & /sqrt(rpt32(1)**2+rpt32(2)**2+rpt32(3)**2)
2061  dih_sign = one
2062 !if (abs(sin_dihedral) > tol12) then
2063 !dih_sign = sin_dihedral/abs(sin_dihedral)
2064 !end if
2065  if (sin_dihedral < -tol12) then
2066    dih_sign = -one
2067  end if
2068 
2069 !DEBUG
2070 !write(std_out,'(a,3E20.10)') 'angle_dihedral : cos sin dih_sign= ',&
2071 !&    cos_dihedral,sin_dihedral,dih_sign
2072 !ENDDEBUG
2073 
2074  if (cos_dihedral > one - epsilon(one)*two) then
2075    cos_dihedral = one
2076  else if(cos_dihedral < -one + epsilon(one)*two) then
2077    cos_dihedral = -one
2078  end if
2079 
2080  angle_dihedral = dih_sign*acos(cos_dihedral)
2081 
2082 end function angle_dihedral

m_abimover/bond_length [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 bond_length

FUNCTION

INPUTS

OUTPUT

SOURCE

1918 pure function bond_length(r1,r2)
1919 
1920 
1921 !This section has been created automatically by the script Abilint (TD).
1922 !Do not modify the following lines by hand.
1923 #undef ABI_FUNC
1924 #define ABI_FUNC 'bond_length'
1925 !End of the abilint section
1926 
1927  implicit none
1928 
1929 !Arguments ------------------------------------
1930 !scalars
1931  real(dp) :: bond_length
1932 !arrays
1933  real(dp),intent(in) :: r1(3),r2(3)
1934 
1935 !Local variables ------------------------------------
1936 !arrays
1937  real(dp) :: rpt(3)
1938 
1939 !******************************************************************
1940  rpt(:) = r1(:)-r2(:)
1941  bond_length = sqrt(rpt(1)**2+rpt(2)**2+rpt(3)**2)
1942 
1943 end function bond_length

m_abimover/bonds_free [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 bonds_free

FUNCTION

  Free memory

PARENTS

      m_abimover,prec_simple

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

2368 subroutine bonds_free(bonds)
2369 
2370 
2371 !This section has been created automatically by the script Abilint (TD).
2372 !Do not modify the following lines by hand.
2373 #undef ABI_FUNC
2374 #define ABI_FUNC 'bonds_free'
2375 !End of the abilint section
2376 
2377  implicit none
2378 
2379 !Arguments ------------------------------------
2380  type(go_bonds),intent(inout) :: bonds
2381 
2382 ! *********************************************************************
2383 
2384  if (allocated(bonds%bond_vect))then
2385    ABI_DEALLOCATE(bonds%bond_vect)
2386  end if
2387 
2388  if (allocated(bonds%bond_length))then
2389    ABI_DEALLOCATE(bonds%bond_length)
2390  end if
2391 
2392  if (allocated(bonds%nbondi))then
2393    ABI_DEALLOCATE(bonds%nbondi)
2394  end if
2395 
2396  if (allocated(bonds%indexi))then
2397    ABI_DEALLOCATE(bonds%indexi)
2398  end if
2399 
2400 end subroutine bonds_free

m_abimover/calc_prim_int [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 calc_prim_int

FUNCTION

  calculate values of primitive internal coordinates as a function of
  cartesian ones.

INPUTS

 angs= number of angles
 bonds(2,2,nbond)=for a bond between iatom and jatom
              bonds(1,1,nbond) = iatom
              bonds(2,1,nbond) = icenter
              bonds(1,2,nbond) = jatom
              bonds(2,2,nbond) = irshift
 carts(2,ncart)= index of total primitive internal, and atom (carts(2,:))
 dihedrals(2,4,ndihed)=indexes to characterize dihedrals
 dtset <type(dataset_type)>=all input variables for this dataset
 nang(2,3,nang)=indexes to characterize angles
 nbond=number of bonds
 ncart=number of cartesian coordinates used
 ndihed= number of dihedrals
 ninternal=nbond+nang+ndihed+ncart: number of internal coordinates
 nrshift= dimension of rshift
 rprimd(3,3)=dimensional real space primitive translations (bohr)
 rshift(3,nrshift)=shift in xred that must be done to find all neighbors of
                   a given atom within a given number of neighboring shells
 xcart(3,natom)=cartesian coordinates of atoms (bohr)

OUTPUT

 prim_int(ninternal)=values of primitive internal coordinates

SIDE EFFECTS

NOTES

PARENTS

      pred_delocint,xcart2deloc

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

1784 subroutine calc_prim_int(deloc,natom,rprimd,xcart,prim_int)
1785 
1786 
1787 !This section has been created automatically by the script Abilint (TD).
1788 !Do not modify the following lines by hand.
1789 #undef ABI_FUNC
1790 #define ABI_FUNC 'calc_prim_int'
1791 !End of the abilint section
1792 
1793  implicit none
1794 
1795 !Arguments ------------------------------------
1796 !scalars
1797  integer,intent(in) :: natom
1798  type(delocint),intent(in) :: deloc
1799 !arrays
1800  real(dp),intent(in) :: rprimd(3,3),xcart(3,natom)
1801  real(dp),intent(out) :: prim_int(deloc%ninternal)
1802 
1803 !Local variables ------------------------------
1804 !scalars
1805  integer :: i1,i2,i3,i4,iang,ibond,icart,idihed,iprim,s1,s2,s3,s4
1806 !arrays
1807  real(dp) :: r1(3),r2(3),r3(3),r4(3)
1808 
1809 !************************************************************************
1810 
1811 !DEBUG
1812 !write(std_out,*) ' calc_prim_int : enter'
1813 !write(std_out,*) shape(deloc%bonds)
1814 !do ibond=1,deloc%nbond
1815 !do i1=1,2
1816 !write(std_out,'(2I5)') deloc%bonds(:,i1,ibond)
1817 !end do
1818 !end do
1819 !ENDDEBUG
1820 
1821  iprim=1
1822 !first: bond values
1823  do ibond=1,deloc%nbond
1824    i1 = deloc%bonds(1,1,ibond)
1825    s1 = deloc%bonds(2,1,ibond)
1826    r1(:) = xcart(:,i1)+deloc%rshift(1,s1)*rprimd(:,1)&
1827 &   +deloc%rshift(2,s1)*rprimd(:,2)&
1828 &   +deloc%rshift(3,s1)*rprimd(:,3)
1829    i2 = deloc%bonds(1,2,ibond)
1830    s2 = deloc%bonds(2,2,ibond)
1831    r2(:) = xcart(:,i2)+deloc%rshift(1,s2)*rprimd(:,1)&
1832 &   +deloc%rshift(2,s2)*rprimd(:,2)&
1833 &   +deloc%rshift(3,s2)*rprimd(:,3)
1834    prim_int(iprim) = bond_length(r1,r2)
1835    iprim=iprim+1
1836  end do
1837 
1838 !second: angle values (ang)
1839  do iang=1,deloc%nang
1840    i1 = deloc%angs(1,1,iang)
1841    s1 = deloc%angs(2,1,iang)
1842    r1(:) = xcart(:,i1)+deloc%rshift(1,s1)*rprimd(:,1)&
1843 &   +deloc%rshift(2,s1)*rprimd(:,2)&
1844 &   +deloc%rshift(3,s1)*rprimd(:,3)
1845    i2 = deloc%angs(1,2,iang)
1846    s2 = deloc%angs(2,2,iang)
1847    r2(:) = xcart(:,i2)+deloc%rshift(1,s2)*rprimd(:,1)&
1848 &   +deloc%rshift(2,s2)*rprimd(:,2)&
1849 &   +deloc%rshift(3,s2)*rprimd(:,3)
1850    i3 = deloc%angs(1,3,iang)
1851    s3 = deloc%angs(2,3,iang)
1852    r3(:) = xcart(:,i3)+deloc%rshift(1,s3)*rprimd(:,1)&
1853 &   +deloc%rshift(2,s3)*rprimd(:,2)&
1854 &   +deloc%rshift(3,s3)*rprimd(:,3)
1855    prim_int(iprim) = angle_ang(r1,r2,r3)
1856    iprim=iprim+1
1857  end do
1858 
1859 !third: dihedral values
1860  do idihed=1,deloc%ndihed
1861    i1 = deloc%dihedrals(1,1,idihed)
1862    s1 = deloc%dihedrals(2,1,idihed)
1863    r1(:) = xcart(:,i1)+deloc%rshift(1,s1)*rprimd(:,1)&
1864 &   +deloc%rshift(2,s1)*rprimd(:,2)&
1865 &   +deloc%rshift(3,s1)*rprimd(:,3)
1866    i2 = deloc%dihedrals(1,2,idihed)
1867    s2 = deloc%dihedrals(2,2,idihed)
1868    r2(:) = xcart(:,i2)+deloc%rshift(1,s2)*rprimd(:,1)&
1869 &   +deloc%rshift(2,s2)*rprimd(:,2)&
1870 &   +deloc%rshift(3,s2)*rprimd(:,3)
1871    i3 = deloc%dihedrals(1,3,idihed)
1872    s3 = deloc%dihedrals(2,3,idihed)
1873    r3(:) = xcart(:,i3)+deloc%rshift(1,s3)*rprimd(:,1)&
1874 &   +deloc%rshift(2,s3)*rprimd(:,2)&
1875 &   +deloc%rshift(3,s3)*rprimd(:,3)
1876    i4 = deloc%dihedrals(1,4,idihed)
1877    s4 = deloc%dihedrals(2,4,idihed)
1878    r4(:) = xcart(:,i4)+deloc%rshift(1,s4)*rprimd(:,1)&
1879 &   +deloc%rshift(2,s4)*rprimd(:,2)&
1880 &   +deloc%rshift(3,s4)*rprimd(:,3)
1881    prim_int(iprim) = angle_dihedral(r1,r2,r3,r4)
1882    iprim=iprim+1
1883  end do
1884 
1885  do icart=1,deloc%ncart
1886    prim_int(iprim) = xcart(deloc%carts(1,icart),deloc%carts(2,icart))
1887    iprim=iprim+1
1888  end do
1889 
1890 !DEBUG
1891 !write(std_out,*) 'Primitive internal coordinate values:'
1892 !do iprim=1,ninternal
1893 !if (iprim <= deloc%nbond) then
1894 !write(std_out,*) iprim, prim_int(iprim)
1895 !else
1896 !write(std_out,*) iprim, prim_int(iprim), prim_int(iprim)/pi*180.0_dp
1897 !end if
1898 !end do
1899 !ENDDEBUG
1900 
1901 end subroutine calc_prim_int

m_abimover/delocint [ Types ]

[ Top ] [ m_abimover ] [ Types ]

NAME

 delocint

FUNCTION

 Datatype with the important variables in pred_delocint

NOTES

   deloc <type(delocint)>=Important variables for pred_delocint
   |
   ! icenter  = Index of the center of the number of shifts
   | nang     = Number of angles
   | nbond    = Number of bonds
   | ncart    = Number of cartesian directions (used for constraints)
   | ndihed   = Number of dihedrals
   | nrshift  = Dimension of rshift
   | ninternal= Number of internal coordinates
   |            ninternal=nbond+nang+ndihed+ncart
   | angs(2,3,nang)  = Indexes to characterize angles
   | bonds(2,2,nbond)= For a bond between iatom and jatom
   |                   bonds(1,1,nbond) = iatom
   |                   bonds(2,1,nbond) = icenter
   |                   bonds(1,2,nbond) = jatom
   |                   bonds(2,2,nbond) = irshift
   | carts(2,ncart)  = Index of total primitive internal, and atom (carts(2,:))
   | dihedrals(2,4,ndihed)= Indexes to characterize dihedrals
   | rshift(3,nrshift)= Shift in xred that must be done to find
   |                    all neighbors of a given atom within a
   |                    given number of neighboring shells

SOURCE

217 type,public :: delocint
218 
219 ! scalars
220  integer :: icenter
221  integer :: nang
222  integer :: nbond
223  integer :: ncart
224  integer :: ndihed
225  integer :: nrshift
226  integer :: ninternal
227 
228 ! arrays
229  integer,allocatable :: angs(:,:,:)
230  integer,allocatable :: bonds(:,:,:)
231  integer,allocatable :: carts(:,:)
232  integer,allocatable :: dihedrals(:,:,:)
233  real(dp),allocatable :: rshift(:,:)
234 
235 end type delocint

m_abimover/delocint_fin [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 delocint_fin

FUNCTION

 destructor function for delocint object

 INPUT
 deloc= container object for delocalized internal coordinates

OUTPUT

PARENTS

      m_abimover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

2581 subroutine delocint_fin(deloc)
2582 
2583 
2584 !This section has been created automatically by the script Abilint (TD).
2585 !Do not modify the following lines by hand.
2586 #undef ABI_FUNC
2587 #define ABI_FUNC 'delocint_fin'
2588 !End of the abilint section
2589 
2590  type(delocint), intent(inout) :: deloc
2591 
2592  if(allocated(deloc%angs))  then
2593    ABI_DEALLOCATE(deloc%angs)
2594  end if
2595  if(allocated(deloc%bonds))  then
2596    ABI_DEALLOCATE(deloc%bonds)
2597  end if
2598  if(allocated(deloc%carts))  then
2599    ABI_DEALLOCATE(deloc%carts)
2600  end if
2601  if(allocated(deloc%dihedrals))  then
2602    ABI_DEALLOCATE(deloc%dihedrals)
2603  end if
2604  if(allocated(deloc%rshift))  then
2605    ABI_DEALLOCATE(deloc%rshift)
2606  end if
2607 
2608 end subroutine delocint_fin

m_abimover/delocint_ini [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 delocint_ini

FUNCTION

 ini function for delocint object

 INPUT

OUTPUT

SIDE EFFECTS

 deloc= container object for delocalized internal coordinates

PARENTS

CHILDREN

SOURCE

2519 subroutine delocint_ini(deloc)
2520 
2521 
2522 !This section has been created automatically by the script Abilint (TD).
2523 !Do not modify the following lines by hand.
2524 #undef ABI_FUNC
2525 #define ABI_FUNC 'delocint_ini'
2526 !End of the abilint section
2527 
2528  implicit none
2529 
2530  !Arguments ------------------------------------
2531  !scalars
2532  type(delocint), intent(out) :: deloc
2533 
2534  !Local variables ------------------------------
2535  !scalars
2536  integer :: ii,irshift,jj,kk,nshell
2537 
2538 ! *********************************************************************
2539 
2540    nshell=3
2541    deloc%nrshift=(2*nshell+1)**3
2542    deloc%icenter = nshell*(2*nshell+1)**2 + nshell*(2*nshell+1) + nshell + 1
2543 
2544    ABI_ALLOCATE(deloc%rshift,(3,deloc%nrshift))
2545    irshift=0
2546    do ii=-nshell,nshell
2547      do jj=-nshell,nshell
2548        do kk=-nshell,nshell
2549          irshift=irshift+1
2550          deloc%rshift(:,irshift) = (/dble(ii),dble(jj),dble(kk)/)
2551        end do
2552      end do
2553    end do
2554 
2555 end subroutine delocint_ini

m_abimover/go_angles [ Types ]

[ Top ] [ m_abimover ] [ Types ]

NAME

 go_angles

FUNCTION

 Datatype all the information relevant to create
 angles between atoms inside and outside the cell

NOTES

  This type is not used

SOURCE

386 type, public :: go_angles
387 
388  !scalar
389  integer  :: nangles ! Total number of bonds for the system
390 
391  !arrays
392  integer,allocatable  :: angle_vertex(:)  ! Indices of the vertex atom
393  real(dp),allocatable :: angle_value(:)   ! Value of angle in radians
394  real(dp),allocatable :: angle_bonds(:,:) ! Indices of the bonds
395  real(dp),allocatable :: angle_vect(:,:)  ! Unitary vector perpendicular to the plane
396 
397 end type go_angles
398 
399 !public :: make_angles_new ! This routine is broken and should be tested before use.

m_abimover/go_bonds [ Types ]

[ Top ] [ m_abimover ] [ Types ]

NAME

 go_bonds

FUNCTION

 Datatype all the information relevant to create
 bonds between atoms inside and outside the cell

SOURCE

349 type, public ::  go_bonds
350 
351 !scalar
352 real(dp) :: tolerance ! To decide if consider bond the atom or not
353                       ! 1.0 means that only consider values lower
354                       ! than the sum of covalent radius
355 
356 integer  :: nbonds ! Total number of bonds for the system
357 
358 !arrays
359 
360 integer,allocatable :: nbondi(:)    ! Number of bonds for atom i
361 integer,allocatable :: indexi(:,:)  ! Indices of bonds for atom i
362                                 ! Positive: Vector from i to j
363                                 ! Negative: Vector from j to i
364 
365 real(dp),allocatable :: bond_length(:) ! Bond lengths
366 real(dp),allocatable :: bond_vect(:,:) ! Unitary vectors for bonds
367 
368 end type go_bonds

m_abimover/make_angles [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 make_angles

FUNCTION

  (to be completed)

INPUTS

  (to be completed)

OUTPUT

  (to be completed)

PARENTS

      m_abimover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

1375 subroutine make_angles(deloc,natom)
1376 
1377 
1378 !This section has been created automatically by the script Abilint (TD).
1379 !Do not modify the following lines by hand.
1380 #undef ABI_FUNC
1381 #define ABI_FUNC 'make_angles'
1382 !End of the abilint section
1383 
1384  implicit none
1385 
1386 !Arguments ------------------------------------
1387 !scalars
1388  integer,intent(in) :: natom
1389  type(delocint),intent(inout) :: deloc
1390 !arrays
1391 
1392 !Local variables-------------------------------
1393 !scalars
1394  integer :: ia1,ia2,iang,ibond,is1,is2,ishift,ja1,ja2
1395  integer :: jbond,js1,js2
1396 !arrays
1397  integer,allocatable :: angs_tmp(:,:,:)
1398 
1399 ! *************************************************************************
1400 
1401 !tentative first allocation: < 6 angles per bond.
1402  ABI_ALLOCATE(angs_tmp,(2,3,72*natom))
1403 
1404  deloc%nang = 0
1405 
1406  do ibond=1, deloc%nbond
1407    ia1 = deloc%bonds(1,1,ibond)
1408    is1 = deloc%bonds(2,1,ibond)
1409    ia2 = deloc%bonds(1,2,ibond)
1410    is2 = deloc%bonds(2,2,ibond)
1411    do jbond=ibond+1,deloc%nbond
1412      ja1 = deloc%bonds(1,1,jbond)
1413      ja2 = deloc%bonds(1,2,jbond)
1414      do ishift=-(deloc%icenter-1),+(deloc%icenter-1)
1415        js1 = deloc%bonds(2,1,jbond)+ishift
1416        js2 = deloc%bonds(2,2,jbond)+ishift
1417 
1418        if      (ia1==ja1 .and. is1==js1) then
1419          deloc%nang = deloc%nang+1
1420          angs_tmp(:,1,deloc%nang) = (/ia2,is2/)
1421          angs_tmp(:,2,deloc%nang) = (/ia1,is1/)
1422          angs_tmp(:,3,deloc%nang) = (/ja2,js2/)
1423 
1424        else if (ia1==ja2 .and. is1==js2) then
1425          deloc%nang = deloc%nang+1
1426          angs_tmp(:,1,deloc%nang) = (/ia2,is2/)
1427          angs_tmp(:,2,deloc%nang) = (/ia1,is1/)
1428          angs_tmp(:,3,deloc%nang) = (/ja1,js1/)
1429 
1430        else if (ia2==ja2 .and. is2==js2) then
1431          deloc%nang = deloc%nang+1
1432          angs_tmp(:,1,deloc%nang) = (/ia1,is1/)
1433          angs_tmp(:,2,deloc%nang) = (/ia2,is2/)
1434          angs_tmp(:,3,deloc%nang) = (/ja1,js1/)
1435 
1436        else if (ia2==ja1 .and. is2==js1) then
1437          deloc%nang = deloc%nang+1
1438          angs_tmp(:,1,deloc%nang) = (/ia1,is1/)
1439          angs_tmp(:,2,deloc%nang) = (/ia2,is2/)
1440          angs_tmp(:,3,deloc%nang) = (/ja2,js2/)
1441 
1442        end if
1443        if (deloc%nang > 72*natom) then
1444          MSG_ERROR('too many angles found > 72*natom')
1445        end if
1446      end do
1447    end do ! jbond do
1448  end do ! ibond
1449 
1450  if (allocated(deloc%angs)) then
1451    ABI_FREE(deloc%angs)
1452  end if
1453  ABI_ALLOCATE(deloc%angs,(2,3,deloc%nang))
1454  do iang=1,deloc%nang
1455    deloc%angs(:,:,iang) = angs_tmp(:,:,iang)
1456  end do
1457  ABI_DEALLOCATE(angs_tmp)
1458 
1459 end subroutine make_angles

m_abimover/make_angles_new [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 make_angles_new

FUNCTION

  Fill the contents of the angles structure, that contains
  all non redundant angles that could be generated between
  all the atoms in the unitary cell and their adjacent cells
  An angle is establish when an atom has two or more bonds.
  The angles structure contains information about the atoms
  involved, the value of the angle in radians, and the unitary
  vector perpendicular to the plane of the three atoms that
  build the angle.

INPUTS

  natom=  Number of atoms
  ntypat= Number of type of atoms
  rprimd= Dimensional primitive vectors of the cell
  xcart=  Cartesian coordinates of the atoms
  znucl=  Z number of the atom
  bonds= Structure that store all the information about
         bonds created by this routine:
         nbonds=  Total number of bonds
         nbondi=  Number of bonds for atom i
         indexi=  Indeces of bonds for atom i
         bond_length=  Distances between atoms i and j (including shift)
         bond_vect=    Unitary vector for the bond from i to j
         tolerance=    The tolerance is multiplied to the
                       adition of covalent radius to decide if a bond is created

OUTPUT

  angles=  Structure that store the information about
           angles created by this routine
          nangles= Total number of angles
          angle_vertex= Index of the atom for that angle
          angle_value= Value of the angle in radians
          angle_bonds=  Indices of the bonds
          angle_vect=   Unitary vector perpendicular to the plane of the angle

PARENTS

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

2659 !This routine has been disables since it's broken
2660 #if 0
2661 
2662 subroutine make_angles_new(angles,bonds,natom,ntypat,rprimd,typat,xcart,znucl)
2663 
2664 
2665 !This section has been created automatically by the script Abilint (TD).
2666 !Do not modify the following lines by hand.
2667 #undef ABI_FUNC
2668 #define ABI_FUNC 'make_angles_new'
2669 !End of the abilint section
2670 
2671  implicit none
2672 
2673 !Arguments ------------------------------------
2674 !scalars
2675 integer,intent(in) :: natom,ntypat
2676 !arrays
2677 integer,intent(in) :: typat(natom)
2678 real(dp),intent(in) :: znucl(ntypat)
2679 real(dp),intent(in) :: rprimd(3,3),xcart(3,natom)
2680 type(go_bonds),intent(in) :: bonds
2681 type(go_angles),intent(inout) :: angles
2682 
2683 !Local variables ------------------------------
2684 !scalars
2685 integer :: ii,jj,kk,iangle
2686 type(atomdata_t) :: atom
2687 
2688 !arrays
2689 type(go_bonds) :: bonds_tmp
2690 character(len=2) :: symbol(ntypat)
2691 real(dp) :: amu(ntypat)
2692 integer :: shift(3,13) ! Represent all shift vectors that are not equivalent by central symmetry
2693 ! For example (1,1,-1) is equivalent to (-1,-1,1)
2694 ! It means that bond between atom i in the original cell and atom j in the
2695 ! cell with cordinates (1,1,-1) is equivalent to the bond between atom j in
2696 ! the orignal cell and atom i in the cell with coordinates (-1,-1,1)
2697 ! The trivial shift (0,0,0) is excluded here
2698 real(dp) :: rcov(ntypat) ! Covalent radius
2699 real(dp) :: rpt(3)
2700 
2701 !***************************************************************************
2702 !Beginning of executable session
2703 !***************************************************************************
2704  MSG_ERROR("This routine is not tested")
2705 
2706 !write(std_out,*) 'make_bonds 01'
2707 !##########################################################
2708 !### 01. Compute covalent radius
2709 
2710  do ii=1,ntypat
2711    call atomdata_from_znucl(atom,znucl(ii))
2712    amu(ii) = atom%amu
2713    rcov(ii) = atom%rcov
2714    symbol(ii) = symbol(ii)
2715  end do
2716 
2717 !write(std_out,*) 'make_bonds 02'
2718 !##########################################################
2719 !### 02. Fill the 13 posible shift conecting adjacent cells
2720 
2721  shift(:,:)=reshape( (/ 1,0,0,&
2722 & 0, 1, 0,&
2723 & 0, 0, 1,&
2724 & 1, 1, 0,&
2725 & 1,-1, 0,&
2726 & 0, 1, 1,&
2727 & 0, 1,-1,&
2728 & 1, 0, 1,&
2729 & 1, 0,-1,&
2730 & 1, 1, 1,&
2731 & 1,-1, 1,&
2732 & 1, 1,-1,&
2733 & 1,-1,-1 /), (/ 3, 13 /))
2734 
2735 !write(std_out,*) 'make_bonds 03'
2736 !##########################################################
2737 !### 03. Initialize the values of bonds
2738 
2739 !The total number of bonds could not be predicted without
2740 !compute all the distances, but the extreme case is linking
2741 !all the atoms within all adjacent cells (natom*natom*13)
2742 !plus the all the bonds inside the original cell (natom*(natom-1))
2743 
2744  bonds_tmp%nbonds=0
2745  bonds_tmp%tolerance=bonds%tolerance
2746  ibond=0
2747 
2748  ABI_ALLOCATE(bonds_tmp%bond_vect,(3,natom*natom*14-natom))
2749  ABI_ALLOCATE(bonds_tmp%bond_length,(natom*natom*14-natom))
2750 
2751 !indexi contains the indeces to the bonds
2752  ABI_ALLOCATE(bonds_tmp%indexi,(natom,natom*natom*14-natom))
2753 
2754  ABI_ALLOCATE(bonds_tmp%nbondi,(natom))
2755 
2756  bonds_tmp%indexi(:,:)=0
2757  bonds_tmp%nbondi(:)=0
2758 
2759 !write(std_out,*) 'make_bonds 04'
2760 !##########################################################
2761 !### 04. Compute the bonds inside the original cell
2762 !### shift=(0,0,0)
2763 
2764  do ii=1,natom
2765    rcov1 = rcov(typat(ii))
2766 
2767    do jj=ii+1,natom
2768      rcov2 = rcov(typat(jj))
2769 
2770      bl=bond_length(xcart(:,ii),xcart(:,jj))
2771 
2772      if (bonds_tmp%tolerance*(rcov1+rcov2) > bl) then
2773 !      We have a new bond, nbonds starts from
2774 !      0, so it could be used to index the
2775 !      locations of bondij and distij
2776 
2777 !      Increase the number of bonds
2778        bonds_tmp%nbonds= bonds_tmp%nbonds+1
2779 
2780 !      The number of bonds for atoms ii and jj
2781 !      needs to raise by one
2782        bonds_tmp%nbondi(ii)= bonds_tmp%nbondi(ii)+1
2783        bonds_tmp%nbondi(jj)= bonds_tmp%nbondi(jj)+1
2784 
2785        bonds_tmp%indexi(ii,bonds_tmp%nbondi(ii))=bonds_tmp%nbonds
2786 !      The value for jj is negative to indicate that
2787 !      the vector is from ii to jj
2788        bonds_tmp%indexi(jj,bonds_tmp%nbondi(jj))=-bonds_tmp%nbonds
2789 
2790 !      The unitary vector is always from ii to jj
2791        bonds_tmp%bond_vect(:,bonds_tmp%nbonds)=(xcart(:,jj)-xcart(:,ii))/bl
2792        bonds_tmp%bond_length(bonds_tmp%nbonds)=bl
2793 
2794      end if
2795 
2796    end do !! jj
2797  end do !! ii
2798 
2799 !write(std_out,*) 'make_bonds 05'
2800 !##########################################################
2801 !### 05. Compute the bonds outside the original cell
2802 !###     13 shifts considered
2803 
2804 !Bonds between identical atoms but in diferent cells are
2805 !allowed
2806 
2807  do ii=1,natom
2808    rcov1 = rcov(typat(ii))
2809    do jj=1,natom
2810      rcov2 = rcov(typat(jj))
2811 
2812      do irshift=1,13
2813 
2814        do kk=1,3
2815          rpt(kk) = xcart(kk,jj)+&
2816 &         shift(1,irshift)*rprimd(kk,1)+ &
2817 &         shift(2,irshift)*rprimd(kk,2)+ &
2818 &         shift(3,irshift)*rprimd(kk,3)
2819        end do
2820 
2821 
2822        bl =bond_length(xcart(:,ii),rpt)
2823 
2824        if (bonds_tmp%tolerance*(rcov1+rcov2) > bl) then
2825 
2826 !        We have a new bond, nbonds starts from
2827 !        0, so it could be used to index the
2828 !        locations of bondij and distij
2829 
2830 !        Increase the number of bonds
2831          bonds_tmp%nbonds= bonds_tmp%nbonds+1
2832 
2833 !        The number of bonds for atoms ii and jj
2834 !        needs to raise by one
2835          bonds_tmp%nbondi(ii)= bonds_tmp%nbondi(ii)+1
2836          bonds_tmp%indexi(ii,bonds_tmp%nbondi(ii))=bonds_tmp%nbonds
2837 
2838 !        The value for jj is negative to indicate that
2839 !        the vector is from ii to jj
2840          bonds_tmp%nbondi(jj)= bonds_tmp%nbondi(jj)+1
2841          bonds_tmp%indexi(jj,bonds_tmp%nbondi(jj))=-bonds_tmp%nbonds
2842 
2843 !        The unitary vector is always from ii to jj
2844          bonds_tmp%bond_vect(:,bonds_tmp%nbonds)=(rpt(:)-xcart(:,ii))/bl
2845          bonds_tmp%bond_length(bonds_tmp%nbonds)=bl
2846 
2847          if (ii==jj) then
2848            bonds_tmp%nbonds= bonds_tmp%nbonds+1
2849          end if
2850 
2851        end if
2852 
2853      end do !! irshift
2854 
2855    end do !! jj
2856  end do !! ii
2857 
2858  call print_bonds(amu,bonds_tmp,natom,ntypat,symbol,typat,znucl)
2859 
2860 
2861 !write(std_out,*) 'make_bonds 05'
2862 !##########################################################
2863 !### 05. Deallocate all the arrays inside bonds
2864 !###     allocate them with the right size and fill them
2865 
2866  call bonds_free(bonds)
2867 
2868  bonds%nbonds=bonds_tmp%nbonds
2869 
2870  if (bonds%nbonds>0) then
2871 !  Allocate the arrays with exactly the rigth nbonds
2872    ABI_ALLOCATE(bonds%bond_vect,(3,bonds%nbonds))
2873    ABI_ALLOCATE(bonds%bond_length,(bonds%nbonds))
2874    ABI_ALLOCATE(bonds%indexi,(natom,bonds%nbonds))
2875    ABI_ALLOCATE(bonds%nbondi,(natom))
2876 
2877 !  Fill the values
2878    bonds%bond_vect(:,1:bonds%nbonds)=bonds_tmp%bond_vect(:,1:bonds%nbonds)
2879    bonds%bond_length(1:bonds%nbonds)=bonds_tmp%bond_length(1:bonds%nbonds)
2880    bonds%indexi(:,1:bonds%nbonds)=bonds_tmp%indexi(:,1:bonds%nbonds)
2881    bonds%nbondi(:)=bonds_tmp%nbondi(:)
2882  end if
2883 
2884  call bonds_free(bonds_tmp)
2885 
2886 end subroutine make_angles_new

m_abimover/make_bonds [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 make_bonds

FUNCTION

  (to be completed)

INPUTS

  (to be completed)

OUTPUT

  (to be completed)

PARENTS

      m_abimover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

1641 subroutine make_bonds(deloc,natom,ntypat,rprimd,typat,xcart,znucl)
1642 
1643 
1644 !This section has been created automatically by the script Abilint (TD).
1645 !Do not modify the following lines by hand.
1646 #undef ABI_FUNC
1647 #define ABI_FUNC 'make_bonds'
1648 !End of the abilint section
1649 
1650  implicit none
1651 
1652 !Arguments ------------------------------------
1653 !scalars
1654  integer,intent(in) :: natom,ntypat
1655  type(delocint),intent(inout) :: deloc
1656 !arrays
1657  integer,intent(in) :: typat(natom)
1658  real(dp),intent(in) :: znucl(:) ! znucl(ntypat) or
1659                                  ! znucl(npsp) ?
1660  real(dp),intent(in) :: rprimd(3,3),xcart(3,natom)
1661 
1662 !Local variables ------------------------------
1663 !scalars
1664  integer :: iatom,ibond,irshift,itypat,jatom
1665  real(dp) :: bl,bondfudge,rcov1,rcov2
1666  type(atomdata_t) :: atom
1667 !arrays
1668  integer,allocatable :: bonds_tmp(:,:,:)
1669  real(dp) :: rcov(ntypat),rpt(3)
1670 
1671 !************************************************************************
1672 
1673  do itypat=1,ntypat
1674    call atomdata_from_znucl(atom,znucl(itypat))
1675    rcov(itypat) = atom%rcov
1676  end do
1677 
1678 !write(std_out,*) ' rcov =', rcov
1679 !write(std_out,*) ' nrshift =', deloc%nrshift
1680 !write(std_out,*) ' xcart =', xcart
1681 !write(std_out,*) ' natom =',natom
1682 
1683 !tentative first allocation: < 12 bonds per atom.
1684  ABI_ALLOCATE(bonds_tmp,(2,2,12*natom))
1685 
1686  bondfudge = 1.1_dp
1687 
1688  deloc%nbond = 0
1689 
1690  do iatom=1,natom
1691    rcov1 = rcov(typat(iatom))
1692    do jatom=iatom+1,natom
1693      rcov2 = rcov(typat(jatom))
1694      do irshift=1,deloc%nrshift
1695        rpt(:) = xcart(:,jatom) &
1696 &       + deloc%rshift(1,irshift)*rprimd(:,1) &
1697 &       + deloc%rshift(2,irshift)*rprimd(:,2) &
1698 &       + deloc%rshift(3,irshift)*rprimd(:,3)
1699        bl =  bond_length(xcart(:,iatom),rpt)
1700 
1701        !write(std_out,*) ' bl, bondfudge*(rcov1+rcov2) = ',bl, bondfudge*(rcov1+rcov2)
1702 
1703        if (bondfudge*(rcov1+rcov2) - bl > tol6) then
1704          deloc%nbond = deloc%nbond+1
1705          if (deloc%nbond > 12*natom) then
1706            MSG_ERROR('make_bonds: error too many bonds !')
1707          end if
1708          bonds_tmp(1,1,deloc%nbond) = iatom
1709          bonds_tmp(2,1,deloc%nbond) = deloc%icenter
1710          bonds_tmp(1,2,deloc%nbond) = jatom
1711          bonds_tmp(2,2,deloc%nbond) = irshift
1712 
1713          !write(std_out,*) ' ibond bonds = ', deloc%nbond, bonds_tmp(:,:,deloc%nbond),xcart(:,iatom),rpt
1714        end if
1715      end do ! jatom
1716    end do
1717  end do ! iatom
1718 
1719  if (allocated(deloc%bonds)) then
1720    ABI_FREE(deloc%bonds)
1721  end if
1722 
1723  ABI_ALLOCATE(deloc%bonds,(2,2,deloc%nbond))
1724  do ibond=1,deloc%nbond
1725    deloc%bonds(:,:,ibond) = bonds_tmp(:,:,ibond)
1726  end do
1727 
1728 ! do ibond=1,deloc%nbond
1729 ! write(std_out,*) ' make_bonds : bonds_tmp ', ibond, bonds_tmp(:,:,ibond)
1730 ! write(std_out,*) ' make_bonds : deloc%bonds ', ibond, deloc%bonds(:,:,ibond)
1731 ! end do
1732 
1733   ABI_DEALLOCATE(bonds_tmp)
1734 
1735 end subroutine make_bonds

m_abimover/make_bonds_new [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 make_bonds_new

FUNCTION

  Fill the contents of the bonds structure, that contains
  all non redundant bonds that could be generated between
  all the atoms in the unitary cell and their adjacent cells

INPUTS

  natom=  Number of atoms
  ntypat= Number of type of atoms
  rprimd= Dimensional primitive vectors of the cell
  xcart=  Cartesian coordinates of the atoms
  znucl=  Z number of the atom

OUTPUT

  bonds= Structure that store all the information about
         bonds created by this routine:
         nbonds=  Total number of bonds
         nbondi=  Number of bonds for atom i
         indexi=  Indeces of bonds for atom i
         bond_length=  Distances between atoms i and j (including shift)
         bond_vect=    Unitary vector for the bond from i to j
         tolerance=    The tolerance is multiplied to the
                       adition of covalent radius to decide if a bond is created

PARENTS

      prec_simple

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

2122 subroutine make_bonds_new(bonds,natom,ntypat,rprimd,typat,xcart,znucl)
2123 
2124 
2125 !This section has been created automatically by the script Abilint (TD).
2126 !Do not modify the following lines by hand.
2127 #undef ABI_FUNC
2128 #define ABI_FUNC 'make_bonds_new'
2129 !End of the abilint section
2130 
2131 implicit none
2132 
2133 !Arguments ------------------------------------
2134 !scalars
2135 integer,intent(in) :: natom,ntypat
2136 !arrays
2137 integer,intent(in) :: typat(natom)
2138 real(dp),intent(in) :: znucl(ntypat)
2139 real(dp),intent(in) :: rprimd(3,3),xcart(3,natom)
2140 type(go_bonds),intent(inout) :: bonds
2141 
2142 !Local variables ------------------------------
2143 !scalars
2144 integer :: ii,jj,kk,ibond,irshift
2145 real(dp) :: rcov1,rcov2
2146 real(dp) :: bl
2147 type(go_bonds) :: bonds_tmp
2148 type(atomdata_t) :: atom
2149 
2150 !arrays
2151 character(len=2) :: symbol(ntypat)
2152 real(dp) :: amu(ntypat)
2153 integer :: shift(3,13) ! Represent all shift vectors that are not equivalent by central symmetry
2154 ! For example (1,1,-1) is equivalent to (-1,-1,1)
2155 ! It means that bond between atom i in the original cell and atom j in the
2156 ! cell with cordinates (1,1,-1) is equivalent to the bond between atom j in
2157 ! the orignal cell and atom i in the cell with coordinates (-1,-1,1)
2158 ! The trivial shift (0,0,0) is excluded here
2159 real(dp) :: rcov(ntypat) ! Covalent radius
2160 real(dp) :: rpt(3)
2161 
2162 !***************************************************************************
2163 !Beginning of executable session
2164 !***************************************************************************
2165 
2166 !write(std_out,*) 'make_bonds 01'
2167 !##########################################################
2168 !### 01. Compute covalent radius
2169 
2170  do ii=1,ntypat
2171    call atomdata_from_znucl(atom,znucl(ii))
2172    amu(ii) = atom%amu
2173    rcov(ii) = atom%rcov
2174    symbol(ii) = atom%symbol
2175  end do
2176 
2177 !write(std_out,*) 'make_bonds 02'
2178 !##########################################################
2179 !### 02. Fill the 13 posible shift conecting adjacent cells
2180 
2181  shift(:,:)=reshape( (/ 1,0,0,&
2182 & 0, 1, 0,&
2183 & 0, 0, 1,&
2184 & 1, 1, 0,&
2185 & 1,-1, 0,&
2186 & 0, 1, 1,&
2187 & 0, 1,-1,&
2188 & 1, 0, 1,&
2189 & 1, 0,-1,&
2190 & 1, 1, 1,&
2191 & 1,-1, 1,&
2192 & 1, 1,-1,&
2193 & 1,-1,-1 /), (/ 3, 13 /))
2194 
2195 !write(std_out,*) 'make_bonds 03'
2196 !##########################################################
2197 !### 03. Initialize the values of bonds
2198 
2199 !The total number of bonds could not be predicted without
2200 !compute all the distances, but the extreme case is linking
2201 !all the atoms within all adjacent cells (natom*natom*13)
2202 !plus the all the bonds inside the original cell (natom*(natom-1))
2203 
2204  bonds_tmp%nbonds=0
2205  bonds_tmp%tolerance=bonds%tolerance
2206  ibond=0
2207 
2208  ABI_ALLOCATE(bonds_tmp%bond_vect,(3,natom*natom*14-natom))
2209  ABI_ALLOCATE(bonds_tmp%bond_length,(natom*natom*14-natom))
2210 
2211 !indexi contains the indeces to the bonds
2212  ABI_ALLOCATE(bonds_tmp%indexi,(natom,natom*natom*14-natom))
2213 
2214  ABI_ALLOCATE(bonds_tmp%nbondi,(natom))
2215 
2216  bonds_tmp%indexi(:,:)=0
2217  bonds_tmp%nbondi(:)=0
2218  bonds_tmp%bond_vect(:,:)=0.0
2219  bonds_tmp%bond_length(:)=0.0
2220 
2221 !write(std_out,*) 'make_bonds 04'
2222 !##########################################################
2223 !### 04. Compute the bonds inside the original cell
2224 !### shift=(0,0,0)
2225 
2226  do ii=1,natom
2227    rcov1 = rcov(typat(ii))
2228 
2229    do jj=ii+1,natom
2230      rcov2 = rcov(typat(jj))
2231 
2232      bl=bond_length(xcart(:,ii),xcart(:,jj))
2233 
2234      if (bonds_tmp%tolerance*(rcov1+rcov2) > bl) then
2235 !      We have a new bond, nbonds starts from
2236 !      0, so it could be used to index the
2237 !      locations of bondij and distij
2238 
2239 !      Increase the number of bonds
2240        bonds_tmp%nbonds= bonds_tmp%nbonds+1
2241 
2242 !      The number of bonds for atoms ii and jj
2243 !      needs to raise by one
2244        bonds_tmp%nbondi(ii)= bonds_tmp%nbondi(ii)+1
2245        bonds_tmp%nbondi(jj)= bonds_tmp%nbondi(jj)+1
2246 
2247        bonds_tmp%indexi(ii,bonds_tmp%nbondi(ii))=bonds_tmp%nbonds
2248 !      The value for jj is negative to indicate that
2249 !      the vector is from ii to jj
2250        bonds_tmp%indexi(jj,bonds_tmp%nbondi(jj))=-bonds_tmp%nbonds
2251 
2252 !      The unitary vector is always from ii to jj
2253        bonds_tmp%bond_vect(:,bonds_tmp%nbonds)=(xcart(:,jj)-xcart(:,ii))/bl
2254        bonds_tmp%bond_length(bonds_tmp%nbonds)=bl
2255 
2256      end if
2257 
2258    end do !! jj
2259  end do !! ii
2260 
2261 !write(std_out,*) 'make_bonds 05'
2262 !##########################################################
2263 !### 05. Compute the bonds outside the original cell
2264 !###     13 shifts considered
2265 
2266 !Bonds between identical atoms but in diferent cells are
2267 !allowed
2268 
2269  do ii=1,natom
2270    rcov1 = rcov(typat(ii))
2271    do jj=1,natom
2272      rcov2 = rcov(typat(jj))
2273 
2274      do irshift=1,13
2275 
2276        do kk=1,3
2277          rpt(kk) = xcart(kk,jj)+&
2278 &         shift(1,irshift)*rprimd(kk,1)+ &
2279 &         shift(2,irshift)*rprimd(kk,2)+ &
2280 &         shift(3,irshift)*rprimd(kk,3)
2281        end do
2282 
2283 
2284        bl =bond_length(xcart(:,ii),rpt)
2285 
2286        if (bonds_tmp%tolerance*(rcov1+rcov2) > bl) then
2287 
2288 !        We have a new bond, nbonds starts from
2289 !        0, so it could be used to index the
2290 !        locations of bondij and distij
2291 
2292 !        Increase the number of bonds
2293          bonds_tmp%nbonds= bonds_tmp%nbonds+1
2294 
2295 !        The number of bonds for atoms ii and jj
2296 !        needs to raise by one
2297          bonds_tmp%nbondi(ii)= bonds_tmp%nbondi(ii)+1
2298          bonds_tmp%indexi(ii,bonds_tmp%nbondi(ii))=bonds_tmp%nbonds
2299 
2300 !        The value for jj is negative to indicate that
2301 !        the vector is from ii to jj
2302          bonds_tmp%nbondi(jj)= bonds_tmp%nbondi(jj)+1
2303          bonds_tmp%indexi(jj,bonds_tmp%nbondi(jj))=-bonds_tmp%nbonds
2304 
2305 !        The unitary vector is always from ii to jj
2306          bonds_tmp%bond_vect(:,bonds_tmp%nbonds)=(rpt(:)-xcart(:,ii))/bl
2307          bonds_tmp%bond_length(bonds_tmp%nbonds)=bl
2308 
2309          if (ii==jj) then
2310            bonds_tmp%nbonds= bonds_tmp%nbonds+1
2311          end if
2312 
2313        end if
2314 
2315      end do !! irshift
2316 
2317    end do !! jj
2318  end do !! ii
2319 
2320  call print_bonds(amu,bonds_tmp,natom,ntypat,symbol,typat,znucl)
2321 
2322 
2323 !write(std_out,*) 'make_bonds 05'
2324 !##########################################################
2325 !### 05. Deallocate all the arrays inside bonds
2326 !###     allocate them with the right size and fill them
2327 
2328  call bonds_free(bonds)
2329 
2330  bonds%nbonds=bonds_tmp%nbonds
2331 
2332  if (bonds%nbonds>0) then
2333 !  Allocate the arrays with exactly the rigth nbonds
2334    ABI_ALLOCATE(bonds%bond_vect,(3,bonds%nbonds))
2335    ABI_ALLOCATE(bonds%bond_length,(bonds%nbonds))
2336    ABI_ALLOCATE(bonds%indexi,(natom,bonds%nbonds))
2337    ABI_ALLOCATE(bonds%nbondi,(natom))
2338 
2339 !  Fill the values
2340    bonds%bond_vect(:,1:bonds%nbonds)=bonds_tmp%bond_vect(:,1:bonds%nbonds)
2341    bonds%bond_length(1:bonds%nbonds)=bonds_tmp%bond_length(1:bonds%nbonds)
2342    bonds%indexi(:,1:bonds%nbonds)=bonds_tmp%indexi(:,1:bonds%nbonds)
2343    bonds%nbondi(:)=bonds_tmp%nbondi(:)
2344  end if
2345 
2346  call bonds_free(bonds_tmp)
2347 
2348 end subroutine make_bonds_new

m_abimover/make_dihedrals [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 make_dihedrals

FUNCTION

  (to be completed)

INPUTS

  (to be completed)

OUTPUT

  (to be completed)

PARENTS

      m_abimover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

1485 subroutine make_dihedrals(badangles,deloc)
1486 
1487 
1488 !This section has been created automatically by the script Abilint (TD).
1489 !Do not modify the following lines by hand.
1490 #undef ABI_FUNC
1491 #define ABI_FUNC 'make_dihedrals'
1492 !End of the abilint section
1493 
1494  implicit none
1495 
1496 !Arguments ------------------------------------
1497 !scalars
1498  type(delocint),intent(inout) :: deloc
1499 !arrays
1500  integer,intent(in) :: badangles(deloc%nang)
1501 
1502 !Local variables-------------------------------
1503 !scalars
1504  integer :: chkdihed,ia1,ia2,ia3,iang,idihed,is1,is2
1505  integer :: is3,ishift,ja1,ja2,ja3,jang,js1,js2,js3,maxshift
1506  integer :: minshift
1507 !arrays
1508  integer,allocatable :: diheds_tmp(:,:,:)
1509 
1510 ! *************************************************************************
1511 
1512 !tentative first allocation: < 6 dihedrals per angle.
1513  ABI_ALLOCATE(diheds_tmp,(2,4,6*deloc%nang))
1514 
1515  deloc%ndihed = 0
1516  diheds_tmp(:,:,:) = 0
1517 
1518  do iang=1,deloc%nang
1519    if (badangles(iang) == 1) cycle
1520    ia1 = deloc%angs(1,1,iang)
1521    is1 = deloc%angs(2,1,iang)
1522    ia2 = deloc%angs(1,2,iang)
1523    is2 = deloc%angs(2,2,iang)
1524    ia3 = deloc%angs(1,3,iang)
1525    is3 = deloc%angs(2,3,iang)
1526 
1527    do jang=iang+1,deloc%nang
1528      if (badangles(jang) == 1) cycle
1529      ja1 = deloc%angs(1,1,jang)
1530      ja2 = deloc%angs(1,2,jang)
1531      ja3 = deloc%angs(1,3,jang)
1532      do ishift=-(deloc%icenter-1),(deloc%icenter-1)
1533        js1 = deloc%angs(2,1,jang)+ishift
1534        js2 = deloc%angs(2,2,jang)+ishift
1535        js3 = deloc%angs(2,3,jang)+ishift
1536 
1537        chkdihed=0
1538        if (ia2==ja1 .and. is2==js1) then
1539          if (ia1==ja2 .and. is1==js2) then
1540            deloc%ndihed = deloc%ndihed+1
1541            diheds_tmp(:,1,deloc%ndihed) = (/ia3,is3/)
1542            diheds_tmp(:,2,deloc%ndihed) = (/ia2,is2/)
1543            diheds_tmp(:,3,deloc%ndihed) = (/ja2,js2/)
1544            diheds_tmp(:,4,deloc%ndihed) = (/ja3,js3/)
1545            chkdihed=1
1546          else if (ia3==ja2 .and. is3==js2) then
1547            deloc%ndihed = deloc%ndihed+1
1548            diheds_tmp(:,1,deloc%ndihed) = (/ia1,is1/)
1549            diheds_tmp(:,2,deloc%ndihed) = (/ia2,is2/)
1550            diheds_tmp(:,3,deloc%ndihed) = (/ja2,js2/)
1551            diheds_tmp(:,4,deloc%ndihed) = (/ja3,js3/)
1552            chkdihed=1
1553          end if
1554        else if (ia2==ja3 .and. is2==js3) then
1555          if (ia1==ja2 .and. is1==js2) then
1556            deloc%ndihed = deloc%ndihed+1
1557            diheds_tmp(:,1,deloc%ndihed) = (/ia3,is3/)
1558            diheds_tmp(:,2,deloc%ndihed) = (/ia2,is2/)
1559            diheds_tmp(:,3,deloc%ndihed) = (/ja2,js2/)
1560            diheds_tmp(:,4,deloc%ndihed) = (/ja1,js1/)
1561            chkdihed=1
1562          else if (ia3==ja2 .and. is3==js2) then
1563            deloc%ndihed = deloc%ndihed+1
1564            diheds_tmp(:,1,deloc%ndihed) = (/ia1,is1/)
1565            diheds_tmp(:,2,deloc%ndihed) = (/ia2,is2/)
1566            diheds_tmp(:,3,deloc%ndihed) = (/ja2,js2/)
1567            diheds_tmp(:,4,deloc%ndihed) = (/ja1,js1/)
1568            chkdihed=1
1569          end if
1570        end if
1571        if (deloc%ndihed > 6*deloc%nang) then
1572          MSG_ERROR('make_dihedrals : too many dihedrals found > 6*nang')
1573        end if
1574        if (chkdihed == 1) then
1575          if (   diheds_tmp(1,4,deloc%ndihed) == diheds_tmp(1,1,deloc%ndihed) .and.&
1576 &         diheds_tmp(2,4,deloc%ndihed) == diheds_tmp(2,1,deloc%ndihed) ) then
1577            write(std_out,*) 'make_dihedrals : Bad dihedral was found: atom1 == atom4. Discarding.'
1578            diheds_tmp(:,:,deloc%ndihed) = 0
1579            deloc%ndihed = deloc%ndihed-1
1580          end if
1581        end if
1582      end do
1583    end do
1584 !  end jang do
1585  end do
1586 !end iang do
1587 
1588  if (allocated(deloc%dihedrals)) then
1589    ABI_FREE(deloc%dihedrals)
1590  end if
1591 
1592  ABI_ALLOCATE(deloc%dihedrals,(2,4,deloc%ndihed))
1593  do idihed=1,deloc%ndihed
1594    deloc%dihedrals(:,:,idihed) = diheds_tmp(:,:,idihed)
1595 
1596 !  minshift = minval(diheds_tmp(2,:,idihed))
1597 !  if (minshift <= 0) then
1598 !  deloc%dihedrals(2,:,idihed) = deloc%dihedrals(2,:,idihed)+minshift+1
1599 !  end if
1600 !  maxshift = maxval(diheds_tmp(2,:,idihed))
1601 !  if (maxshift > deloc%nrshift) then
1602 !  deloc%dihedrals(2,:,idihed) = deloc%dihedrals(2,:,idihed)-maxshift
1603 !  end if
1604 !
1605    minshift = minval(diheds_tmp(2,:,idihed))
1606    maxshift = maxval(diheds_tmp(2,:,idihed))
1607    if (minshift <= 0 .or. maxshift > deloc%nrshift) then
1608      write(std_out,*) ' make_dihedrals : Error : dihedral extends beyond '
1609      write(std_out,*) '  first neighboring unit cells ! '
1610      MSG_ERROR("Aborting now")
1611    end if
1612  end do
1613  ABI_DEALLOCATE(diheds_tmp)
1614 
1615 end subroutine make_dihedrals

m_abimover/make_prim_internals [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 make_prim_internals

FUNCTION

  Determine the bonds, angles and dihedrals for a starting
  geometry, based on covalent radii for the atoms.

INPUTS

 natom  = Number of atoms (dtset%natom)
 nrshift= dimension of rshift
 rprimd(3,3)=dimensional real space primitive translations (bohr)
 rshift(3,nrshift)=shift in xred that must be done to find all neighbors of
                   a given atom within a given number of neighboring shells
 xcart(3,natom)=cartesian coordinates of atoms (bohr)

OUTPUT

SIDE EFFECTS

   deloc <type(delocint)>=Important variables for
   |                           pred_delocint
   ! icenter  = Index of the center of the number of shifts 
   | nang     = Number of angles
   | nbond    = Number of bonds
   | ncart    = Number of cartesian directions
   |             (used for constraints)
   | ndihed   = Number of dihedrals
   | nrshift  = Dimension of rshift
   | ninternal= Number of internal coordinates
   |            ninternal=nbond+nang+ndihed+ncart
   |
   | angs(2,3,nang)  = Indexes to characterize angles
   | bonds(2,2,nbond)= For a bond between iatom and jatom
   |                   bonds(1,1,nbond) = iatom
   |                   bonds(2,1,nbond) = icenter
   |                   bonds(1,2,nbond) = jatom
   |                   bonds(2,2,nbond) = irshift
   | carts(2,ncart)  = Index of total primitive internal,
   |                   and atom (carts(2,:))
   | dihedrals(2,4,ndihed)= Indexes to characterize dihedrals
   |
   | rshift(3,nrshift)= Shift in xred that must be done to find
   |                    all neighbors of a given atom within a
   |                    given number of neighboring shells

NOTES

   Adds cartesian coordinates if the number of internals with a
   given atom is < 4 the chosen coordinate could be optimized
   to be less dependent of the internals already incorporated.

PARENTS

      pred_delocint

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

1200 subroutine make_prim_internals(deloc,natom,ntypat,rprimd,typat,xcart,znucl)
1201 
1202 
1203 !This section has been created automatically by the script Abilint (TD).
1204 !Do not modify the following lines by hand.
1205 #undef ABI_FUNC
1206 #define ABI_FUNC 'make_prim_internals'
1207 !End of the abilint section
1208 
1209  implicit none
1210 
1211 !Arguments ------------------------------------
1212 !scalars
1213  type(delocint),intent(inout) :: deloc
1214  integer,intent(in) :: natom,ntypat
1215 !arrays
1216  real(dp),intent(in) :: rprimd(3,3),xcart(3,natom)
1217  integer,intent(in) :: typat(natom)
1218  real(dp),intent(in) :: znucl(:) ! znucl(ntypat) or znucl(npsp) ?
1219 
1220 !Local variables ------------------------------
1221 ! function
1222 !scalars
1223  integer :: iang,iatom,ibond,icart,idihed,ii
1224  real(dp) :: spp
1225 !arrays
1226  integer :: particip_atom(natom)
1227  integer,allocatable :: badangles(:)
1228  real(dp) :: rpt1(3),rpt3(3) !rpt2(3)
1229 
1230 !************************************************************************
1231 
1232  particip_atom(:) = 0
1233 
1234  call make_bonds(deloc,natom,ntypat,rprimd,typat,xcart,znucl)
1235 
1236  do ibond=1,deloc%nbond
1237    write(std_out,'(a,i4,2(2i5,2x))') 'bond ', ibond, deloc%bonds(:,:,ibond)
1238    particip_atom(deloc%bonds(1,1,ibond)) = particip_atom(deloc%bonds(1,1,ibond))+1
1239    particip_atom(deloc%bonds(1,2,ibond)) = particip_atom(deloc%bonds(1,2,ibond))+1
1240  end do
1241 
1242  call make_angles(deloc,natom)
1243 
1244  ABI_ALLOCATE(badangles,(deloc%nang))
1245  badangles(:) = 0
1246  do iang=1,deloc%nang
1247    write(std_out,'(a,i4,3(2i5,2x))') 'angle ', iang, deloc%angs(:,:,iang)
1248    particip_atom(deloc%angs(1,1,iang)) = particip_atom(deloc%angs(1,1,iang))+1
1249    particip_atom(deloc%angs(1,2,iang)) = particip_atom(deloc%angs(1,2,iang))+1
1250    particip_atom(deloc%angs(1,3,iang)) = particip_atom(deloc%angs(1,3,iang))+1
1251 
1252 !  DEBUG
1253 !  rpt1(:) = xcart(:,deloc%angs(1,1,iang)) &
1254 !  & + deloc%rshift(1,deloc%angs(2,1,iang))*rprimd(:,1) &
1255 !  & + deloc%rshift(2,deloc%angs(2,1,iang))*rprimd(:,2) &
1256 !  & + deloc%rshift(3,deloc%angs(2,1,iang))*rprimd(:,3)
1257 !  rpt2(:) = xcart(:,deloc%angs(1,2,iang)) &
1258 !  & + deloc%rshift(1,deloc%angs(2,2,iang))*rprimd(:,1) &
1259 !  & + deloc%rshift(2,deloc%angs(2,2,iang))*rprimd(:,2) &
1260 !  & + deloc%rshift(3,deloc%angs(2,2,iang))*rprimd(:,3)
1261 !  rpt3(:) = xcart(:,deloc%angs(1,3,iang)) &
1262 !  & + deloc%rshift(1,deloc%angs(2,3,iang))*rprimd(:,1) &
1263 !  & + deloc%rshift(2,deloc%angs(2,3,iang))*rprimd(:,2) &
1264 !  & + deloc%rshift(3,deloc%angs(2,3,iang))*rprimd(:,3)
1265 !  write(std_out,*) rpt1,rpt2,rpt3,bond_length(rpt1,rpt2),bond_length(rpt2,rpt3)
1266 !  ENDDEBUG
1267 
1268 !  check if angles are 180 degrees: discard the dihedrals in that case.
1269    rpt1(:) = xcart(:,deloc%angs(1,1,iang)) &
1270 &   + deloc%rshift(1,deloc%angs(2,1,iang))*rprimd(:,1) &
1271 &   + deloc%rshift(2,deloc%angs(2,1,iang))*rprimd(:,2) &
1272 &   + deloc%rshift(3,deloc%angs(2,1,iang))*rprimd(:,3) &
1273 &   - xcart(:,deloc%angs(1,2,iang)) &
1274 &   - deloc%rshift(1,deloc%angs(2,2,iang))*rprimd(:,1) &
1275 &   - deloc%rshift(2,deloc%angs(2,2,iang))*rprimd(:,2) &
1276 &   - deloc%rshift(3,deloc%angs(2,2,iang))*rprimd(:,3)
1277 
1278    rpt3(:) = xcart(:,deloc%angs(1,3,iang)) &
1279 &   + deloc%rshift(1,deloc%angs(2,3,iang))*rprimd(:,1) &
1280 &   + deloc%rshift(2,deloc%angs(2,3,iang))*rprimd(:,2) &
1281 &   + deloc%rshift(3,deloc%angs(2,3,iang))*rprimd(:,3) &
1282 &   - xcart(:,deloc%angs(1,2,iang)) &
1283 &   - deloc%rshift(1,deloc%angs(2,2,iang))*rprimd(:,1) &
1284 &   - deloc%rshift(2,deloc%angs(2,2,iang))*rprimd(:,2) &
1285 &   - deloc%rshift(3,deloc%angs(2,2,iang))*rprimd(:,3)
1286    spp = (rpt1(1)*rpt3(1)+rpt1(2)*rpt3(2)+rpt1(3)*rpt3(3))&
1287 &   / sqrt(rpt1(1)*rpt1(1)+rpt1(2)*rpt1(2)+rpt1(3)*rpt1(3)) &
1288 &   / sqrt(rpt3(1)*rpt3(1)+rpt3(2)*rpt3(2)+rpt3(3)*rpt3(3))
1289    if (abs(abs(spp) - one) < tol6) then
1290      write(std_out,*) 'make_prim_internals : an angle is too close to 180 degrees:'
1291      write(std_out,*) '   will discard dihedrals using it '
1292      badangles(iang) = 1
1293    end if
1294  end do
1295 
1296  call make_dihedrals(badangles,deloc)
1297  ABI_DEALLOCATE(badangles)
1298 
1299  do idihed=1,deloc%ndihed
1300    write(std_out,'(a,i4,4(2i5,2x))') 'dihedral ', idihed, deloc%dihedrals(:,:,idihed)
1301    particip_atom(deloc%dihedrals(1,1,idihed)) = particip_atom(deloc%dihedrals(1,1,idihed))+1
1302    particip_atom(deloc%dihedrals(1,2,idihed)) = particip_atom(deloc%dihedrals(1,2,idihed))+1
1303    particip_atom(deloc%dihedrals(1,3,idihed)) = particip_atom(deloc%dihedrals(1,3,idihed))+1
1304    particip_atom(deloc%dihedrals(1,4,idihed)) = particip_atom(deloc%dihedrals(1,4,idihed))+1
1305 
1306 !  do ii=1,4
1307 !  write(std_out,'((3E16.6,2x))') xcart(:,deloc%dihedrals(1,ii,idihed)) + &
1308 !  &  deloc%rshift(1,deloc%dihedrals(2,ii,idihed))*rprimd(:,1)   + &
1309 !  &  deloc%rshift(2,deloc%dihedrals(2,ii,idihed))*rprimd(:,2)   + &
1310 !  &  deloc%rshift(2,deloc%dihedrals(2,ii,idihed))*rprimd(:,3)
1311 !  end do
1312  end do
1313 
1314  write(std_out,*) 'make_deloc_internals: nbond,nang,ndihed = ', deloc%nbond,deloc%nang,deloc%ndihed
1315 
1316 !Check all atoms participate in at least 4 primitives. Otherwise, we should
1317 !probably add cartesian coordinates to the internal ones.
1318  deloc%ncart = 0
1319  do iatom=1,natom
1320    if (particip_atom(iatom) < 4) then
1321      write(std_out,*) ' make_prim_internals : Warning : atom ', iatom, &
1322 &     ' does not belong to enough primitives to determine its'
1323      write(std_out,*) ' position uniquely ! instead : ', particip_atom(iatom)
1324      write(std_out,*) ' Will add cartesian coordinates to set of internals.'
1325 !    write(std_out,*) ' Not done yet.'
1326 !    stop
1327      deloc%ncart = deloc%ncart + 4-particip_atom(iatom)
1328    end if
1329  end do
1330  if (allocated(deloc%carts)) then
1331    ABI_FREE(deloc%carts)
1332  end if
1333  ABI_ALLOCATE(deloc%carts ,(2,deloc%ncart))
1334  icart = 0
1335  do iatom=1,natom
1336    if (particip_atom(iatom) < 4) then
1337 !    kind of arbitrary : include first few directions for the atom: x, then y then z
1338      do ii=1,4-particip_atom(iatom)
1339        icart = icart+1
1340        deloc%carts(1,icart) = ii
1341        deloc%carts(2,icart) = iatom
1342      end do
1343    end if
1344  end do
1345 
1346 !ninternal=nbond+nang+ndihed
1347  deloc%ninternal=deloc%nbond+deloc%nang+deloc%ndihed+deloc%ncart
1348 
1349 end subroutine make_prim_internals

m_abimover/mttk_fin [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 mttk_fin

FUNCTION

 destructor function for mttk object

 INPUT
 mttk

OUTPUT

PARENTS

      mover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

1028 subroutine mttk_fin(mttk_vars)
1029 
1030 
1031 !This section has been created automatically by the script Abilint (TD).
1032 !Do not modify the following lines by hand.
1033 #undef ABI_FUNC
1034 #define ABI_FUNC 'mttk_fin'
1035 !End of the abilint section
1036 
1037  implicit none
1038 
1039  type(mttk_type), intent(inout) :: mttk_vars
1040 
1041  if(allocated(mttk_vars%glogs))  then
1042   ABI_DEALLOCATE(mttk_vars%glogs)
1043  end if
1044  if(allocated(mttk_vars%vlogs))  then
1045   ABI_DEALLOCATE(mttk_vars%vlogs)
1046  end if
1047  if(allocated(mttk_vars%xlogs))  then
1048   ABI_DEALLOCATE(mttk_vars%xlogs)
1049  end if
1050 
1051 end subroutine mttk_fin

m_abimover/mttk_ini [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 mttk_ini

FUNCTION

 destructor function for mttk object

 INPUT
 mttk

OUTPUT

PARENTS

      mover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

 978 subroutine mttk_ini(mttk_vars,nnos)
 979 
 980 
 981 !This section has been created automatically by the script Abilint (TD).
 982 !Do not modify the following lines by hand.
 983 #undef ABI_FUNC
 984 #define ABI_FUNC 'mttk_ini'
 985 !End of the abilint section
 986 
 987  implicit none
 988 
 989 !This section has been created automatically by the script Abilint (TD).
 990 !Do not modify the following lines by hand.
 991 #undef ABI_FUNC
 992 #define ABI_FUNC 'mttk_ini'
 993 !End of the abilint section
 994 
 995  integer,intent(in)  :: nnos
 996  type(mttk_type), intent(out) :: mttk_vars
 997 
 998  ABI_ALLOCATE(mttk_vars%glogs,(nnos))
 999  ABI_ALLOCATE(mttk_vars%vlogs,(nnos))
1000  ABI_ALLOCATE(mttk_vars%xlogs,(nnos))
1001 
1002 end subroutine mttk_ini

m_abimover/mttk_type [ Types ]

[ Top ] [ m_abimover ] [ Types ]

NAME

 mttk_type

FUNCTION

 For Martyna et al. (TTK) reversible MD integration scheme and related data

SOURCE

249  type, public :: mttk_type
250 
251    real(dp) :: glogv
252     !Logarithm of the volume
253 
254    real(dp) :: vlogv
255     !Derivative of logv
256 
257   real(dp) :: gboxg(3,3)
258    !Imbalance in pressure (see paper)
259 
260   real(dp) :: vboxg(3,3)
261    !Velocity of log rprimd (see paper)
262 
263   real(dp), allocatable :: glogs(:)
264    ! glogs(nnos)
265    ! Imbalance of kinetic energy
266 
267   real(dp), allocatable :: vlogs(:)
268    ! vlogs(nnos)
269    ! Velocities of thermostat variables
270 
271   real(dp), allocatable :: xlogs(:)
272    ! xlogs(nnos)
273    ! Positions of thermostat variables
274 
275  end type mttk_type

m_abimover/print_bonds [ Functions ]

[ Top ] [ m_abimover ] [ Functions ]

NAME

 print_bonds

FUNCTION

  Print the bonds

INPUTS

  natom=  Number of atoms
  ntypat= Number of type of atoms
  znucl=  Z number of the atom

OUTPUT

  bonds= Structure that store all the information about
         bonds created by this routine:
         nbonds=  Total number of bonds
         bondij=  Unitary vector along the bond direction
         distij=  Distances between atoms i and j (including shift)
         listij= Indices of bonds going from i to j
         listji= Indices of bonds going from j to i
         indexij= Number of bonds between i and j
         indexji= Number of bonds between j and i
         tolerance

PARENTS

      m_abimover

CHILDREN

      atomdata_from_znucl,bonds_free,print_bonds

SOURCE

2437 subroutine print_bonds(amu,bonds,natom,ntypat,symbol,typat,znucl)
2438 
2439 
2440 !This section has been created automatically by the script Abilint (TD).
2441 !Do not modify the following lines by hand.
2442 #undef ABI_FUNC
2443 #define ABI_FUNC 'print_bonds'
2444 !End of the abilint section
2445 
2446  implicit none
2447 
2448  !Arguments ------------------------------------
2449  !scalars
2450  integer,intent(in) :: natom,ntypat
2451  integer,intent(in) :: typat(natom)
2452  real(dp),intent(in) :: znucl(ntypat)
2453  real(dp),intent(in) :: amu(ntypat)
2454  character(len=2),intent(in) :: symbol(ntypat)
2455  type(go_bonds),intent(in) :: bonds
2456 
2457  !Local variables ------------------------------
2458  !scalars
2459  integer :: ii,jj,kk
2460 
2461 ! *********************************************************************
2462 
2463  write(std_out,'(a)') ch10
2464  write(std_out,'(a,72a,a)') '---BONDS',('-',kk=1,72),ch10
2465  write(std_out,'(a,i3)') 'Number of atoms:   ',natom
2466  write(std_out,'(a,i3)') 'Number of bonds:   ',bonds%nbonds
2467  write(std_out,'(a,f6.3,a,a)') 'Tolerance of bonds: ',bonds%tolerance,' times the sum of covalent radius',ch10
2468 
2469  do ii=1,natom
2470    write(std_out,'(a,i3)') 'ATOM number:       ',ii
2471    write(std_out,'(a,f8.3)') '  Z:              ',znucl(typat(ii))
2472    write(std_out,'(a,f8.3)') '  Weight:         ',amu(typat(ii))
2473    write(std_out,'(a,a3)') '  Symbol:          ',symbol(typat(ii))
2474    write(std_out,'(a,i3)') '  Number of bonds: ',bonds%nbondi(ii)
2475 
2476    do jj=1,bonds%nbondi(ii)
2477      write(std_out,'(a,i3,a,a,i3,a,3f7.3,a,f7.3)') '    [',jj,']',&
2478 &     '    Index of bond: ',bonds%indexi(ii,jj),&
2479 &     '    Unitary vector: ',bonds%bond_vect(:,abs(bonds%indexi(ii,jj))),&
2480 &     '    Bond length: ',bonds%bond_length(abs(bonds%indexi(ii,jj)))
2481    end do
2482 
2483  end do
2484 
2485  do ii=1,bonds%nbonds
2486 
2487    write(std_out,'(a,i3)') 'BOND Index=',ii
2488    write(std_out,'(a,3f8.3)') '    Vector',bonds%bond_vect(:,ii)
2489    write(std_out,'(a,f8.3)')  '    bond Length',bonds%bond_length(ii)
2490 
2491  end do
2492 
2493 end subroutine print_bonds