Commit 11f12b0f authored by Daniel Wortmann's avatar Daniel Wortmann

Added some code for a INFO/WARNING function.

XML output is still missing
parent 894fb095
......@@ -12,6 +12,7 @@ juDFT/hdf_tools_rw_var.F90
juDFT/hdf_tools_stride.F90)
endif()
set(fleur_F90 ${fleur_F90}
juDFT/info.F90
juDFT/init.F90
juDFT/juDFT.F90
juDFT/stop.F90
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grnberg Institut, Forschungszentrum Jlich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
module m_judft_info
private
integer:: info_index
character(len=50),allocatable:: messages(:)
character(len=20),allocatable:: groups(:)
public judft_info,judft_write_infos
contains
subroutine judft_info(message,group)
implicit none
character(len=*),intent(in)::message,group
integer:: irank=0,ierr
#ifdef CPP_MPI
include 'mpif.h'
logical:: l_mpi=.true.
CALL MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr)
#else
logical :: l_mpi=.false.
#endif
if (l_mpi) THEN
write(*,9000) irank,group,message
else
write(*,8000) group,message
endif
!Store info in arrays
info_index=info_index+1
!perhaps (more) storage is needed?
if (.not.allocated(messages)) call priv_reallocate()
if (info_index>size(messages)) call priv_reallocate()
messages(info_index)=message
groups(info_index)=group
9000 FORMAT("PE:",i3,a20," WARNING: ",a50)
8000 FORMAT(a20,' WARNING: ',a50)
end subroutine judft_info
subroutine priv_reallocate()
integer:: n
character(len=50),allocatable:: old_m(:)
character(len=20),allocatable:: old_g(:)
if (.not.allocated(messages)) THEN
info_index=0
allocate(messages(10),groups(10))
return
endif
n=size(messages)
allocate(old_m(n),old_g(n))
old_m=messages
old_g=groups
deallocate(messages,groups)
allocate(messages(n+10),groups(n+10))
messages(:n)=old_m
groups(:n)=old_g
end subroutine priv_reallocate
subroutine judft_write_infos()
integer::n
write(6,*) "The following WARNING messages have been issued:"
DO n=1,info_index
write(6,8000) groups(n),messages(n)
enddo
8000 FORMAT(a20,' WARNING: ',a50)
end subroutine judft_write_infos
end module m_judft_info
......@@ -9,5 +9,5 @@
USE m_juDFT_time
USE m_juDFT_init
USE m_judft_args
USE m_judft_info
END MODULE m_juDFT
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment