psmile_error.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PSMILe_Error
!
! !INTERFACE:

      subroutine psmile_error ( ierror, char_string, ierrp, nerrp, &
                                file, line )
!
! !USES:
!
      use PSMILe, dummy_interface => PSMILe_Error
      use PRISM_constants

      implicit none
!
! !INPUT PARAMETERS:
!
      integer, Intent (In)                :: ierror
!
!     PRISM error code
!
      character(len=*), Intent(In)        :: char_string
!
!     Character parameter to the error code
!
      integer, Intent (In)                :: nerrp
!
!     Number of error parameters
!
      integer, Intent (In)                :: ierrp (nerrp)
!
!     Error parameters for the error code
!
      character(len=*), Intent(In)        :: file
!
!     File name in which the error code was generated
!
      integer, Intent (In)                :: line
!
!     Line number in "file" at which error code was generated
!
! !LOCAL VARIABLES
!
      integer                             :: lenstr
      logical                             :: abort
      character(len=16)                   :: ch_rank
      integer                             :: ipos
!
! !DESCRIPTION:
!
! Subroutine PSMILe_Error prints error messages.
!
! \begin{verbatim}
! Error classes:
!
!        ierror = PRISM_Error_Initialized :
!                 PRISM environment is not initialized.
!        ierror = PRISM_Error_Internal : Internal error
! \end{verbatim}
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 01.12.03    R. Redler    created
! 01.12.05    J. Ghattas   moved some parts to psmile_error_common
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_error.F90 2706 2010-11-04 15:33:32Z hanke $
!  $Autor$
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_error.F90 2706 2010-11-04 15:33:32Z hanke $'
!
!----------------------------------------------------------------------

  if ( (PRISM_Error_MPI <= ierror .and. ierror <= 10) .or. &
       (ierror == PRISM_Error_Parameter)   .or. &
       (ierror == PRISM_Error_Alloc)       .or. &
       (ierror == PRISM_Error_Dealloc)     .or. &
       (ierror == PRISM_Error_Invalid_Arg) .or. &
       (ierror == PRISM_Error_Arg)         .or. &
       (ierror == PRISM_Error_Arglist)              )then
#ifdef DEBUG
   print *, 'psmile_error_common :  ierror   nerrp = ', ierror, nerrp
#endif

! These error cases are treated in psmile_error_common  
   call psmile_error_common(ierror, char_string, ierrp, nerrp, file, line)

  else 

!
!   Flush Output
!
      call psmile_flushstd
!
      abort = .true.
!
!   Write initial line containing the id and the location
!
      ipos = 0
      lenstr = len_trim (char_string)
      call psmile_int2char ( Appl%rank, ch_rank, ipos)

      write (*, 9990) ch_rank(1:ipos), trim(Appl%name), file, line


      if (ierror == PRISM_Error_Initialized) then

         write (*, 1120) char_string(1:lenstr)

      else if (ierror == PRISM_Error_App) then

         write (*, 1160) char_string(1:lenstr), ierrp (1), ierrp (2)

         abort = .true.

      else if (ierror == PRISM_Error_InitApp) then

         write (*, 1165) char_string(1:lenstr), ierrp (1), ierrp (2)

         abort = .true.

      else if (ierror == PRISM_Error_Grid) then

         write (*, 1170) trim(Grids(ierrp(1))%grid_name), &
                         trim(Comps(ierrp(2))%comp_name), &
                         ierrp (3),                       &
                         char_string(1:lenstr)

      else if (ierror == PRISM_Error_Gridtype) then

         write (*, 1171) trim(Grids(ierrp(1))%grid_name), &
                         Grids(ierrp(1))%grid_type, &
                         char_string(1:lenstr)

      else if (ierror == PRISM_Error_Mask) then

         write (*, 1175) trim(Grids(ierrp(1))%grid_name), &
                         trim(Comps(ierrp(2))%comp_name), &
                         ierrp (3),                       &
                         char_string(1:lenstr)

      else if (ierror == PRISM_Error_Comp_name) then

         write (*, 1180) "component", char_string(1:lenstr)

         abort = .true.

      else if (ierror == PRISM_Error_Appl_name) then

         write (*, 1180) "application", char_string(1:lenstr)

         abort = .true.

      else if (ierror == PRISM_Error_Wrong) then

         write (*, 1200) ierrp (2), ierrp (3), ierrp (1)

      else if (ierror == PRISM_Error_Date) then

         write (*, 1210) char_string(1:lenstr), ierrp (1)

         abort = .true.

      else if (ierror == PRISM_Error_Size) then

         write (*, 1220) char_string(1:lenstr), ierrp (1), ierrp (2), ierrp (3)

         abort = .true.

      else if (ierror == PRISM_Error_Interp_type) then

         write (*, 1230) ierrp (1), char_string(1:lenstr) 

         abort = .true.

!   I/O error

      else if (ierror == PRISM_Error_IO_Meta) then

         write (*, 4190) char_string(1:lenstr), ierrp (1)

         abort = .true.


!   Internal PSMILe error

      else if (ierror == PRISM_Error_Internal) then

         write (*, 9960) char_string(1:lenstr), nerrp
         write (*, 9970) ierrp

      else

!   unknown error code

         write (*, 9980) ierror, char_string(1:lenstr), nerrp
         write (*, 9970) ierrp
      endif

      call psmile_flushstd

!   Abort entire application ?

      if (abort) call PSMILe_Abort


  endif      
!----------------------------------------------------------------------------
!   Formats
!----------------------------------------------------------------------------

! MPI errors

1010  format (1x, 'Error in MPI routine ', a, ': Error message :', a)
1020  format (1x, 'Error occured in Send to process', i4, ' using tag', i5)
1030  format (1x, 'Error occured in Receive from process', i4, ' using tag', i5)
1090  format (1x, 'Error parameters:', (1x, 10(i7, :, ',')))

! PSMILe errors

1110  format (1x, 'Value of parameter ', a, ' is insufficient.', &
             /1x, 'Current value:', i5, '; should be ', i6)
1120  format (1x, 'Error in routine ', a, '. PRISM is not initialized')
1130  format (1x, 'Cannot allocate ', a, &
                  '. Number of data items to be allocated was', i9)
1140  format (1x, 'Cannot deallocate ', a, '.')
1150  format (1x, 'Argument ', a, ' is out of range.', &
             /1x, 'Current value:', i5)
1160  format (1x, 'Error in specification of applications.', 1x, a, &
                  1x, i7, 1x, i7)
1165  format (1x, 'Error in initialisation of applications.', 1x, a, &
                  1x, i7, 1x, i7)
1190  format (1x, 'Error in argument list: ', a, (1x, 10(i7, :, ',')))

1200  format (1x, 'Wrong message from sender', i7, ' received. ', &
                  'Message tag =', i7, '; Message length =', i7)
1210  format (1x, 'Inconsistent Date Argument: ', a, ' for field_id ', i5)
1220  format (1x, 'Inconsistent sizes specified for field ', a, &
                   ' with id ', i5, '; lengths are ', i10, i10)
1230  format (1x, 'Invalid interpolation type', i9, ' specified for grid', &
                   ' of type ', a, '.')
           

! Error in Grid definition
! statt id namen drucken

1170  format (1x, 'Error in Grid definition of grid ', a,       &
                  ' of comp ', a, ':'                           &
             /1x, 'Grid type:', i7                              &
             /1x, a)
1171  format (1x, 'Error in Corner definition of grid ', a,     &
             /1x, 'Grid type:', i8 ,                            &
             /1x, 'requires other corner shapes than ', a )

1175  format (1x, 'Error in Mask definition of grid ', a,     &
                  ' of comp ', a, ':'                         &
             /1x, 'Mask id:', i7                              &
             /1x, a )

1180  format (1x, 'Unknown ', a, ' name "', a, '" specified')

!  Error in IO

4190  format (1x, 'Error in PRISM I/O: ', a, i7)

!  General formats

9960  format (1x, 'Internal PSMILe error', '; string "', a, '"; nerrp', i3)

9970  format (1x, 10i7)
9980  format (1x, 'Unknown error code', i4, '; string ', a, '; nerrp', i3)
9990  format (1x, '[', a, '] PSMILe: Error in application ', a, &
                  '; File ', a, ': line', i6 )
end subroutine PSMILe_Error