TABLE OF CONTENTS


ABINIT/iofn1 [ Functions ]

[ Top ] [ Functions ]

NAME

 iofn1

FUNCTION

 Begin by eventual redefinition of unit std_in and std_out
 Then, print greetings for interactive user.
 Next, Read filenames from unit std_in, AND check that new
 output file does not already exist.

COPYRIGHT

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

INPUTS

  comm=MPI communicator.

OUTPUT

  character(len=fnlen) :: filnam(5)=character strings giving file names
  character(len=fnlen) :: filstat=character strings giving name of status file

NOTES

 If it does exist, isfile will create a new name to avoid overwriting the output file.
 Also create name of status file

 File names refer to following files, in order:
  (1) Formatted input file  (std_in)
  (2) Formatted output file (std_out)
  (3) Root name for generic input files (wavefunctions, potential, density ...)
  (4) Root name for generic output files (wavefunctions, potential, density,
                                          DOS, hessian ...)
  (5) Root name for generic temporary files (wftmp1,wftmp2,kgunit,status ...)

PARENTS

      abinit

CHILDREN

      abi_log_status_state,int2char4,isfile,libpaw_log_flag_set,xmpi_barrier
      xmpi_bcast

SOURCE

 47 #if defined HAVE_CONFIG_H
 48 #include "config.h"
 49 #endif
 50 
 51 #include "abi_common.h"
 52 
 53 subroutine iofn1(filnam,filstat,comm)
 54 
 55  use defs_basis
 56  use m_profiling_abi
 57  use m_xmpi
 58  use m_errors
 59  use m_build_info
 60 
 61  use m_fstrings,     only : int2char4
 62  use m_io_tools,     only : open_file
 63  use m_libpaw_tools, only : libpaw_log_flag_set
 64 
 65 !This section has been created automatically by the script Abilint (TD).
 66 !Do not modify the following lines by hand.
 67 #undef ABI_FUNC
 68 #define ABI_FUNC 'iofn1'
 69  use interfaces_32_util
 70 !End of the abilint section
 71 
 72  implicit none
 73 
 74 !Arguments ------------------------------------
 75  integer,intent(in) :: comm
 76  character(len=fnlen), intent(out) :: filstat
 77  character(len=fnlen), intent(out) :: filnam(5)
 78 
 79 !Local variables-------------------------------
 80  character(len=1) :: blank
 81  integer,parameter :: master=0
 82  integer :: me,ios,nproc,ierr
 83  logical :: ex
 84  character(len=fnlen) :: fillog,tmpfil
 85  character(len=10) :: tag
 86  character(len=500) :: message,errmsg
 87 
 88 !*************************************************************************
 89 
 90  ! NOTE: In this routine it's very important to perform tests
 91  ! on possible IO errors (err=10, iomsg) because we are initializing the IO stuff 
 92  ! It there's some problem with the hardware or some misconfiguration, 
 93  ! it's very likely that the code will crash here and we should try to give useful error messages.
 94 
 95  blank = ' '; tmpfil = ''
 96 
 97 !Determine who I am in comm
 98  me = xmpi_comm_rank(comm)
 99  nproc = xmpi_comm_size(comm)
100 
101 !Define values of do_write_log and do_write_status parameters
102 !if a _NOLOG file exists no LOG file and no STATUS file are created for each cpu core
103 !if a _LOG file exists, a LOG file and a STATUS file are created for each cpu core
104 !if the #_of_cpu_core>NPROC_NO_EXTRA_LOG OR presence of ABI_MAIN_LOG_FILE, LOG file is only created for master proc
105 !if the #_of_cpu_core>NPROC_NO_EXTRA_STATUS OR presence of ABI_MAIN_LOG_FILE, STATUS file is only created for master proc
106  inquire(file=ABI_NO_LOG_FILE,iostat=ios,exist=ex)
107  if (ios/=0) ex=.false.
108  if (ex) then
109    do_write_log=.false. ; do_write_status=.false.
110    call abi_log_status_state(new_do_write_log=.false.,new_do_write_status=.false.)
111    call libpaw_log_flag_set(.false.)
112  else
113    inquire(file=ABI_ENFORCE_LOG_FILE,iostat=ios,exist=ex)
114    if (ios/=0) ex=.false.
115    if (ex) then
116      do_write_log=.true. ; do_write_status=.true.
117      call abi_log_status_state(new_do_write_log=.true.,new_do_write_status=.true.)
118      call libpaw_log_flag_set(.true.)
119    else
120      inquire(file=ABI_MAIN_LOG_FILE,iostat=ios,exist=ex)
121      if (ios/=0) ex=.false.
122      if (ex.and.me/=0) then
123        do_write_log=.false. ; do_write_status=.false.
124        call abi_log_status_state(new_do_write_log=.false.,new_do_write_status=.false.)
125        call libpaw_log_flag_set(.false.)
126      else
127        if (me/=0) then
128          do_write_log= (nproc<NPROC_NO_EXTRA_LOG)
129          call abi_log_status_state(new_do_write_log=(nproc<NPROC_NO_EXTRA_LOG))
130          call libpaw_log_flag_set((nproc<NPROC_NO_EXTRA_LOG))
131          do_write_status= (nproc<NPROC_NO_EXTRA_STATUS)
132          call abi_log_status_state(new_do_write_status=(nproc<NPROC_NO_EXTRA_STATUS))
133        end if
134      end if
135    end if
136  end if
137 
138  if (me==master) then
139 
140 !  Eventually redefine standard input and standard output
141 
142    if (do_write_log) then
143 #if defined READ_FROM_FILE
144 !    Take care of the output file
145      tmpfil(1:fnlen)=blank
146      tmpfil(1:3)='log'
147      call isfile(tmpfil,'new')
148      close(std_out, err=10, iomsg=errmsg)
149      if (open_file(tmpfil,message,unit=std_out,form='formatted',status='new',action="write") /= 0) then
150        MSG_ERROR(message)
151      end if 
152 #endif
153    else
154 !    Redirect standard output to null
155      close(std_out, err=10, iomsg=errmsg)
156      if (open_file(NULL_FILE,message,unit=std_out,action="write") /= 0) then
157        MSG_ERROR(message)
158      end if
159    end if
160 
161 #if defined READ_FROM_FILE
162 !  Now take care of the "files" file
163    tmpfil(1:fnlen)=blank
164    tmpfil(1:9)='ab.files'
165    write(message, '(4a)' )&
166 &   'Because of cpp option READ_FROM_FILE,',ch10,&
167 &   'read file "ab.files" instead of standard input ' ,ch10
168    MSG_COMMENT(message)
169    call isfile(tmpfil,'old')
170    close(std_in, err=10, iomsg=errmsg)
171    if (open_file(tmpfil,message,unit=std_in,form='formatted',status='old',action="read") /= 0) then
172      MSG_ERROR(message)
173    end if
174 #endif
175 
176 !  Print greetings for interactive user
177    write(std_out,*,err=10,iomsg=errmsg)' ABINIT ',trim(abinit_version)
178    write(std_out,*,err=10,iomsg=errmsg)' '
179 
180 !  Read name of input file (std_in):
181    write(std_out,*,err=10,iomsg=errmsg)' Give name for formatted input file: '
182    read(std_in, '(a)',err=10,iomsg=errmsg ) filnam(1)
183    write(std_out, '(a)',err=10,iomsg=errmsg ) trim(filnam(1))
184    write(std_out,*)' Give name for formatted output file:'
185    read (std_in, '(a)',err=10,iomsg=errmsg ) filnam(2)
186    write (std_out, '(a)',err=10,iomsg=errmsg ) trim(filnam(2))
187    write(std_out,*)' Give root name for generic input files:'
188    read (std_in, '(a)',err=10,iomsg=errmsg ) filnam(3)
189    write (std_out, '(a)',err=10,iomsg=errmsg ) trim(filnam(3))
190    write(std_out,*, err=10, iomsg=errmsg )' Give root name for generic output files:'
191    read (std_in, '(a)', err=10, iomsg=errmsg ) filnam(4)
192    write (std_out, '(a)', err=10, iomsg=errmsg ) trim(filnam(4))
193    write(std_out,*, err=10, iomsg=errmsg)' Give root name for generic temporary files:'
194    read (std_in, '(a)', err=10, iomsg=errmsg ) filnam(5)
195    write (std_out, '(a)', err=10, iomsg=errmsg ) trim(filnam(5))
196 
197 !  Check that old input file exists
198    call isfile(filnam(1),'old')
199 
200 !  Check that new output file does NOT exist
201    call isfile(filnam(2),'new')
202 
203 !  Check that root name for generic input and output differ
204    if ( trim(filnam(3))==trim(filnam(4)) ) then
205      write(message, '(a,a,a)' )&
206 &     'Root name for generic input and output files must differ ',ch10,&
207 &     'Action: correct your "file" file.'
208      MSG_ERROR(message)
209    end if
210 
211 !  Check that root names are at least 20 characters less than fnlen
212    if ( len_trim(filnam(3)) >= (fnlen-20) ) then
213      write(message, '(a,a,a,a,a,i4,a,i4,a,a)' )&
214 &     'Root name for generic input files is too long. ',ch10,&
215 &     'It must be 20 characters less than the maximal allowed ',ch10,&
216 &     'length of names, that is ',fnlen,', while it is ',len_trim(filnam(3)),ch10,&
217 &     'Action : correct your "file" file.'
218      MSG_ERROR(message)
219    end if
220    if ( len_trim(filnam(4)) >= (fnlen-20) ) then
221      write(message, '(a,a,a,a,a,i4,a,i4,a,a)' )&
222 &     'Root name for generic output files is too long. ',ch10,&
223 &     'It must be 20 characters less than the maximal allowed ',ch10,&
224 &     'length of names, that is ',fnlen,', while it is ',len_trim(filnam(4)),ch10,&
225 &     'Action: correct your "file" file.'
226      MSG_ERROR(message)
227    end if
228    if ( len_trim(filnam(5)) >= (fnlen-20) ) then
229      write(message, '(a,a,a,a,a,i4,a,i4,a,a)' )&
230 &     'Root name for generic temporary files is too long. ',ch10,&
231 &     'It must be 20 characters less than the maximal allowed ',ch10,&
232 &     'length of names, that is ',fnlen,', while it is ',len_trim(filnam(5)),ch10,&
233 &     'Action: correct your "file" file.'
234      MSG_ERROR(message)
235    end if
236 
237  end if ! master only
238 
239 !Communicate filenames to all processors
240  call xmpi_bcast(filnam,master,comm,ierr)
241 
242 !Check
243 !Create a name for the status file, based on filnam(5)
244  filstat=trim(filnam(5))//'_STATUS'
245 
246 !Redefine the log unit if not the master
247  if (me/=master) then
248    call int2char4(me,tag)
249    ABI_CHECK((tag(1:1)/='#'),'Bug: string length too short!')
250    filstat=trim(filstat)//'_P-'//trim(tag)
251    if (do_write_log) then
252      fillog=trim(filnam(5))//'_LOG_'//trim(tag)
253      close(std_out, err=10, iomsg=errmsg)
254      if (open_file(fillog,message,unit=std_out,status='unknown',action="write") /= 0) then
255        MSG_ERROR(message)
256      end if
257    else
258      close(std_out, err=10, iomsg=errmsg)
259      if (open_file(NULL_FILE,message,unit=std_out,action="write") /= 0) then
260        MSG_ERROR(message)
261      end if
262    end if
263  end if
264 
265  call xmpi_barrier(comm)
266  return
267 
268 ! Handle possibe IO errors
269  10 continue
270  MSG_ERROR(errmsg)
271 
272 end subroutine iofn1