TABLE OF CONTENTS


ABINIT/m_xfpack [ Modules ]

[ Top ] [ Modules ]

NAME

  m_xfpack

FUNCTION

COPYRIGHT

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

PARENTS

CHILDREN

SOURCE

20 #if defined HAVE_CONFIG_H
21 #include "config.h"
22 #endif
23 
24 #include "abi_common.h"
25 
26 module m_xfpack
27 
28  use defs_basis
29  use m_errors
30  use m_abicore
31  use m_abimover
32 
33  use m_symtk,      only : matr3inv
34  use m_geometry,   only : mkradim, mkrdim, metric, strainsym
35  use m_results_gs , only : results_gs_type
36  use m_bfgs,        only : hessupdt
37 
38  implicit none
39 
40  private

ABINIT/xfh_recover_new [ Functions ]

[ Top ] [ Functions ]

NAME

 xfh_recover_new

FUNCTION

 Update the contents of the history xfhist taking values
 from xred, acell, rprim, fred_corrected and strten

INPUTS

OUTPUT

PARENTS

      pred_bfgs,pred_lbfgs

CHILDREN

      hessupdt,xfpack_f2vout,xfpack_x2vin

SOURCE

612 subroutine xfh_recover_new(ab_xfh,ab_mover,acell,acell0,cycl_main,fred,&
613 & hessin,ndim,rprim,rprimd0,strten,ucvol,ucvol0,vin,vin_prev,vout,&
614 & vout_prev,xred)
615 
616 
617 !This section has been created automatically by the script Abilint (TD).
618 !Do not modify the following lines by hand.
619 #undef ABI_FUNC
620 #define ABI_FUNC 'xfh_recover_new'
621 !End of the abilint section
622 
623  implicit none
624 
625 !Arguments ------------------------------------
626 !scalars
627 
628 integer,intent(in) :: ndim
629 integer,intent(out) :: cycl_main
630 real(dp),intent(inout) :: ucvol,ucvol0
631 type(ab_xfh_type),intent(inout) :: ab_xfh
632 type(abimover),intent(in) :: ab_mover
633 
634 
635 !arrays
636 real(dp),intent(inout) :: acell(3)
637 real(dp),intent(in) :: acell0(3)
638 real(dp),intent(inout) :: hessin(:,:)
639 real(dp),intent(inout) :: xred(3,ab_mover%natom)
640 real(dp),intent(inout) :: rprim(3,3)
641 real(dp),intent(inout) :: rprimd0(3,3)
642 real(dp),intent(inout) :: fred(3,ab_mover%natom)
643 real(dp),intent(inout) :: strten(6)
644 real(dp),intent(inout) :: vin(:)
645 real(dp),intent(inout) :: vin_prev(:)
646 real(dp),intent(inout) :: vout(:)
647 real(dp),intent(inout) :: vout_prev(:)
648 
649 !Local variables-------------------------------
650 !scalars
651 integer :: ixfh ! kk,jj
652 
653 !*********************************************************************
654 
655  if(ab_xfh%nxfh/=0)then
656 !  Loop over previous time steps
657    do ixfh=1,ab_xfh%nxfh
658 
659 !    For that time step, get new (x,f) from xfhist
660      xred(:,:)     =ab_xfh%xfhist(:,1:ab_mover%natom        ,1,ixfh)
661      rprim(1:3,1:3)=ab_xfh%xfhist(:,ab_mover%natom+2:ab_mover%natom+4,1,ixfh)
662      acell(:)      =ab_xfh%xfhist(:,ab_mover%natom+1,1,ixfh)
663      fred(:,:)     =ab_xfh%xfhist(:,1:ab_mover%natom,2,ixfh)
664 !    This use of results_gs is unusual
665      strten(1:3)   =ab_xfh%xfhist(:,ab_mover%natom+2,2,ixfh)
666      strten(4:6)   =ab_xfh%xfhist(:,ab_mover%natom+3,2,ixfh)
667 
668 !    !DEBUG
669 !    write (ab_out,*) '---READED FROM XFHIST---'
670 
671 !    write (ab_out,*) 'XRED'
672 !    do kk=1,ab_mover%natom
673 !    write (ab_out,*) xred(:,kk)
674 !    end do
675 !    write (ab_out,*) 'FRED'
676 !    do kk=1,ab_mover%natom
677 !    write (ab_out,*) fred(:,kk)
678 !    end do
679 !    write(ab_out,*) 'RPRIM'
680 !    do kk=1,3
681 !    write(ab_out,*) rprim(:,kk)
682 !    end do
683 !    write(ab_out,*) 'ACELL'
684 !    write(ab_out,*) acell(:)
685 !    !DEBUG
686 
687 !    Transfer it in vin, vout
688      call xfpack_x2vin(acell,acell0,ab_mover%natom,&
689 &     ndim,ab_mover%nsym,ab_mover%optcell,rprim,rprimd0,&
690 &     ab_mover%symrel,ucvol,ucvol0,vin,xred)
691      call xfpack_f2vout(fred,ab_mover%natom,&
692 &     ndim,ab_mover%optcell,ab_mover%strtarget,strten,&
693 &     ucvol,vout)
694 !    Get old time step, if any, and update inverse hessian
695      if(ixfh/=1)then
696        xred(:,:)     =ab_xfh%xfhist(:,1:ab_mover%natom,1,ixfh-1)
697        rprim(1:3,1:3)=&
698 &       ab_xfh%xfhist(:,ab_mover%natom+2:ab_mover%natom+4,1,ixfh-1)
699        acell(:)=ab_xfh%xfhist(:,ab_mover%natom+1,1,ixfh-1)
700        fred(:,:)=ab_xfh%xfhist(:,1:ab_mover%natom,2,ixfh-1)
701 !      This use of results_gs is unusual
702        strten(1:3)=ab_xfh%xfhist(:,ab_mover%natom+2,2,ixfh-1)
703        strten(4:6)=ab_xfh%xfhist(:,ab_mover%natom+3,2,ixfh-1)
704 !      Tranfer it in vin_prev, vout_prev
705        call xfpack_x2vin(acell,acell0,ab_mover%natom,&
706 &       ndim,ab_mover%nsym,ab_mover%optcell,rprim,rprimd0,&
707 &       ab_mover%symrel,ucvol,ucvol0,vin_prev,xred)
708        call xfpack_f2vout(fred,ab_mover%natom,&
709 &       ndim,ab_mover%optcell,ab_mover%strtarget,strten,&
710 &       ucvol,vout_prev)
711 
712 !      write(ab_out,*) 'Hessian matrix before update',ndim,'x',ndim
713 !      write(ab_out,*) 'ixfh=',ixfh
714 !      do kk=1,ndim
715 !      do jj=1,ndim,3
716 !      if (jj+2<=ndim)then
717 !      write(ab_out,*) jj,hessin(jj:jj+2,kk)
718 !      else
719 !      write(ab_out,*) jj,hessin(jj:ndim,kk)
720 !      end if
721 !      end do
722 !      end do
723 
724        call hessupdt(hessin,ab_mover%iatfix,ab_mover%natom,ndim,&
725 &       vin,vin_prev,vout,vout_prev)
726 
727 !      !DEBUG
728 !      write(ab_out,*) 'Hessian matrix after update',ndim,'x',ndim
729 !      do kk=1,ndim
730 !      do jj=1,ndim,3
731 !      if (jj+2<=ndim)then
732 !      write(ab_out,*) jj,hessin(jj:jj+2,kk)
733 !      else
734 !      write(ab_out,*) jj,hessin(jj:ndim,kk)
735 !      end if
736 !      end do
737 !      end do
738 !      !DEBUG
739 
740      end if !if(ab_xfh%nxfh/=0)
741    end do ! End loop over previous time steps
742 
743 !  The hessian has been generated,
744 !  as well as the latest vin and vout
745 !  so will cycle the main loop
746    cycl_main=1
747  end if
748 
749 end subroutine xfh_recover_new

ABINIT/xfh_update [ Functions ]

[ Top ] [ Functions ]

NAME

 xfh_update

FUNCTION

 Update the contents of the history xfhist taking values
 from xred, acell, rprim, fred_corrected and strten

INPUTS

OUTPUT

PARENTS

      mover

CHILDREN

SOURCE

771 subroutine xfh_update(ab_xfh,acell,fred_corrected,natom,rprim,strten,xred)
772 
773 
774 !This section has been created automatically by the script Abilint (TD).
775 !Do not modify the following lines by hand.
776 #undef ABI_FUNC
777 #define ABI_FUNC 'xfh_update'
778 !End of the abilint section
779 
780 implicit none
781 
782 !Arguments ------------------------------------
783 !scalars
784 
785 type(ab_xfh_type),intent(inout) :: ab_xfh
786 integer,intent(in) :: natom
787 
788 !arrays
789 real(dp),intent(in) :: acell(3)
790 real(dp),intent(in) :: xred(3,natom)
791 real(dp),intent(in) :: rprim(3,3)
792 real(dp),intent(in) :: fred_corrected(3,natom)
793 real(dp),intent(in) :: strten(6)
794 
795 !Local variables-------------------------------
796 !scalars
797 !integer :: kk
798 
799 !*********************************************************************
800 
801 !DEBUG
802 !write (ab_out,*) '---WROTE TO XFHIST---'
803 
804 !write (ab_out,*) 'XRED'
805 !do kk=1,natom
806 !write (ab_out,*) xred(:,kk)
807 !end do
808 !write (ab_out,*) 'FRED'
809 !do kk=1,natom
810 !write (ab_out,*) fred_corrected(:,kk)
811 !end do
812 !write(ab_out,*) 'RPRIM'
813 !do kk=1,3
814 !write(ab_out,*) rprim(:,kk)
815 !end do
816 !write(ab_out,*) 'ACELL'
817 !write(ab_out,*) acell(:)
818 !DEBUG
819 
820  ab_xfh%nxfh=ab_xfh%nxfh+1
821 
822  ab_xfh%xfhist(:,1:natom,1,ab_xfh%nxfh)=xred(:,:)
823  ab_xfh%xfhist(:,natom+1,1,ab_xfh%nxfh)=acell(:)
824  ab_xfh%xfhist(:,natom+2:natom+4,1,ab_xfh%nxfh)=rprim(:,:)
825  ab_xfh%xfhist(:,1:natom,2,ab_xfh%nxfh)=fred_corrected(:,:)
826  ab_xfh%xfhist(:,natom+2,2,ab_xfh%nxfh)=strten(1:3)
827  ab_xfh%xfhist(:,natom+3,2,ab_xfh%nxfh)=strten(4:6)
828 
829 end subroutine xfh_update

ABINIT/xfpack_f2vout [ Functions ]

[ Top ] [ Functions ]

NAME

 xfpack_f2vout

FUNCTION

 Old option=3, transfer fred and strten to vout

INPUTS

 natom=number of atoms in cell
 ndim=dimension of vout arrays
 optcell=option for the optimisation of the unit cell. Described in abinit_help.
  Depending on its value, different part of strten
  are contained in vout.
 strtarget(6)=target stresses ; they will be subtracted from strten when vout
  is computed.
 ucvol=unit cell volume (bohr^3), needed for some values of optcell.

OUTPUT

  (see side effects)

SIDE EFFECTS

 Input/Output variables
 fred(3,natom)=grads of Etot wrt reduced coordinates (hartree)
 strten(6)=components of the stress tensor (hartree/bohr^3)
 vout(ndim)=vector that contains fred and some quantity derived from
   strten, depending on the value of optcell, and taking care ot strtarget

PARENTS

      pred_bfgs,pred_delocint,pred_lbfgs,pred_verlet,xfh_recover_deloc
      xfh_recover_new

CHILDREN

SOURCE

482 subroutine xfpack_f2vout(fred,natom,ndim,optcell,strtarget,strten,ucvol,vout)
483 
484 
485 !This section has been created automatically by the script Abilint (TD).
486 !Do not modify the following lines by hand.
487 #undef ABI_FUNC
488 #define ABI_FUNC 'xfpack_f2vout'
489 !End of the abilint section
490 
491  implicit none
492 
493 !Arguments ------------------------------------
494 !scalars
495  integer,intent(in) :: natom,ndim,optcell
496  real(dp),intent(in) :: ucvol
497 !arrays
498  real(dp),intent(in) :: strtarget(6)
499  real(dp),intent(in) :: fred(3,natom),strten(6)
500  real(dp),intent(out) :: vout(ndim)
501 
502 !Local variables-------------------------------
503 !scalars
504  real(dp) :: strdiag
505  character(len=500) :: message
506 !arrays
507  real(dp) :: dstr(6)
508 
509 ! *************************************************************************
510 
511 !!DEBUG
512 !write(ab_out,*) ''
513 !write(ab_out,*) 'xfpack_f2vout'
514 !write(ab_out,*) 'natom=',natom
515 !write(ab_out,*) 'ndim=',ndim
516 !write(ab_out,*) 'optcell=',optcell
517 !write(ab_out,*) 'ucvol=',ucvol
518 !!DEBUG
519 
520 
521 !##########################################################
522 !### 1. Test for compatible ndim
523 
524  if(optcell==0 .and. ndim/=3*natom)then
525    write(message,'(a,a,a,i4,a,i4,a)' )&
526 &   '  When optcell=0, ndim MUST be equal to 3*natom,',ch10,&
527 &   '  while ndim=',ndim,' and 3*natom=',3*natom,'.'
528    MSG_BUG(message)
529  end if
530 
531  if( (optcell==1 .or. optcell==4 .or. optcell==5 .or. optcell==6) &
532 & .and. ndim/=3*natom+1)then
533    write(message,'(a,a,a,i4,a,i4,a)' )&
534 &   '  When optcell=1,4,5 or 6, ndim MUST be equal to 3*natom+1,',ch10,&
535 &   '  while ndim=',ndim,' and 3*natom+1=',3*natom+1,'.'
536    MSG_BUG(message)
537  end if
538 
539  if( (optcell==2 .or. optcell==3) &
540 & .and. ndim/=3*natom+6)then
541    write(message,'(a,a,a,i4,a,i4,a)' )&
542 &   '  When optcell=2 or 3, ndim MUST be equal to 3*natom+6,',ch10,&
543 &   '  while ndim=',ndim,' and 3*natom+6=',3*natom+6,'.'
544    MSG_BUG(message)
545  end if
546 
547  if( optcell>=7 .and. ndim/=3*natom+3)then
548    write(message,'(a,a,a,i4,a,i4,a)' )&
549 &   '  When optcell=7,8 or 9, ndim MUST be equal to 3*natom+3,',ch10,&
550 &   '  while ndim=',ndim,' and 3*natom+3=',3*natom+3,'.'
551    MSG_BUG(message)
552  end if
553 
554 !
555 !Get vout from fred and strten
556 !
557  vout(1:3*natom)= reshape(fred(:,:), (/3*natom/) )
558  dstr(:)=strten(:)-strtarget(:)
559 
560  if(optcell==1)then
561 
562    vout(3*natom+1)=( dstr(1)+dstr(2)+dstr(3))*ucvol
563 
564  else if(optcell==2 .or. optcell==3 .or. optcell>=7)then
565 
566 !  Eventually take away the trace
567    strdiag=0.0_dp
568    if(optcell==3) strdiag=(dstr(1)+dstr(2)+dstr(3))/3.0_dp
569    if(optcell==2 .or. optcell==3)then
570      vout(3*natom+1:3*natom+3)=(dstr(1:3)-strdiag)*ucvol
571 !    For non-diagonal derivatives, must take into account
572 !    that eps(i,j) AND eps(j,i) are varied at the same time. Thus, derivative
573 !    is twice larger
574      vout(3*natom+4:3*natom+6)=dstr(4:6)*ucvol*2.0_dp
575    else if(optcell==7 .or. optcell==8 .or. optcell==9)then
576 !    Similar to case optcell==2 or optcell==3, but in 2 dimensions.
577      vout(3*natom+1:3*natom+3)=dstr(1:3)*ucvol
578      vout(3*natom+optcell-6)  =dstr(optcell-3)*ucvol*2.0_dp
579    end if
580 
581  else if(optcell==4 .or. optcell==5 .or. optcell==6)then
582 
583    vout(3*natom+1)=dstr(optcell-3)*ucvol
584 
585  end if
586 
587 end subroutine xfpack_f2vout

ABINIT/xfpack_vin2x [ Functions ]

[ Top ] [ Functions ]

NAME

 xfpack_vin2x

FUNCTION

 Old option=2, transfer vin  to xred, acell and rprim

INPUTS

 acell0(3)=reference length scales of primitive translations (bohr), needed for some values of optcell.
 natom=number of atoms in cell
 ndim=dimension of vin array
 nsym=order of group.
 rprimd0(3,3)=reference real space primitive translations,
   needed for some values of optcell.
 optcell=option for the optimisation of the unit cell. Described in abinit_help.
  Depending on its value, different part of acell and rprim
  are contained in vin.
 symrel(3,3,nsym)=symmetry operators in terms of action on primitive translations
 ucvol=unit cell volume (bohr^3), needed for some values of optcell.
 ucvol0=reference unit cell volume (bohr^3), needed for some values of optcell.

OUTPUT

  (see side effects)

SIDE EFFECTS

 Input/Output variables
 acell(3)=length scales of primitive translations (bohr)
 rprim(3,3)=dimensionless real space primitive translations
 vin(ndim)=vector that contains xred and some quantity derived
   from acell and rprim, depending on the value of optcell.
 xred(3,natom)=reduced dimensionless atomic coordinates

PARENTS

      pred_bfgs,pred_delocint,pred_lbfgs,pred_verlet

CHILDREN

      metric,mkradim,strainsym

SOURCE

 93 subroutine xfpack_vin2x(acell,acell0,natom,ndim,nsym,optcell,&
 94 & rprim,rprimd0,symrel,ucvol,ucvol0,vin,xred)
 95 
 96 
 97 !This section has been created automatically by the script Abilint (TD).
 98 !Do not modify the following lines by hand.
 99 #undef ABI_FUNC
100 #define ABI_FUNC 'xfpack_vin2x'
101 !End of the abilint section
102 
103  implicit none
104 
105 !Arguments ------------------------------------
106 !scalars
107  integer,intent(in) :: natom,ndim,nsym,optcell
108  real(dp),intent(in) :: ucvol0
109  real(dp),intent(out) :: ucvol
110 !arrays
111  integer,intent(in) :: symrel(3,3,nsym)
112  real(dp),intent(in) :: acell0(3),rprimd0(3,3)
113  real(dp),intent(inout) :: acell(3),rprim(3,3)
114  real(dp),intent(in) :: vin(ndim)
115  real(dp),intent(out) :: xred(3,natom)
116 
117 !Local variables-------------------------------
118 !scalars
119  integer :: ii,jj,kk
120  real(dp) :: scale
121  character(len=500) :: message
122  logical :: equal=.TRUE.
123 !arrays
124  real(dp) :: gmet(3,3),gprimd(3,3),rmet(3,3),rprimd(3,3)
125  real(dp) :: rprimd_symm(3,3),scaling(3,3)
126 
127 ! *************************************************************************
128 
129 !!DEBUG
130 !write(ab_out,*) ''
131 !write(ab_out,*) 'xfpack_vin2x'
132 !write(ab_out,*) 'natom=',natom
133 !write(ab_out,*) 'ndim=',ndim
134 !write(ab_out,*) 'nsym=',nsym
135 !write(ab_out,*) 'optcell=',optcell
136 !write(ab_out,*) 'ucvol=',ucvol
137 !write(ab_out,*) 'xred='
138 !do kk=1,natom
139 !write(ab_out,*) xred(:,kk)
140 !end do
141 !write(ab_out,*) 'VECTOR INPUT (vin) xfpack_vin2x INPUT'
142 !do ii=1,ndim,3
143 !if (ii+2<=ndim)then
144 !write(ab_out,*) ii,vin(ii:ii+2)
145 !else
146 !write(ab_out,*) ii,vin(ii:ndim)
147 !end if
148 !end do
149 !!DEBUG
150 
151 
152 !##########################################################
153 !### 1. Test for compatible ndim
154 
155  if(optcell==0 .and. ndim/=3*natom)then
156    write(message,'(a,a,a,i4,a,i4,a)' )&
157 &   '  When optcell=0, ndim MUST be equal to 3*natom,',ch10,&
158 &   '  while ndim=',ndim,' and 3*natom=',3*natom,'.'
159    MSG_BUG(messagE)
160  end if
161 
162  if( (optcell==1 .or. optcell==4 .or. optcell==5 .or. optcell==6) &
163 & .and. ndim/=3*natom+1)then
164    write(message,'(a,a,a,i4,a,i4,a)' )&
165 &   '  When optcell=1,4,5 or 6, ndim MUST be equal to 3*natom+1,',ch10,&
166 &   '  while ndim=',ndim,' and 3*natom+1=',3*natom+1,'.'
167    MSG_BUG(message)
168  end if
169 
170  if( (optcell==2 .or. optcell==3) &
171 & .and. ndim/=3*natom+6)then
172    write(message,'(a,a,a,i4,a,i4,a)' )&
173 &   '  When optcell=2 or 3, ndim MUST be equal to 3*natom+6,',ch10,&
174 &   '  while ndim=',ndim,' and 3*natom+6=',3*natom+6,'.'
175    MSG_BUG(message)
176  end if
177 
178  if( optcell>=7 .and. ndim/=3*natom+3)then
179    write(message,'(a,a,a,i4,a,i4,a)' )&
180 &   '  When optcell=7,8 or 9, ndim MUST be equal to 3*natom+3,',ch10,&
181 &   '  while ndim=',ndim,' and 3*natom+3=',3*natom+3,'.'
182    MSG_BUG(message)
183  end if
184 
185 !##########################################################
186 !### 3. option=2, transfer vin  to xred, acell and rprim
187 
188 !Get xred, and eventually acell and rprim from vin
189  xred(:,:)=reshape( vin(1:3*natom), (/3,natom/) )
190 
191  if(optcell==1)then
192 
193 !  acell(:)=acell0(:)*vin(3*natom+1)/(ucvol0**third)
194    acell(:)=acell0(:)*vin(3*natom+1)
195 
196  else if(optcell==2 .or. optcell==3 .or. optcell>=7 )then
197 
198    scaling(:,:)=0.0_dp
199    scaling(1,1)=1.0_dp ; scaling(2,2)=1.0_dp ; scaling(3,3)=1.0_dp
200 
201    if(optcell==2 .or. optcell==3)then
202      scaling(1,1)=vin(3*natom+1)
203      scaling(2,2)=vin(3*natom+2)
204      scaling(3,3)=vin(3*natom+3)
205      scaling(2,3)=vin(3*natom+4) ; scaling(3,2)=vin(3*natom+4)
206      scaling(1,3)=vin(3*natom+5) ; scaling(3,1)=vin(3*natom+5)
207      scaling(1,2)=vin(3*natom+6) ; scaling(2,1)=vin(3*natom+6)
208    else if(optcell==7)then
209      scaling(2,2)=vin(3*natom+2) ; scaling(3,3)=vin(3*natom+3)
210      scaling(2,3)=vin(3*natom+1) ; scaling(3,2)=vin(3*natom+1)
211    else if(optcell==8)then
212      scaling(1,1)=vin(3*natom+1) ; scaling(3,3)=vin(3*natom+3)
213      scaling(1,3)=vin(3*natom+2) ; scaling(3,1)=vin(3*natom+2)
214    else if(optcell==9)then
215      scaling(1,1)=vin(3*natom+1) ; scaling(2,2)=vin(3*natom+2)
216      scaling(1,2)=vin(3*natom+3) ; scaling(2,1)=vin(3*natom+3)
217    end if
218    do ii=1,3
219      do jj=1,3
220        rprimd(ii,jj)=0.0_dp
221        do kk=1,3
222          rprimd(ii,jj)=rprimd(ii,jj)+scaling(ii,kk)*rprimd0(kk,jj)
223        end do
224      end do
225    end do
226 !  Rescale if the volume must be preserved
227    if(optcell==3)then
228      call metric(gmet,gprimd,-1,rmet,rprimd,ucvol)
229      scale=(ucvol0/ucvol)**third
230      rprimd(:,:)=scale*rprimd(:,:)
231    end if
232    call strainsym(nsym,rprimd0,rprimd,rprimd_symm,symrel)
233    do jj=1,3
234      do ii=1,3
235 !      write(ab_out,*) 'DIFF',ii,jj,abs(rprimd0(ii,jj)-rprimd_symm(ii,jj))
236        if (abs(rprimd0(ii,jj)-rprimd_symm(ii,jj))>1.E-14)&
237 &       equal=.FALSE.
238      end do
239    end do
240 
241    if (equal)then
242      acell(:)=acell0(:)
243      rprimd(:,:)=rprimd0(:,:)
244    else
245 !    Use a representation based on normalised rprim vectors
246      call mkradim(acell,rprim,rprimd_symm)
247    end if
248 
249  else if(optcell==4 .or. optcell==5 .or. optcell==6)then
250 
251    acell(:)=acell0(:) ; acell(optcell-3)=vin(3*natom+1)*acell0(optcell-3)
252 
253  end if
254 
255 end subroutine xfpack_vin2x

ABINIT/xfpack_x2vin [ Functions ]

[ Top ] [ Functions ]

NAME

 xfpack_x2vin

FUNCTION

 Old option=1, transfer xred, acell, and rprim to vin

INPUTS

 acell0(3)=reference length scales of primitive translations (bohr), needed for some values of optcell.
 natom=number of atoms in cell
 ndim=dimension of vin arrays
 nsym=order of group.
 rprimd0(3,3)=reference real space primitive translations,
   needed for some values of optcell.
 optcell=option for the optimisation of the unit cell. Described in abinit_help.
  Depending on its value, different part of acell and rprim
  are contained in vin.
 symrel(3,3,nsym)=symmetry operators in terms of action on primitive translations
 ucvol=unit cell volume (bohr^3), needed for some values of optcell.
 ucvol0=reference unit cell volume (bohr^3), needed for some values of optcell.

OUTPUT

  (see side effects)

SIDE EFFECTS

 Input/Output variables
 acell(3)=length scales of primitive translations (bohr)
 rprim(3,3)=dimensionless real space primitive translations
 vin(ndim)=vector that contains xred and some quantity derived
   from acell and rprim, depending on the value of optcell.
 xred(3,natom)=reduced dimensionless atomic coordinates

PARENTS

      pred_bfgs,pred_delocint,pred_lbfgs,pred_verlet,xfh_recover_deloc
      xfh_recover_new

CHILDREN

      matr3inv,metric,mkrdim,strainsym

SOURCE

299 subroutine xfpack_x2vin(acell,acell0,natom,ndim,nsym,optcell,&
300   & rprim,rprimd0,symrel,ucvol,ucvol0,vin,xred)
301 
302 
303 !This section has been created automatically by the script Abilint (TD).
304 !Do not modify the following lines by hand.
305 #undef ABI_FUNC
306 #define ABI_FUNC 'xfpack_x2vin'
307 !End of the abilint section
308 
309  implicit none
310 
311 !Arguments ------------------------------------
312 !scalars
313  integer,intent(in) :: natom,ndim,nsym,optcell
314  real(dp),intent(in) :: ucvol0
315  real(dp),intent(inout) :: ucvol !vz_i
316 !arrays
317  integer,intent(in) :: symrel(3,3,nsym)
318  real(dp),intent(in) :: acell0(3),rprimd0(3,3)
319  real(dp),intent(in) :: acell(3),rprim(3,3)
320  real(dp),intent(in) :: xred(3,natom)
321  real(dp),intent(out) :: vin(ndim)
322 
323 !Local variables-------------------------------
324 !scalars
325  integer :: ii,jj,kk
326  real(dp) :: scale
327  character(len=500) :: message
328 !arrays
329  real(dp) :: gmet(3,3),gprimd(3,3),gprimd0(3,3),rmet(3,3),rprimd(3,3)
330  real(dp) :: rprimd_symm(3,3),scaling(3,3)
331 
332 ! *************************************************************************
333 
334 !!DEBUG
335 !write(ab_out,*) ''
336 !write(ab_out,*) 'xfpack_x2vin'
337 !write(ab_out,*) 'natom=',natom
338 !write(ab_out,*) 'ndim=',ndim
339 !write(ab_out,*) 'nsym=',nsym
340 !write(ab_out,*) 'optcell=',optcell
341 !write(ab_out,*) 'ucvol=',ucvol
342 !write(ab_out,*) 'xred='
343 !do kk=1,natom
344 !write(ab_out,*) xred(:,kk)
345 !end do
346 !write(ab_out,*) 'VECTOR INPUT (vin) xfpack_x2vin INPUT'
347 !do ii=1,ndim,3
348 !if (ii+2<=ndim)then
349 !write(ab_out,*) ii,vin(ii:ii+2)
350 !else
351 !write(ab_out,*) ii,vin(ii:ndim)
352 !end if
353 !end do
354 !!DEBUG
355 
356 
357 !##########################################################
358 !### 1. Test for compatible ndim
359 
360  if(optcell==0 .and. ndim/=3*natom)then
361    write(message,'(a,a,a,i4,a,i4,a)' )&
362 &   '  When optcell=0, ndim MUST be equal to 3*natom,',ch10,&
363 &   '  while ndim=',ndim,' and 3*natom=',3*natom,'.'
364    MSG_BUG(message)
365  end if
366 
367  if( (optcell==1 .or. optcell==4 .or. optcell==5 .or. optcell==6) &
368 & .and. ndim/=3*natom+1)then
369    write(message,'(a,a,a,i4,a,i4,a)' )&
370 &   '  When optcell=1,4,5 or 6, ndim MUST be equal to 3*natom+1,',ch10,&
371 &   '  while ndim=',ndim,' and 3*natom+1=',3*natom+1,'.'
372    MSG_BUG(message)
373  end if
374 
375  if( (optcell==2 .or. optcell==3) &
376 & .and. ndim/=3*natom+6)then
377    write(message,'(a,a,a,i4,a,i4,a)' )&
378 &   '  When optcell=2 or 3, ndim MUST be equal to 3*natom+6,',ch10,&
379 &   '  while ndim=',ndim,' and 3*natom+6=',3*natom+6,'.'
380    MSG_BUG(message)
381  end if
382 
383  if( optcell>=7 .and. ndim/=3*natom+3)then
384    write(message,'(a,a,a,i4,a,i4,a)' )&
385 &   '  When optcell=7,8 or 9, ndim MUST be equal to 3*natom+3,',ch10,&
386 &   '  while ndim=',ndim,' and 3*natom+3=',3*natom+3,'.'
387    MSG_BUG(message)
388  end if
389 
390 !##########################################################
391 !### 2. option=1, transfer xred, acell, and rprim to vin
392 
393 !Get vin from xred, acell, and rprim
394  vin(1:3*natom)= reshape(xred(:,:), (/3*natom/) )
395 
396  if(optcell/=0)then
397    call mkrdim(acell,rprim,rprimd)
398    call strainsym(nsym,rprimd0,rprimd,rprimd_symm,symrel)
399    call metric(gmet,gprimd,-1,rmet,rprimd_symm,ucvol)
400 
401    if(optcell==1)then
402 
403 !    vin(3*natom+1)=ucvol**third
404      vin(3*natom+1)=(ucvol/ucvol0)**third
405 
406    else if(optcell==2 .or. optcell==3 .or. optcell>=7)then
407 
408 !    Generates gprimd0
409      call matr3inv(rprimd0,gprimd0)
410      do ii=1,3
411        do jj=1,3
412          scaling(ii,jj)=0.0_dp
413          do kk=1,3
414            scaling(ii,jj)=scaling(ii,jj)+rprimd_symm(ii,kk)*gprimd0(jj,kk)
415          end do
416        end do
417      end do
418 !    Rescale if the volume must be preserved
419      if(optcell==3)then
420        scale=(ucvol0/ucvol)**third
421        scaling(:,:)=scale*scaling(:,:)
422      end if
423      if(optcell==2 .or. optcell==3)then
424        vin(3*natom+1)=scaling(1,1) ; vin(3*natom+4)=(scaling(2,3)+scaling(3,2))*0.5_dp
425        vin(3*natom+2)=scaling(2,2) ; vin(3*natom+5)=(scaling(1,3)+scaling(3,1))*0.5_dp
426        vin(3*natom+3)=scaling(3,3) ; vin(3*natom+6)=(scaling(1,2)+scaling(2,1))*0.5_dp
427      else if(optcell>=7)then
428        vin(3*natom+1)=scaling(1,1)
429        vin(3*natom+2)=scaling(2,2)
430        vin(3*natom+3)=scaling(3,3)
431        if(optcell==7)vin(3*natom+1)=(scaling(2,3)+scaling(3,2))*0.5_dp
432        if(optcell==8)vin(3*natom+2)=(scaling(1,3)+scaling(3,1))*0.5_dp
433        if(optcell==9)vin(3*natom+3)=(scaling(1,2)+scaling(2,1))*0.5_dp
434      end if
435 
436    else if(optcell==4 .or. optcell==5 .or. optcell==6)then
437 
438      vin(3*natom+1)=acell(optcell-3)/acell0(optcell-3)
439 
440    end if
441 
442  end if
443 
444 end subroutine xfpack_x2vin