source: LMDZ6/branches/contrails/libf/misc/assert_eq_m.f90 @ 5426

Last change on this file since 5426 was 5268, checked in by abarral, 2 months ago

.f90 <-> .F90 depending on cpp key use

  • 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.8 KB
Line 
1! $Id$
2MODULE assert_eq_m
3
4  implicit none
5
6  INTERFACE assert_eq
7     MODULE PROCEDURE assert_eq2,assert_eq3,assert_eq4,assert_eqn
8  END INTERFACE
9
10  private assert_eq2,assert_eq3,assert_eq4,assert_eqn
11
12CONTAINS
13
14  FUNCTION assert_eq2(n1,n2,string)
15    CHARACTER(LEN=*), INTENT(IN) :: string
16    INTEGER, INTENT(IN) :: n1,n2
17    INTEGER  assert_eq2
18    if (n1 == n2) then
19       assert_eq2=n1
20    else
21       write (*,*) 'nrerror: an assert_eq failed with this tag: ', &
22            string
23       print *, 'program terminated by assert_eq2'
24       stop 1
25    end if
26  END FUNCTION assert_eq2
27  !BL
28  FUNCTION assert_eq3(n1,n2,n3,string)
29    CHARACTER(LEN=*), INTENT(IN) :: string
30    INTEGER, INTENT(IN) :: n1,n2,n3
31    INTEGER  assert_eq3
32    if (n1 == n2 .and. n2 == n3) then
33       assert_eq3=n1
34    else
35       write (*,*) 'nrerror: an assert_eq failed with this tag: ', &
36            string
37       print *, 'program terminated by assert_eq3'
38       stop 1
39    end if
40  END FUNCTION assert_eq3
41  !BL
42  FUNCTION assert_eq4(n1,n2,n3,n4,string)
43    CHARACTER(LEN=*), INTENT(IN) :: string
44    INTEGER, INTENT(IN) :: n1,n2,n3,n4
45    INTEGER  assert_eq4
46    if (n1 == n2 .and. n2 == n3 .and. n3 == n4) then
47       assert_eq4=n1
48    else
49       write (*,*) 'nrerror: an assert_eq failed with this tag: ', &
50            string,n1,n2,n3,n4
51       print *, 'program terminated by assert_eq4'
52       stop 1
53    end if
54  END FUNCTION assert_eq4
55  !BL
56  FUNCTION assert_eqn(nn,string)
57    CHARACTER(LEN=*), INTENT(IN) :: string
58    INTEGER, DIMENSION(:), INTENT(IN) :: nn
59    INTEGER  assert_eqn
60    if (all(nn(2:) == nn(1))) then
61       assert_eqn=nn(1)
62    else
63       write (*,*) 'nrerror: an assert_eq failed with this tag: ', &
64            string
65       print *, 'program terminated by assert_eqn'
66       stop 1
67    end if
68  END FUNCTION assert_eqn
69
70END MODULE assert_eq_m
Note: See TracBrowser for help on using the repository browser.