TABLE OF CONTENTS


ABINIT/mrgdv [ Programs ]

[ Top ] [ Programs ]

NAME

 mrgdv

FUNCTION

 This program merges DFPT potentials for different q-vectors and perturbations.

COPYRIGHT

 Copyright (C) 2004-2018 ABINIT group (MG)
 This file is distributed under the terms of the
 GNU General Public Licence, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .
 For the initials of contributors, see ~abinit/doc/developers/contributors.txt .

NOTES

 DVDB file format:
   version (integer)
   number of potentials (integer)
   for each potential:
     Abinit header with info on the perturbation and the FFT mesh
     potential on the FFT mesh

PARENTS

CHILDREN

      abi_io_redirect,abimem_init,abinit_doctor,dvdb_free,dvdb_init
      dvdb_list_perts,dvdb_merge_files,dvdb_print,dvdb_test_ftinterp
      dvdb_test_v1complete,dvdb_test_v1rsym,get_command_argument,herald
      prompt,wrtout,xmpi_init

SOURCE

 34 #if defined HAVE_CONFIG_H
 35 #include "config.h"
 36 #endif
 37 
 38 #include "abi_common.h"
 39 
 40 program mrgdv
 41 
 42  use defs_basis
 43  use defs_abitypes
 44  use m_xmpi
 45  use m_errors
 46  use m_build_info
 47  use m_abicore
 48  use m_dvdb
 49 
 50  use m_specialmsg,      only : specialmsg_getcount, herald
 51  use m_fstrings,        only : sjoin, itoa, ltoa
 52  use m_numeric_tools,   only : vdiff_eval, vdiff_print
 53  use m_io_tools,        only : file_exists, prompt
 54 
 55 !This section has been created automatically by the script Abilint (TD).
 56 !Do not modify the following lines by hand.
 57 #undef ABI_FUNC
 58 #define ABI_FUNC 'mrgdv'
 59 !End of the abilint section
 60 
 61  implicit none
 62 
 63 !Local variables-------------------------------
 64 !scalars
 65  integer :: ii,nargs,nfiles,comm,prtvol,my_rank,ierr
 66  character(len=24) :: codename
 67  character(len=500) :: command,arg, msg
 68  character(len=fnlen) :: db_path,dump_file
 69  type(dvdb_t) :: db
 70 !arrays
 71  integer :: ngqpt(3)
 72  character(len=fnlen),allocatable :: v1files(:)
 73 
 74 ! *************************************************************************
 75 
 76  ! Change communicator for I/O (mandatory!)
 77  call abi_io_redirect(new_io_comm=xmpi_world)
 78 
 79  ! Initialize MPI
 80  call xmpi_init()
 81  comm = xmpi_world
 82  my_rank = xmpi_comm_rank(comm)
 83 
 84 !Initialize memory profiling if it is activated
 85 !if a full abimem.mocc report is desired, set the argument of abimem_init to "2" instead of "0"
 86 !note that abimem.mocc files can easily be multiple GB in size so don't use this option normally
 87 #ifdef HAVE_MEM_PROFILING
 88  call abimem_init(0)
 89 #endif
 90 
 91  ! write greating,read the file names, etc.
 92  codename='MRGDV'//repeat(' ',18)
 93  call herald(codename,abinit_version,std_out)
 94 
 95  ABI_CHECK(xmpi_comm_size(comm) == 1, "Not programmed for parallel execution")
 96  prtvol = 0
 97  !prtvol = 10
 98 
 99  nargs = command_argument_count()
100 
101  if (nargs == 0) then
102    ! We are reading from stdin
103    call prompt("Enter name of output file:", db_path)
104    call prompt("Enter total number of DFPT POT files:", nfiles)
105    ABI_MALLOC(v1files, (nfiles))
106    do ii=1,nfiles
107      call prompt(sjoin("Enter name of POT file",itoa(ii),":"), v1files(ii))
108    end do
109    call dvdb_merge_files(nfiles, v1files, db_path, prtvol)
110    ABI_FREE(v1files)
111 
112  else
113    ! Command line options.
114    do ii=1,command_argument_count()
115      call get_command_argument(ii, arg)
116      if (arg == "-v" .or. arg == "--version") then
117        write(std_out,"(a)") trim(abinit_version); goto 100
118 
119      else if (arg == "-h" .or. arg == "--help") then
120        ! Document the options.
121        write(std_out,*)"-v, --version              Show version number and exit."
122        write(std_out,*)"merge out_DVDB POT1 POT2   Merge list of POT files, produce out_DVDB file."
123        write(std_out,*)"info out_DVDB              Print information on DVDB file"
124        write(std_out,*)"-h, --help                 Show this help and exit."
125        write(std_out,*)" "
126        write(std_out,*)"Options for developers:"
127        write(std_out,*)"test_v1complete [file]     Test symmetrization of DFPT potentials."
128        write(std_out,*)"                           Assume DVDB with all 3*natom perturbations for each q (prep_gkk)."
129        write(std_out,*)"test_v1rsym                Test symmetries of DFPT potentials in real space."
130        write(std_out,*)"test_ftinterp [n1,n2,n3]   Test Fourier interpolation of DFPT potentials."
131        goto 100
132      end if
133    end do
134 
135    call get_command_argument(1, command)
136 
137    select case (command)
138    case ("merge")
139      ! Get name of output database and list of v1 files.
140      ABI_CHECK(nargs > 1, "Additional arguments are missing")
141      call get_command_argument(2, db_path)
142      if (file_exists(db_path)) then
143        MSG_ERROR(sjoin("Cannot overwrite existing file:", db_path))
144      end if
145 
146      nfiles = nargs - 2
147      ABI_MALLOC(v1files, (nfiles))
148      do ii=1,nfiles
149        call get_command_argument(ii+2, v1files(ii))
150      end do
151 
152      ! Merge POT files.
153      call dvdb_merge_files(nfiles, v1files, db_path, prtvol)
154      ABI_FREE(v1files)
155 
156    case ("info")
157      ! Get name of output database and list of v1 files.
158      ABI_CHECK(nargs > 1, "Additional arguments are missing")
159      call get_command_argument(2, db_path)
160 
161      call dvdb_init(db, db_path, comm)
162      call dvdb_print(db, prtvol=prtvol)
163      call dvdb_list_perts(db, [-1,-1,-1])
164      call dvdb_free(db)
165 
166    case ("test_v1comp", "test_v1complete")
167      call wrtout(std_out," Testing symmetries (assuming overcomplete DVDB, pass extra argument to dump v1(r)) to file")
168      call get_command_argument(2, db_path)
169      dump_file = ""; if (nargs > 2) call get_command_argument(3, dump_file)
170      call dvdb_test_v1complete(db_path, dump_file, comm)
171 
172    case ("test_v1rsym")
173      call wrtout(std_out," Testing symmetries of V1(r) in real space.")
174      call get_command_argument(2, db_path)
175      call dvdb_test_v1rsym(db_path, comm)
176 
177    case ("test_ftinterp")
178      call get_command_argument(2, db_path)
179      ngqpt = [2,2,2]
180      if (nargs > 2) then
181        call get_command_argument(3, arg)
182        read(arg, *, iostat=ierr, iomsg=msg)ngqpt
183        ABI_CHECK(ierr == 0, msg)
184      end if
185 
186      write(std_out,"(a)")sjoin("Testing Fourier interpolation of V1(r) with ngqpt:", ltoa(ngqpt))
187      call dvdb_test_ftinterp(db_path, ngqpt, comm)
188 
189    case default
190      MSG_ERROR(sjoin("Unknown command:", command))
191    end select
192 
193  end if
194 
195  call wrtout(std_out," Done",'COLL')
196 
197  call abinit_doctor("__mrgdv")
198 
199  100 call xmpi_end()
200 
201  end program mrgdv