Line data    Source code

       1             : 
       2             : module icepack_warnings
       3             : 
       4             :       use icepack_kinds
       5             : 
       6             :       implicit none
       7             : 
       8             :       private
       9             : 
      10             :       ! warning messages
      11             :       character(len=char_len_long), dimension(:), allocatable :: warnings
      12             :       integer :: nWarnings = 0
      13             :       integer, parameter :: nWarningsBuffer = 10 ! incremental number of messages
      14             : 
      15             :       ! abort flag, accessed via icepack_warnings_setabort and icepack_warnings_aborted
      16             :       logical :: warning_abort = .false.
      17             : 
      18             :       ! public string for all subroutines to use
      19             :       character(len=char_len_long), public :: warnstr
      20             : 
      21             :       public :: &
      22             :         icepack_warnings_clear,    &
      23             :         icepack_warnings_print,    &
      24             :         icepack_warnings_flush,    &
      25             :         icepack_warnings_aborted,  &
      26             :         icepack_warnings_add,      &
      27             :         icepack_warnings_setabort
      28             : 
      29             :       private :: &
      30             :         icepack_warnings_getall,   &
      31             :         icepack_warnings_getone
      32             : 
      33             : !=======================================================================
      34             : 
      35             : contains
      36             : 
      37             : !=======================================================================
      38             : !autodocument_start icepack_warnings_aborted
      39             : ! turn on the abort flag in the icepack warnings package
      40             : ! pass in an optional error message
      41             : 
      42   450619967 :       logical function icepack_warnings_aborted(instring)
      43             : 
      44             :         character(len=*),intent(in), optional :: instring
      45             : 
      46             : !autodocument_end
      47             : 
      48             :         character(len=*),parameter :: subname='(icepack_warnings_aborted)'
      49             : 
      50   450619967 :         icepack_warnings_aborted = warning_abort
      51           0 :         if (warning_abort .and. present(instring)) then
      52           0 :            call icepack_warnings_add(subname//' ... '//trim(instring))
      53             :         endif
      54             : 
      55   450619967 :       end function icepack_warnings_aborted
      56             : 
      57             : !=======================================================================
      58             : 
      59          45 :       subroutine icepack_warnings_setabort(abortflag,file,line)
      60             : 
      61             :         logical, intent(in) :: abortflag
      62             :         character(len=*), intent(in), optional :: file
      63             :         integer, intent(in), optional :: line
      64             : 
      65             :         character(len=*),parameter :: subname='(icepack_warnings_setabort)'
      66             : 
      67             :         ! try to capture just the first setabort call
      68             : 
      69          45 :         if (abortflag) then
      70           0 :           write(warnstr,*) subname,abortflag
      71           0 :           if (present(file)) write(warnstr,*) trim(warnstr)//' :file '//trim(file)
      72           0 :           if (present(line)) write(warnstr,*) trim(warnstr)//' :line ',line
      73           0 :           call icepack_warnings_add(warnstr)
      74             :         endif
      75             : 
      76          45 :         warning_abort = abortflag
      77             : 
      78          45 :       end subroutine icepack_warnings_setabort
      79             : 
      80             : !=======================================================================
      81             : !autodocument_start icepack_warnings_clear
      82             : ! clear all warning messages from the icepack warning buffer
      83             : 
      84    12731847 :       subroutine icepack_warnings_clear()
      85             : 
      86             : !autodocument_end
      87             : 
      88             :         character(len=*),parameter :: subname='(icepack_warnings_clear)'
      89             : 
      90    12731847 :         nWarnings = 0
      91             : 
      92    12731847 :       end subroutine icepack_warnings_clear
      93             : 
      94             : !=======================================================================
      95             :       
      96           0 :       subroutine icepack_warnings_getall(warningsOut)
      97             : 
      98             :         character(len=char_len_long), dimension(:), allocatable, intent(out) :: &
      99             :              warningsOut
     100             :  
     101             :         integer :: iWarning
     102             :         character(len=*),parameter :: subname='(icepack_warnings_getall)'
     103             : 
     104           0 :         if (allocated(warningsOut)) deallocate(warningsOut)
     105           0 :         allocate(warningsOut(nWarnings))
     106             : 
     107           0 :         do iWarning = 1, nWarnings
     108           0 :            warningsOut(iWarning) = trim(icepack_warnings_getone(iWarning))
     109             :         enddo
     110             : 
     111           0 :       end subroutine icepack_warnings_getall
     112             : 
     113             : !=======================================================================
     114             : !autodocument_start icepack_warnings_print
     115             : ! print all warning messages from the icepack warning buffer
     116             : 
     117      320377 :       subroutine icepack_warnings_print(iounit)
     118             : 
     119             :         integer, intent(in) :: iounit
     120             : 
     121             : !autodocument_end
     122             : 
     123             :         integer :: iWarning
     124             :         character(len=*),parameter :: subname='(icepack_warnings_print)'
     125             : 
     126             : ! tcraig
     127             : ! this code intermittenly aborts on recursive IO errors with intel
     128             : ! not sure if it's OMP or something else causing this
     129             : !$OMP MASTER
     130     1281807 :         do iWarning = 1, nWarnings
     131     1281807 :           write(iounit,*) trim(icepack_warnings_getone(iWarning))
     132             :         enddo
     133             : !$OMP END MASTER
     134             : 
     135      320377 :       end subroutine icepack_warnings_print
     136             : 
     137             : !=======================================================================
     138             : !autodocument_start icepack_warnings_flush
     139             : ! print and clear all warning messages from the icepack warning buffer
     140             : 
     141    12731847 :       subroutine icepack_warnings_flush(iounit)
     142             : 
     143             :         integer, intent(in) :: iounit
     144             : 
     145             : !autodocument_end
     146             : 
     147             :         character(len=*),parameter :: subname='(icepack_warnings_flush)'
     148             : 
     149    12731847 :         if (nWarnings > 0) then
     150      320377 :           call icepack_warnings_print(iounit)
     151             :         endif
     152    12731847 :         call icepack_warnings_clear()
     153             : 
     154    12731847 :       end subroutine icepack_warnings_flush
     155             : 
     156             : !=======================================================================
     157             : 
     158      961430 :       subroutine icepack_warnings_add(warning)
     159             : 
     160             :         character(len=*), intent(in) :: warning ! warning to add to array of warnings
     161             : 
     162             :         ! local 
     163             : 
     164      961430 :         character(len=char_len_long), dimension(:), allocatable :: warningsTmp
     165             :         integer :: &
     166             :              nWarningsArray, & ! size of warnings array at start
     167             :              iWarning ! warning index
     168             :         character(len=*),parameter :: subname='(icepack_warnings_add)'
     169             : 
     170             : !$OMP CRITICAL (omp_warnings_add)
     171             :         ! check if warnings array is not allocated
     172      961430 :         if (.not. allocated(warnings)) then
     173             : 
     174             :            ! allocate warning array with number of buffer elements
     175          45 :            allocate(warnings(nWarningsBuffer))
     176             : 
     177             :            ! set initial number of nWarnings
     178          45 :            nWarnings = 0
     179             : 
     180             :         ! already allocated
     181             :         else
     182             : 
     183             :            ! find the size of the warnings array at the start
     184      961385 :            nWarningsArray = size(warnings)
     185             :            
     186             :            ! check to see if need more space in warnings array
     187      961385 :            if (nWarnings + 1 > nWarningsArray) then
     188             :            
     189             :               ! allocate the temporary warning storage
     190           3 :               allocate(warningsTmp(nWarningsArray))
     191             : 
     192             :               ! copy the warnings to temporary storage
     193          33 :               do iWarning = 1, nWarningsArray
     194          33 :                  warningsTmp(iWarning) = trim(warnings(iWarning))
     195             :               enddo ! iWarning
     196             : 
     197             :               ! increase the size of the warning array by the buffer size
     198           3 :               deallocate(warnings)
     199           3 :               allocate(warnings(nWarningsArray + nWarningsBuffer))
     200             : 
     201             :               ! copy back the temporary stored warnings
     202          33 :               do iWarning = 1, nWarningsArray
     203          33 :                  warnings(iWarning) = trim(warningsTmp(iWarning))
     204             :               enddo ! iWarning
     205             : 
     206             :               ! deallocate the temporary storage
     207           3 :               deallocate(warningsTmp)
     208             : 
     209             :            endif
     210             :               
     211             :         endif
     212             : 
     213             :         ! increase warning number
     214      961430 :         nWarnings = nWarnings + 1
     215             : !$OMP END CRITICAL (omp_warnings_add)
     216             : 
     217             :         ! add the new warning
     218      961430 :         warnings(nWarnings) = trim(warning)
     219             : 
     220     1922860 :       end subroutine icepack_warnings_add
     221             : 
     222             : !=======================================================================
     223             : 
     224      961430 :       function icepack_warnings_getone(iWarning) result(warning)
     225             : 
     226             :         integer, intent(in) :: iWarning
     227             : 
     228             :         character(len=char_len_long) :: warning
     229             : 
     230             :         character(len=*),parameter :: subname='(icepack_warnings_getone)'
     231             : 
     232      961430 :         if (iWarning <= nWarnings) then
     233      961430 :            warning = warnings(iWarning)
     234             :         else
     235           0 :            warning = ""
     236             :         endif
     237             : 
     238      961430 :       end function icepack_warnings_getone
     239             : 
     240             : !=======================================================================
     241             : 
     242             : end module icepack_warnings