psmile_warning.F90

Go to the documentation of this file.

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

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

      implicit none
!
! !INPUT PARAMETERS:
!
      character(len=*), Intent(In)        :: char_string

!     Character parameter to the error code

      integer, Intent (In)                :: ierror

!     Warning parameters for the error code

      integer, Intent (In)                :: nerrp
!
!     Number of error parameters
!
      integer, Intent (In)                :: ierrp (nerrp)
!
!     Error parameters for the error code "ierror"
!
      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
!
! !DESCRIPTION:
!
! Subroutine PSMILe_Warning prints warning messages.
!
! Warning classes:
!

!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.05.23    R. Redler    created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_warning.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_warning.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------
!
!   Flush Output
!
      call psmile_flushstd
!
      abort = .true.
!
      lenstr = len_trim (char_string)

      write (*, 9990) trim(ch_id), file, line

      select case ( ierror )

      case ( PRISM_Warn_Init )

         write (*, 1010) trim(ch_id), char_string(1:lenstr), &
                'Multiple calls to PRISM_Init from application', ierrp (1)

      case ( PRISM_Warn_Size )

         write (*, 1010) trim(ch_id), char_string(1:lenstr), &
                ' must be of same size for field with Id', ierrp (1)

      case ( PRISM_Warn_Mask )

         write (*, 1020) trim(ch_id), char_string(1:lenstr), ierrp (1)

!    Grid definition

      case ( PRISM_Warn_Grid_Periodic )

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

!    Cell definition

      case ( PRISM_Warn_Cell )

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

!    Warning about missing PRISM_def_var calls


      case ( PRISM_Warn_NoDefVar )

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

      case default

!   unknown warning code

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

      end select

      call psmile_flushstd

!----------------------------------------------------------------------------
!   Formats
!----------------------------------------------------------------------------

! Warnings

1010  format (1x, a, ': -->  Warning : ', a, a, i8 )
1020  format (1x, a, ': -->  Warning : ', a, i8 )

1170  format (1x, 'Warning for Grid definition of grid ', a, &
                  ' of comp ', a, ':'                        &
             /1x, 'Periodicity:', i7                         &
             /1x, a)

1180  format (1x, 'Warning for Cell definition of grid '     &
             /1x, a, ' at i: ', i7, ' j: ', i7)

1190  format (1x, '    A transient with name ', a, ' is defined in the' & 
             /1x, '    component SMIOC file but no corresponding call ' &
             /1x, '    to prism_def_var is performed by the component.' &
             /1x, '    Check that this is done on purpose.' )

!  General formats

9980  format (1x, a, ': PSMILe Unknown warning code', 1x, i6, '; nerrp', i4, &
             /1x, 'string: ', a)
9970  format (1x, 10i7)

9990  format (1x, a, ': PSMILe Warning in File ', a, '; line', i6 )

      end subroutine PSMILe_Warning