source: LMDZ5/trunk/libf/bibio/assert_m.F90 @ 2225

Last change on this file since 2225 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 1.9 KB
Line 
1! $Id$
2MODULE assert_m
3
4  implicit none
5
6  INTERFACE assert
7     MODULE PROCEDURE assert1,assert2,assert3,assert4,assert_v
8  END INTERFACE
9
10  private assert1,assert2,assert3,assert4,assert_v
11
12CONTAINS
13
14  SUBROUTINE assert1(n1,string)
15    CHARACTER(LEN=*), INTENT(IN) :: string
16    LOGICAL, INTENT(IN) :: n1
17    if (.not. n1) then
18       write (*,*) 'nrerror: an assertion failed with this tag:', &
19            string
20       print *, 'program terminated by assert1'
21       stop 1
22    end if
23  END SUBROUTINE assert1
24  !BL
25  SUBROUTINE assert2(n1,n2,string)
26    CHARACTER(LEN=*), INTENT(IN) :: string
27    LOGICAL, INTENT(IN) :: n1,n2
28    if (.not. (n1 .and. n2)) then
29       write (*,*) 'nrerror: an assertion failed with this tag:', &
30            string
31       print *, 'program terminated by assert2'
32       stop 1
33    end if
34  END SUBROUTINE assert2
35  !BL
36  SUBROUTINE assert3(n1,n2,n3,string)
37    CHARACTER(LEN=*), INTENT(IN) :: string
38    LOGICAL, INTENT(IN) :: n1,n2,n3
39    if (.not. (n1 .and. n2 .and. n3)) then
40       write (*,*) 'nrerror: an assertion failed with this tag:', &
41            string
42       print *, 'program terminated by assert3'
43       stop 1
44    end if
45  END SUBROUTINE assert3
46  !BL
47  SUBROUTINE assert4(n1,n2,n3,n4,string)
48    CHARACTER(LEN=*), INTENT(IN) :: string
49    LOGICAL, INTENT(IN) :: n1,n2,n3,n4
50    if (.not. (n1 .and. n2 .and. n3 .and. n4)) then
51       write (*,*) 'nrerror: an assertion failed with this tag:', &
52            string
53       print *, 'program terminated by assert4'
54       stop 1
55    end if
56  END SUBROUTINE assert4
57  !BL
58  SUBROUTINE assert_v(n,string)
59    CHARACTER(LEN=*), INTENT(IN) :: string
60    LOGICAL, DIMENSION(:), INTENT(IN) :: n
61    if (.not. all(n)) then
62       write (*,*) 'nrerror: an assertion failed with this tag:', &
63            string
64       print *, 'program terminated by assert_v'
65       stop 1
66    end if
67  END SUBROUTINE assert_v
68
69END MODULE assert_m
Note: See TracBrowser for help on using the repository browser.