1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
! file written by s. husa, 5/6/2004
! $Id$
#include "cctk.h"
subroutine apply_check_abs(var, ni, nj, nk, ceiling_value)
implicit none
CCTK_INT, intent(in) :: ni, nj, nk
CCTK_REAL, dimension (ni, nj, nk), intent(in) :: var(ni, nj, nk)
CCTK_REAL, intent(in) :: ceiling_value
CCTK_REAL :: criterion
CCTK_REAL, save :: initial_value
CCTK_INT, save :: counter
counter = counter + 1
criterion = maxval(abs(var) + epsilon(1.0d0))
if (counter == 1) then
initial_value = criterion
write (*,*) "<<<<<< using ceiling initial value", initial_value
else
criterion = criterion / initial_value
if ((ceiling_value > 0).AND.(criterion > ceiling_value)) then
call CCTK_INFO("Ceiling thorn terminates evolution")
call CCTK_TerminateNext(var)
endif
endif
end subroutine apply_check_abs
subroutine apply_check_diff(var, ni, nj, nk, ceiling_value)
implicit none
CCTK_INT, intent(in) :: ni, nj, nk
CCTK_REAL, dimension (ni, nj, nk), intent(in) :: var(ni, nj, nk)
CCTK_REAL, intent(in) :: ceiling_value
CCTK_REAL :: criterion
CCTK_REAL, save :: initial_value
CCTK_INT, save :: counter
counter = counter + 1
criterion = maxval(var) - minval(var)
if (counter == 1) then
initial_value = criterion
write (*,*) "<<<<<< using ceiling initial value", initial_value
else
criterion = criterion / initial_value
if ((ceiling_value > 0).AND.(criterion > ceiling_value)) then
call CCTK_INFO("Ceiling thorn terminates evolution.")
call CCTK_TerminateNext (var)
endif
endif
end subroutine apply_check_diff
|
