LCOV - code coverage report
Current view: top level - src/98_main - mrgddb.F90 (source / functions) Coverage Total Hit
Test: coverage.info Lines: 47.1 % 85 40
Test Date: 2026-11-06 11:53:17 Functions: 100.0 % 2 2
Branches: 13.7 % 124 17

             Branch data     Line data    Source code
       1                 :             : !!****p* ABINIT/mrgddb
       2                 :             : !! NAME
       3                 :             : !! mrgddb
       4                 :             : !!
       5                 :             : !! FUNCTION
       6                 :             : !! This code merges the derivative databases.
       7                 :             : !!
       8                 :             : !! COPYRIGHT
       9                 :             : !! Copyright (C) 1998-2026 ABINIT group (DCA, XG, GMR, SP, GA)
      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                 :             : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt
      14                 :             : !!
      15                 :             : !! INPUTS
      16                 :             : !!  (main routine)
      17                 :             : !!
      18                 :             : !! OUTPUT
      19                 :             : !!  (main routine)
      20                 :             : !!
      21                 :             : !! NOTES
      22                 :             : !! The heading of the constituted database is read,
      23                 :             : !! then the heading of the temporary database to be added is read,
      24                 :             : !! the code check their compatibility, and create a new
      25                 :             : !! database that mixes the old and the temporary ones.
      26                 :             : !! This process can be iterated.
      27                 :             : !! The whole database will be stored in
      28                 :             : !! central memory. One could introduce a third mode in which
      29                 :             : !! only the temporary DDB is in central memory, while the
      30                 :             : !! input DDB is read twice: first to make a table of blocks,
      31                 :             : !! counting the final number of blocks, and second to merge
      32                 :             : !! the two DDBs. This would save memory.
      33                 :             : !!
      34                 :             : !! SOURCE
      35                 :             : 
      36                 :             : #if defined HAVE_CONFIG_H
      37                 :             : #include "config.h"
      38                 :             : #endif
      39                 :             : 
      40                 :             : #include "abi_common.h"
      41                 :             : 
      42                 :          94 : program mrgddb
      43                 :             : 
      44                 :          94 :  use defs_basis
      45                 :             :  use m_abicore
      46                 :             :  use m_errors
      47                 :             :  use m_xmpi
      48                 :             :  use m_ddb_hdr
      49                 :             :  use m_ddb
      50                 :             : 
      51                 :             :  use m_build_info,   only : abinit_version
      52                 :             :  use m_specialmsg,   only : herald
      53                 :             :  use m_time ,        only : asctime, timein
      54                 :             :  use m_io_tools,     only : file_exists
      55                 :             :  use m_fstrings,     only : sjoin
      56                 :             : 
      57                 :             :  implicit none
      58                 :             : 
      59                 :             : !Local variables-------------------------------
      60                 :             : !scalars
      61                 :             :  integer,parameter :: ddbun=2
      62                 :             :  integer :: chkopt,ios, mddb
      63                 :             :  integer :: iddb,ii,nddb,nfiles_cli,nargs,comm,my_rank
      64                 :             :  real(dp) :: tcpu,tcpui,twall,twalli
      65                 :             :  logical :: cannot_overwrite=.True.
      66                 :             :  character(len=24) :: codename
      67                 :             :  character(len=fnlen) :: dscrpt, outname
      68                 :             : !arrays
      69                 :             :  real(dp) :: tsec(2)
      70                 :          94 :  character(len=fnlen),allocatable :: filnam(:),copy_filnam(:)
      71                 :             :  character(len=500) :: msg,arg
      72                 :             : !******************************************************************
      73                 :             : 
      74                 :             :  ! Change communicator for I/O (mandatory!)
      75                 :          94 :  call abi_io_redirect(new_io_comm=xmpi_world)
      76                 :             : 
      77                 :             :  ! Initialize MPI
      78                 :          94 :  call xmpi_init()
      79                 :          94 :  comm = xmpi_world; my_rank = xmpi_comm_rank(comm)
      80                 :             : 
      81                 :             :  ! Initialize memory profiling if it is activated
      82                 :             :  ! if a full abimem.mocc report is desired, set the argument of abimem_init to "2" instead of "0"
      83                 :             :  ! note that abimem.mocc files can easily be multiple GB in size so don't use this option normally
      84                 :             : #ifdef HAVE_MEM_PROFILING
      85                 :             :  call abimem_init(0)
      86                 :             : #endif
      87                 :             : 
      88                 :          94 :  call timein(tcpui,twalli)
      89                 :             : 
      90                 :          94 :  codename='MRGDDB'//repeat(' ',18)
      91                 :          94 :  call herald(codename,abinit_version,std_out)
      92                 :             : 
      93         [ -  + ]:          94 :  ABI_CHECK(xmpi_comm_size(comm)==1, "mrgddb not programmed for parallel execution")
      94                 :             : 
      95                 :          94 :  nargs = command_argument_count()
      96                 :             : 
      97                 :          94 :  mddb = 5000 ! maximum number of databases (initial guess)
      98                 :             : 
      99                 :          94 :  chkopt = 1; nfiles_cli = 0
     100         [ -  + ]:          94 :  do ii=1,nargs
     101                 :           0 :    call get_command_argument(ii, arg)
     102         [ -  - ]:          94 :    if (arg == "-v" .or. arg == "--version") then
     103                 :           0 :      write(std_out,"(a)") trim(abinit_version); goto 100
     104                 :             : 
     105         [ #  # ]:           0 :    else if (arg == "--nostrict") then
     106                 :             :      ! Disable consistency checks
     107                 :           0 :      chkopt = 0
     108                 :             : 
     109         [ #  # ]:           0 :    else if (arg == "-f") then
     110                 :           0 :      cannot_overwrite = .False.
     111                 :             : 
     112         [ #  # ]:           0 :    else if (arg == "-h" .or. arg == "--help") then
     113                 :             :      ! Document the options.
     114                 :           0 :      write(std_out,*)"Usage:"
     115                 :           0 :      write(std_out,*)"    mrgddb                           Interactive prompt."
     116                 :           0 :      write(std_out,*)"    mrgddb < run.files               Read arguments from run.files."
     117                 :           0 :      write(std_out,*)"    mrgddb out_DDB in1_DDB in2_DDB   Merge list of input DDB files, produce new out_DDB file."
     118                 :           0 :      write(std_out,*)"    mrgddb out_DDB in*_DDB           Same as above but use shell wildcards instead of file list."
     119                 :           0 :      write(std_out,*)"    mrgddb out_DDB in_DDB.nc         Convert DDB from NetCDF format to plain text format."
     120                 :           0 :      write(std_out,*)"    mrgddb out_DDB.nc in_DDB         Convert DDB from plain text to NetCDF format."
     121                 :           0 :      write(std_out,*)" "
     122                 :           0 :      write(std_out,*)"Available options:"
     123                 :           0 :      write(std_out,*)"    -v, --version      Show version number and exit."
     124                 :           0 :      write(std_out,*)"    -f                 Overwrite output DDB if file already exists."
     125                 :           0 :      write(std_out,*)"    --nostrict         Disable consistency checks"
     126                 :           0 :      write(std_out,*)"    -h, --help         Show this help and exit."
     127                 :           0 :      goto 100
     128                 :             : 
     129                 :             :    else
     130         [ #  # ]:           0 :      if (ii == 1) then
     131                 :             :        ! First arg is the name of the output file.
     132   [ #  #  #  # ]:           0 :        outname = trim(arg); cycle
     133                 :             :      end if
     134                 :             : 
     135                 :             :      ! Save filenames passed via command-line.
     136         [ #  # ]:           0 :      if (.not. allocated(filnam)) then
     137   [ #  #  #  #  :           0 :        ABI_MALLOC(filnam, (mddb+1))
          #  #  #  #  #  
          #  #  #  #  #  
                   #  # ]
     138                 :             :      end if
     139                 :           0 :      nfiles_cli = nfiles_cli + 1
     140         [ #  # ]:           0 :      if (nfiles_cli > mddb + 1) then
     141                 :             :        ! Extend filnam
     142   [ #  #  #  #  :           0 :        ABI_MALLOC(copy_filnam, (mddb+1))
          #  #  #  #  #  
          #  #  #  #  #  
                   #  # ]
     143   [ #  #  #  #  :           0 :        copy_filnam = filnam
          #  #  #  #  #  
                #  #  # ]
     144                 :           0 :        iddb = mddb + 1
     145                 :           0 :        mddb = 2 * mddb
     146         [ #  # ]:           0 :        ABI_FREE(filnam)
     147   [ #  #  #  #  :           0 :        ABI_MALLOC(filnam, (mddb+1))
          #  #  #  #  #  
          #  #  #  #  #  
                   #  # ]
     148         [ #  # ]:           0 :        filnam(:iddb) = copy_filnam(:iddb)
     149         [ #  # ]:           0 :        ABI_FREE(copy_filnam)
     150                 :             :      end if
     151   [ #  #  #  # ]:           0 :      filnam(nfiles_cli) = trim(arg)
     152                 :             :    end if
     153                 :             :  end do ! nargs
     154                 :             : 
     155         [ +  - ]:          94 :  if (nfiles_cli == 0) then
     156                 :             :    ! Read names of files, operating mode (also check its value),
     157                 :             :    ! and short description of new database.
     158                 :             : 
     159                 :             :    ! Read the name of the output ddb
     160                 :          94 :    write(std_out,*)' Give name for output derivative database : '
     161                 :          94 :    read(std_in, '(a)' ) outname
     162         [ +  - ]:          94 :    write(std_out,'(2a)' )' ',trim(outname)
     163                 :             : 
     164                 :             :    ! Read the description of the derivative database
     165                 :          94 :    write(std_out,*)' Give short description of the derivative database :'
     166                 :          94 :    read(std_in, '(a)' )dscrpt
     167         [ +  - ]:          94 :    write(std_out,'(2a)' )' ',trim(dscrpt)
     168                 :             : 
     169                 :             :    ! Read the number of input ddbs, and check its value
     170                 :             :    ! MG NOTE: In the documentation of mrgddb_init I found:
     171                 :             :    !
     172                 :             :    ! nddb = (=1 => will initialize the ddb, using an input GS file)
     173                 :             :    !        (>1 => will merge the whole set of ddbs listed)
     174                 :             :    !    if nddb==1,
     175                 :             :    !     (2) Formatted input file for the Corning ground-state code
     176                 :             :    !
     177                 :             :    ! but the case nddb=1 with input file is not supported anymore!
     178                 :             : 
     179                 :          94 :    write(std_out,*)' Give number of input ddbs'
     180                 :          94 :    read(std_in,*)nddb
     181                 :          94 :    write(std_out,*)nddb
     182   [ +  -  -  +  :          94 :    ABI_MALLOC(filnam, (nddb))
          -  +  -  +  -  
             +  -  +  -  
                      + ]
     183                 :             : 
     184                 :             :    ! Read the file names
     185         [ +  + ]:         580 :    do iddb=1,nddb
     186                 :             :      !Added to catch error message if the number of input ddbs is greater than the
     187                 :             :      !actual number of ddb files entered by the user.
     188                 :         486 :      read(std_in, '(a)',IOSTAT =ios ) filnam(iddb)
     189         [ -  + ]:         580 :      if (ios < 0) then
     190                 :             :        write(msg, '(a,i0,4a)' )&
     191                 :           0 :        'The number of input ddb files: ',nddb,' exceeds the number ',&
     192                 :           0 :        'of ddb file names.', ch10, &
     193                 :           0 :        'Action: change the number of ddb files in the mrgddb input file.'
     194                 :           0 :        ABI_ERROR(msg)
     195                 :             :      else
     196                 :         486 :        write(std_out,*)' Give name for derivative database number',iddb,' : '
     197         [ +  - ]:         486 :        write(std_out,'(2a)' )' ',trim(filnam(iddb))
     198                 :             :      end if
     199                 :             :    end do
     200                 :             : 
     201                 :             :  else
     202         [ #  # ]:           0 :    if (cannot_overwrite .and. file_exists(outname)) then
     203                 :           0 :      ABI_ERROR(sjoin("Cannot overwrite existing file:", outname))
     204                 :             :    end if
     205                 :           0 :    nddb = nfiles_cli
     206         [ #  # ]:           0 :    dscrpt = sjoin("Generated by mrgddb on:", asctime())
     207                 :             :  end if
     208                 :             : 
     209                 :             :  ! Call the main merging routine
     210                 :          94 :  call merge_ddb(nddb, filnam, outname, dscrpt, chkopt)
     211                 :             : 
     212         [ -  + ]:          94 :  ABI_FREE(filnam)
     213                 :             : 
     214                 :             : !**********************************************************************
     215                 :             : 
     216                 :          94 :  call timein(tcpu,twall)
     217                 :             : 
     218                 :          94 :  tsec(1)=tcpu-tcpui
     219                 :          94 :  tsec(2)=twall-twalli
     220                 :             : 
     221                 :          94 :  write(std_out, '(3a,f13.1,a,f13.1)' ) '-',ch10,'- Proc.   0 individual time (sec): cpu=',tsec(1),'  wall=',tsec(2)
     222                 :          94 :  call wrtout(std_out,'+mrgddb : the run completed successfully ','COLL', do_flush=.True.)
     223                 :             : 
     224                 :          94 :  call abinit_doctor("__mrgddb")
     225                 :             : 
     226                 :          94 :  100 call xmpi_end()
     227                 :             : 
     228                 :           0 :  end program mrgddb
     229                 :             : !!***
        

Generated by: LCOV version 2.3-1