1 | ! $Id$ |
---|
2 | MODULE 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 | |
---|
12 | CONTAINS |
---|
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 | |
---|
70 | END MODULE assert_eq_m |
---|