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