info.F90 2.15 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
!--------------------------------------------------------------------------------
! 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'
21 22
    LOGICAL:: l_mpi
    CALL mpi_initialized(l_mpi,ierr)
23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
    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