forked from NGEET/fates
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathFatesUtilsMod.F90
79 lines (54 loc) · 2.29 KB
/
FatesUtilsMod.F90
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
69
70
71
72
73
74
75
76
77
78
79
module FatesUtilsMod
! This module contains helper functions and subroutines which are general in nature.
! Think string parsing, timing, maybe numerics, etc.
use FatesConstantsMod, only : r8 => fates_r8
use FatesGlobals, only : fates_log
implicit none
private ! Modules are private by default
! Make public necessary subroutines and functions
public :: check_hlm_list
public :: check_var_real
contains
function check_hlm_list(hlms,hlm_name) result(astatus)
! ---------------------------------------------------------------------------------
! This simple function compares a string of HLM tags to see if any of the names
! match the name of the currently active HLM. If any do, return true, if any
! don't, if any don't its a big secret.
! ---------------------------------------------------------------------------------
character(len=*),intent(in) :: hlms
character(len=*),intent(in) :: hlm_name
integer :: index
logical :: astatus
astatus = .false.
index = scan(trim(hlms),trim(hlm_name))
if(index>0)then
astatus=.true.
end if
return
end function check_hlm_list
! =====================================================================================
subroutine check_var_real(r8_var, var_name, return_code)
real(r8),intent(in) :: r8_var
character(len=*),intent(in) :: var_name
integer,intent(out) :: return_code
real(r8), parameter :: r8_type = 1.0
real(r8), parameter :: overflow = huge(r8_type)
real(r8), parameter :: underflow = tiny(r8_type)
return_code = 0
! NaN check
if (r8_var /= r8_var) then
write(fates_log(),*) 'NaN detected, ',trim(var_name),': ',r8_var
return_code = 1
end if
! Overflow check (within 100th of max precision)
if (abs(r8_var) > 0.01*overflow) then
write(fates_log(),*) 'Nigh overflow detected, ',trim(var_name),': ',r8_var
return_code = return_code + 10
end if
! Underflow check (within 100x of min precision)
if (abs(r8_var) < 100.0_r8*underflow) then
write(fates_log(),*) 'Nigh underflow detected, ',trim(var_name),': ',r8_var
return_code = return_code + 100
end if
end subroutine check_var_real
end module FatesUtilsMod