LCOV - code coverage report
Current view: top level - src/45_geomoptim - m_predtk.F90 (source / functions) Coverage Total Hit
Test: coverage.info Lines: 44.6 % 74 33
Test Date: 2026-09-20 15:27:41 Functions: 50.0 % 2 1

            Line data    Source code
       1              : !!****m* ABINIT/m_predtk
       2              : !! NAME
       3              : !!  m_predtk
       4              : !!
       5              : !! FUNCTION
       6              : !!  Low-level procedures used by 45_geomoptim routines
       7              : !!
       8              : !! COPYRIGHT
       9              : !!  Copyright (C) 1998-2026 ABINIT group (DCA, XG, GMR, SE)
      10              : !!  This file is distributed under the terms of the
      11              : !!  GNU General Public License, see ~abinit/COPYING
      12              : !!  or http://www.gnu.org/copyleft/gpl.txt .
      13              : !!
      14              : !! SOURCE
      15              : 
      16              : #if defined HAVE_CONFIG_H
      17              : #include "config.h"
      18              : #endif
      19              : 
      20              : #include "abi_common.h"
      21              : 
      22              : module m_predtk
      23              : 
      24              :  use defs_basis
      25              :  use m_abicore
      26              :  use m_abimover
      27              : 
      28              :  implicit none
      29              : 
      30              :  private
      31              : !!***
      32              : 
      33              :  public :: fdtion
      34              :  public :: prtxvf        ! Print the values of xcart, vel, and fcart to unit iout.
      35              : !!***
      36              : 
      37              : contains
      38              : !!***
      39              : 
      40              : !!****f* ABINIT/fdtion
      41              : !! NAME
      42              : !! fdtion
      43              : !!
      44              : !! FUNCTION
      45              : !! Compute the apropiated "dtion" from the present values
      46              : !! of forces, velocity and viscosity
      47              : !!
      48              : !! INPUTS (in)
      49              : !! hist<type abihist>=Historical record of positions, forces
      50              : !!      |                    acell, stresses, and energies,
      51              : !! ab_mover<type abimover>=Subset of dtset only related with
      52              : !!          |                 movement of ions and acell, contains:
      53              : !!          | dtion:  Time step
      54              : !!          ! natom:  Number of atoms
      55              : !!          | vis:    viscosity
      56              : !!          | iatfix: Index of atoms and directions fixed
      57              : !!          | amass:  Mass of ions
      58              : !! itime: Index of time iteration
      59              : !! xcart(3,natom)= cartesian coordinates of atoms
      60              : !! fcart(3,natom)= forces in cartesian coordinates
      61              : !! vel(3,natom)= velocities
      62              : !!
      63              : !! OUTPUT (out)
      64              : !! fdtion = time step computed
      65              : !!
      66              : !! SOURCE
      67              : 
      68            0 : function fdtion(ab_mover,itime,xcart,fcart,vel)
      69              : 
      70              : !Arguments ---------------------------------------------
      71              : !scalars
      72              :   type(abimover),intent(in) :: ab_mover
      73              :   integer,intent(in) :: itime
      74              :   real(dp) :: fdtion
      75              : !arrays
      76              :   real(dp) :: xcart(:,:),fcart(:,:),vel(:,:)
      77              : 
      78              : !Local variables ------------------------------
      79              : !scalars
      80              :   integer  :: jj,kk
      81              :   real(dp) :: max,min,val
      82              :   real(dp) :: ff,xc,vv,em
      83              : 
      84              : !************************************************************************
      85              : 
      86            0 :  max=0
      87            0 :  min=1e6
      88              : 
      89            0 :  do kk=1,ab_mover%natom
      90            0 :    em=ab_mover%amass(kk)
      91            0 :    do jj=1,3
      92            0 :      ff =fcart(jj,kk)
      93            0 :      xc =xcart(jj,kk)
      94            0 :      vv=vel(jj,kk)
      95              : 
      96            0 :      if (vv>1e-8) then
      97            0 :        val=abs(1.0_dp/vv)
      98            0 :        write(std_out,*) 'vel',kk,jj,val
      99            0 :        if (val>max) max=val
     100            0 :        if (val<min) min=val
     101              :      end if
     102              : 
     103            0 :      if (ff>1e-8) then
     104            0 :        val=sqrt(abs(2*em/ff))
     105            0 :        write(std_out,*) 'forces',kk,jj,val,em,ff
     106            0 :        if (val>max) max=val
     107            0 :        if (val<min) min=val
     108              :      end if
     109              : 
     110              :    end do
     111              : 
     112              :  end do
     113              : 
     114            0 :  write(std_out,*) "DTION max=",max
     115            0 :  write(std_out,*) "DTION min=",min
     116              : 
     117            0 :  if (itime==1)then
     118            0 :    fdtion=min/10
     119              :  else
     120            0 :    fdtion=min/10
     121              :  end if
     122              : 
     123            0 :  end function fdtion
     124              : !!***
     125              : 
     126              : !!****f* ABINIT/prtxvf
     127              : !!
     128              : !! NAME
     129              : !! prtxvf
     130              : !!
     131              : !! FUNCTION
     132              : !! Print the values of xcart, vel, and fcart to unit iout.
     133              : !! Also compute and print max and rms forces.
     134              : 
     135              : !! INPUTS
     136              : !! fcart(3,natom)=forces (hartree/bohr)
     137              : !! iatfix(3,natom)=1 for frozen or fixed atom along specified direction, else 0
     138              : !! iout=unit number for printing
     139              : !! natom=number of atoms in unit cell.
     140              : !! prtvel=1 to print velocities, else do not print them
     141              : !! vel(3,natom)=velocities
     142              : !! xcart(3,natom)=cartesian coordinates (bohr)
     143              : !!
     144              : !! OUTPUT
     145              : !!  (only writing)
     146              : !!
     147              : !! SOURCE
     148              : 
     149          405 : subroutine prtxvf(fcart,gred,iatfix,iout,natom,prtvel,vel,xcart,xred)
     150              : 
     151              : !Arguments ------------------------------------
     152              : !scalars
     153              :  integer,intent(in) :: iout,natom,prtvel
     154              : !arrays
     155              :  integer,intent(in) :: iatfix(3,natom)
     156              :  real(dp),intent(in) :: fcart(3,natom),gred(3,natom)
     157              :  real(dp),intent(in) :: xcart(3,natom),xred(3,natom)
     158              :  real(dp),intent(in) :: vel(3,natom)
     159              : !Local variables-------------------------------
     160              : !scalars
     161              :  integer :: iatom,mu,unfixd
     162              :  real(dp) :: fmax,frms,val_max,val_rms
     163              :  character(len=500) :: msg
     164              : 
     165              : ! *****************************************************************
     166              : 
     167          405 :  write(msg, '(a)' ) ' Cartesian coordinates (xcart) [bohr]'
     168          405 :  call wrtout(iout,msg,'COLL')
     169         2799 :  do iatom=1,natom
     170         2394 :    write(msg, '(1p,3e22.14)' )xcart(:,iatom)
     171         2799 :    call wrtout(iout,msg,'COLL')
     172              :  end do
     173              : 
     174          405 :  write(msg, '(a)' ) ' Reduced coordinates (xred)'
     175          405 :  call wrtout(iout,msg,'COLL')
     176         2799 :  do iatom=1,natom
     177         2394 :    write(msg, '(1p,3e22.14)' )xred(:,iatom)
     178         2799 :    call wrtout(iout,msg,'COLL')
     179              :  end do
     180              : 
     181              : !Compute max |f| and rms f, EXCLUDING the components determined by iatfix
     182              : 
     183          405 :  fmax=0.0_dp
     184          405 :  frms=0.0_dp
     185          405 :  unfixd=0
     186         2799 :  do iatom=1,natom
     187         9981 :    do mu=1,3
     188         9576 :      if (iatfix(mu,iatom) /= 1) then
     189         4014 :        unfixd=unfixd+1
     190         4014 :        frms=frms+fcart(mu,iatom)**2
     191         4014 :        fmax=max(fmax,abs(fcart(mu,iatom)))
     192              :      end if
     193              :    end do
     194              :  end do
     195          405 :  if ( unfixd /= 0 ) frms=sqrt(frms/dble(unfixd))
     196              : 
     197              :  write(msg, '(a,1p,2e12.5,a)' ) &
     198          405 : & ' Cartesian forces (fcart) [Ha/bohr]; max,rms=',fmax,frms,' (free atoms)'
     199          405 :  call wrtout(iout,msg,'COLL')
     200         2799 :  do iatom=1,natom
     201         2394 :    write(msg, '(1p,3e22.14)' )fcart(:,iatom)
     202         2799 :    call wrtout(iout,msg,'COLL')
     203              :  end do
     204              : 
     205          405 :  write(msg, '(a)' ) ' Gradient of E wrt nuclear positions in reduced coordinates (gred)'
     206          405 :  call wrtout(iout,msg,'COLL')
     207         2799 :  do iatom=1,natom
     208         2394 :    write(msg, '(1p,3e22.14)' )gred(:,iatom)
     209         2799 :    call wrtout(iout,msg,'COLL')
     210              :  end do
     211              : 
     212          405 :  if (prtvel == 1) then
     213              : 
     214              : !  Compute max |v| and rms v,
     215              : !  EXCLUDING the components determined by iatfix
     216            0 :    val_max=0.0_dp
     217            0 :    val_rms=0.0_dp
     218            0 :    unfixd=0
     219            0 :    do iatom=1,natom
     220            0 :      do mu=1,3
     221            0 :        if (iatfix(mu,iatom) /= 1) then
     222            0 :          unfixd=unfixd+1
     223            0 :          val_rms=val_rms+vel(mu,iatom)**2
     224            0 :          val_max=max(val_max,abs(vel(mu,iatom)**2))
     225              :        end if
     226              :      end do
     227              :    end do
     228            0 :    if ( unfixd /= 0 ) val_rms=sqrt(val_rms/dble(unfixd))
     229              : 
     230              : 
     231            0 :    write(msg, '(a,1p,2e12.5,a)' ) ' Cartesian velocities (vel) [bohr*Ha/hbar]; max,rms=',&
     232            0 : &   sqrt(val_max),val_rms,' (free atoms)'
     233            0 :    call wrtout(iout,msg,'COLL')
     234            0 :    do iatom=1,natom
     235            0 :      write(msg, '(1p,3e22.14)' ) vel(:,iatom)
     236            0 :      call wrtout(iout,msg,'COLL')
     237              :    end do
     238              :  end if
     239              : 
     240          405 : end subroutine prtxvf
     241              : !!***
     242              : 
     243              : end module m_predtk
     244              : !!***
        

Generated by: LCOV version 2.3-1