1!
2! Copyright (C) 1996-2016	The SIESTA group
3!  This file is distributed under the terms of the
4!  GNU General Public License: see COPYING in the top directory
5!  or http://www.gnu.org/copyleft/gpl.txt.
6! See Docs/Contributors.txt for a list of contributors.
7!
8subroutine init_output(IO)
9
10  ! Subroutine to initialize the output file for SIESTA
11  ! This should *only* be used to close(6) and open(6) for
12  ! the new output file
13  !
14  ! Taken from reinit, and adapted by Nick R. Papior, 2017
15
16  use files, only : stdout_file
17
18  implicit none
19
20  ! Whether this node is allowed to perform IO
21  logical, intent(in) :: IO
22
23  ! Quick return for non-IO node
24  ! Perhaps this should be abber
25  if ( .not. IO ) return
26
27  ! First we determine whether all output should be
28  ! written to stdout or to a file.
29  stdout_file = cla_get_output()
30  if ( stdout_file /= ' ' ) then
31     ! Close default output to create a new handle
32     close(unit=6)
33     open(unit=6, file=trim(stdout_file), form="formatted", &
34          position="rewind", action="write", status="unknown")
35  end if
36
37contains
38
39  function cla_get_output() result(outfile)
40    use files, only: label_length
41    character(len=label_length) :: outfile
42
43    ! Local variables
44    integer :: narg, in, length
45    character(len=128) :: line
46
47    ! Default to no file
48    outfile = ' '
49
50#ifndef NO_F2003
51    ! Read the output file from the command line (--out|-out|-o)
52    narg = command_argument_count()
53    if ( narg > 0 ) then
54       in = 0
55       do while ( in <= narg - 1 )
56
57          in = in + 1
58          call get_command_argument(in,line,length)
59
60          ! If it is not an option, skip it
61          if ( line(1:1) /= '-' ) cycle
62
63          ! Truncate '-' to no '-'
64          do while ( line(1:1) == '-' )
65             line = line(2:)
66          end do
67
68          ! We allow these line
69          if ( line(1:1) == 'o'.or.line(1:3) == 'out' ) then
70             if ( in >= narg ) &
71                  call die('Missing argument for output file')
72             in = in + 1
73             call get_command_argument(in,line,length)
74             ! Capture whether the output file is too long
75             if ( length > label_length ) then
76                call die('Output file name is too long!')
77             end if
78             ! Copy over the output file
79             outfile = line(1:length)
80
81          end if
82
83       end do
84    end if
85#endif
86  end function cla_get_output
87
88end subroutine init_output
89