-
Notifications
You must be signed in to change notification settings - Fork 114
/
rsys.F90
176 lines (138 loc) · 6.67 KB
/
rsys.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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
!===================================== Change Log =========================================!
! 2.0.0 !
! !
!==========================================================================================!
! Copyright (C) 1990, 1995, 1999, 2000, 2003 - All Rights Reserved !
! Regional Atmospheric Modeling System - RAMS !
!==========================================================================================!
! SYSTEM DEPENDENT ROUTINES !
! !
! This module contains short utility routines that are not of the FORTRAN 77 standard !
! and may differ from system to system. These include bit manipulation, I/O, JCL calls, !
! and vector functions. !
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
! Routine to get command line argument. !
!------------------------------------------------------------------------------------------!
subroutine ugetarg(i,arg)
implicit none
integer :: i
character(len=*) :: arg
#if defined(HP)
call getarg(i+1,arg)
#else
call getarg(i,arg)
#endif
return
end subroutine ugetarg
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
! Routine returns CPU time. Called with ICALL=1 at beginning of timestep, ICALL=2 at !
! end of timestep. !
!------------------------------------------------------------------------------------------!
subroutine timing(icall,t1)
implicit none
integer, intent(in) :: icall
real , intent(out) :: t1
real , dimension(2) :: et(2)
#if defined(VAX)
integer :: iad0
#endif
#if defined(IBM)
real , external :: mclock
#elif defined(CRAY)
real , external :: cputime
#elif defined(__APPLE__)
real :: etime
#elif defined(PC_GFORTRAN)
real :: etime
#elif defined(__GFORTRAN__)
real :: etime
#else
real ,external :: etime
#endif
select case (icall)
!----- Start call. ---------------------------------------------------------------------!
case (1)
#if defined(CRAY)
call cpu_time(T1)
#elif defined(VAX)
iad0=0
call lib$init_timer(iad0)
#elif defined(IBM)
T1=mclock(et)/100.
#else
T1=ETIME(et)
#endif
!----- End call. -----------------------------------------------------------------------!
case (2)
#if defined(VAX)
call LIB$SHOW_TIMER(IAD0,2)
#elif defined(CRAY)
call cpu_time(T1)
#elif defined(IBM)
T1=mclock(et)/100.
#else
T1=ETIME(et)
#endif
end select
return
end subroutine timing
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
! Function that checks whether a number is NaN. This works with PGI, Intel, and GNU. !
!------------------------------------------------------------------------------------------!
logical function isnan_real(x)
implicit none
!------ Arguments. ---------------------------------------------------------------------!
real, intent(in) :: x
!---------------------------------------------------------------------------------------!
#if defined(PGI)
isnan_real = x /= x
#else
isnan_real = isnan(x)
#endif
return
end function isnan_real
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
! Function that checks whether a number is NaN. This works with PGI, Intel, and GNU. !
!------------------------------------------------------------------------------------------!
logical function isnan_dble(x)
implicit none
!------ Arguments. ---------------------------------------------------------------------!
real(kind=8), intent(in) :: x
!---------------------------------------------------------------------------------------!
#if defined(PGI)
isnan_dble = x /= x
#else
isnan_dble = isnan(x)
#endif
return
end function isnan_dble
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
! Function that waits for a few seconds before moving on. This may be useful for OMP !
! instructions. Most fortran distributions should work fine with built-in sleep, but it !
! may require libraries. !
!------------------------------------------------------------------------------------------!
subroutine wait_sec(x)
implicit none
!------ Arguments. ---------------------------------------------------------------------!
integer, intent(in) :: x
!---------------------------------------------------------------------------------------!
call sleep(x)
return
end subroutine wait_sec
!==========================================================================================!
!==========================================================================================!