source: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_assert.f90

! $Id$
MODULE lmdz_assert

  IMPLICIT NONE; PRIVATE
  PUBLIC assert
  INTERFACE assert
    MODULE PROCEDURE assert1, assert2, assert3, assert4, assert_v
  END INTERFACE

CONTAINS

  SUBROUTINE assert1(n1, string)
    CHARACTER(LEN = *), INTENT(IN) :: string
    LOGICAL, INTENT(IN) :: n1
    IF (.NOT. n1) THEN
      write (*, *) 'nrerror: an assertion failed with this tag:', &
              string
      PRINT *, 'program terminated by assert1'
      stop 1
    end if
  END SUBROUTINE assert1
  !BL
  SUBROUTINE assert2(n1, n2, string)
    CHARACTER(LEN = *), INTENT(IN) :: string
    LOGICAL, INTENT(IN) :: n1, n2
    IF (.NOT. (n1 .AND. n2)) THEN
      write (*, *) 'nrerror: an assertion failed with this tag:', &
              string
      PRINT *, 'program terminated by assert2'
      stop 1
    end if
  END SUBROUTINE assert2
  !BL
  SUBROUTINE assert3(n1, n2, n3, string)
    CHARACTER(LEN = *), INTENT(IN) :: string
    LOGICAL, INTENT(IN) :: n1, n2, n3
    IF (.NOT. (n1 .AND. n2 .AND. n3)) THEN
      write (*, *) 'nrerror: an assertion failed with this tag:', &
              string
      PRINT *, 'program terminated by assert3'
      stop 1
    end if
  END SUBROUTINE assert3
  !BL
  SUBROUTINE assert4(n1, n2, n3, n4, string)
    CHARACTER(LEN = *), INTENT(IN) :: string
    LOGICAL, INTENT(IN) :: n1, n2, n3, n4
    IF (.NOT. (n1 .AND. n2 .AND. n3 .AND. n4)) THEN
      write (*, *) 'nrerror: an assertion failed with this tag:', &
              string
      PRINT *, 'program terminated by assert4'
      stop 1
    end if
  END SUBROUTINE assert4
  !BL
  SUBROUTINE assert_v(n, string)
    CHARACTER(LEN = *), INTENT(IN) :: string
    LOGICAL, DIMENSION(:), INTENT(IN) :: n
    IF (.NOT. all(n)) THEN
      write (*, *) 'nrerror: an assertion failed with this tag:', &
              string
      PRINT *, 'program terminated by assert_v'
      stop 1
    end if
  END SUBROUTINE assert_v

END MODULE lmdz_assert