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
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
|
! FORTRAN interfaces to the C utilties defined in fortlib.c
!
! Written by: Richard Weed, Ph.D
! Center for Advanced Vehicular Systems
! Mississippi State University
! rweed@cavs.msstate.edu
! License (and other Lawyer Language)
! This software is released under the Apache 2.0 Open Source License. The
! full text of the License can be viewed at :
!
! http:www.apache.org/licenses/LICENSE-2.0.html
!
! The author grants to the University Corporation for Atmospheric Research
! (UCAR), Boulder, CO, USA the right to revise and extend the software
! without restriction. However, the author retains all copyrights and
! intellectual property rights explicitly stated in or implied by the
! Apache license
! Version 1. June 2006
! Unchanged for netCDF 4.1.1
!------------------------------- udexit --------------------------------------
Subroutine udexit(status)
!
USE ISO_C_BINDING, ONLY: C_INT
Implicit NONE
Integer, Intent(IN) :: status
Integer(KIND=C_INT) :: cstatus
Interface
Subroutine exit(status) BIND(C)
USE ISO_C_BINDING, ONLY: C_INT
Integer(KIND=C_INT), VALUE :: status
End Subroutine exit
End Interface
cstatus = status
Call exit(cstatus)
End Subroutine udexit
!------------------------------- udabort --------------------------------------
Subroutine udabort()
USE ISO_C_BINDING
Implicit NONE
Interface
Subroutine abort() BIND(C)
End Subroutine abort
End Interface
Call abort()
End Subroutine udabort
!------------------------------- udrand -------------------------------------
Function udrand(iflag) RESULT(rannum)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Integer, Intent(IN) :: iflag
Real(RK8) :: rannum
Integer(KIND=C_INT) :: ciflag
Real(KIND=C_DOUBLE) :: crannum
Interface
Function myrand(iflag) BIND(C)
USE ISO_C_BINDING, ONLY: C_INT, C_DOUBLE
Integer(KIND=C_INT), VALUE :: iflag
Real(KIND=C_DOUBLE) :: myrand
End Function myrand
End Interface
ciflag = iflag
crannum = myrand(ciflag)
rannum = crannum
End Function udrand
!------------------------------- udshift -------------------------------------
Function udshift(ivalue, amount) RESULT(shiftval)
USE ISO_C_BINDING
Implicit NONE
Integer, Intent(IN) :: ivalue, amount
Integer(KIND=C_INT) :: cvalue, camount
Integer :: shiftval
Integer(KIND=C_INT) :: cshiftval
Interface
Function myshift(cvalue, camount) BIND(C)
USE ISO_C_BINDING, ONLY: C_INT
Integer(KIND=C_INT), VALUE :: cvalue, camount
Integer(KIND=C_INT) :: myshift
End Function myshift
End Interface
cvalue = ivalue
camount = amount
cshiftval = myshift(cvalue, camount)
shiftval = cshiftval
End Function udshift
!------------------------------- ignorefpe ----------------------------------
Subroutine ignorefpe(idoit)
USE ISO_C_BINDING
Implicit NONE
Integer, Intent(IN) :: idoit
Integer(KIND=C_INT) :: cdoit
Interface
Subroutine nc_ignorefpe(cdoit) BIND(C)
USE ISO_C_BINDING, ONLY: C_INT
Integer(KIND=C_INT), VALUE :: cdoit
End Subroutine nc_ignorefpe
End Interface
cdoit = idoit
Call nc_ignorefpe(cdoit)
End Subroutine ignorefpe
!------------------------------- max_uchar ----------------------------------
Function max_uchar() RESULT(cmax)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmax
Real(KIND=C_DOUBLE) :: ccmax
Interface
Function cmax_uchar() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmax_uchar
End Function cmax_uchar
End Interface
ccmax = cmax_uchar()
cmax = ccmax
End Function max_uchar
!------------------------------- min_schar ----------------------------------
Function min_schar() RESULT(cmin)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmin
Real(KIND=C_DOUBLE) :: ccmin
Interface
Function cmin_schar() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmin_schar
End Function cmin_schar
End Interface
ccmin = cmin_schar()
cmin = ccmin
End Function min_schar
!------------------------------- max_schar ----------------------------------
Function max_schar() RESULT(cmax)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmax
Real(KIND=C_DOUBLE) :: ccmax
Interface
Function cmax_schar() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmax_schar
End Function cmax_schar
End Interface
ccmax = cmax_schar()
cmax = ccmax
End Function max_schar
!------------------------------- min_short ----------------------------------
Function min_short() RESULT(cmin)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmin
Real(KIND=C_DOUBLE) :: ccmin
Interface
Function cmin_short() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmin_short
End Function cmin_short
End Interface
ccmin = cmin_short()
cmin = ccmin
End Function min_short
!------------------------------- max_short ----------------------------------
Function max_short() RESULT(cmax)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmax
Real(KIND=C_DOUBLE) :: ccmax
Interface
Function cmax_short() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmax_short
End Function cmax_short
End Interface
ccmax = cmax_short()
cmax = ccmax
End Function max_short
!------------------------------- min_int ----------------------------------
Function min_int() RESULT(cmin)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmin
Real(KIND=C_DOUBLE) :: ccmin
Interface
Function cmin_int() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmin_int
End Function cmin_int
End Interface
ccmin = cmin_int()
cmin = ccmin
End Function min_int
!------------------------------- max_int ----------------------------------
Function max_int() RESULT(cmax)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmax
Real(KIND=C_DOUBLE) :: ccmax
Interface
Function cmax_int() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmax_int
End Function cmax_int
End Interface
ccmax = cmax_int()
cmax = ccmax
End Function max_int
!------------------------------- min_long ----------------------------------
Function min_long() RESULT(cmin)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmin
Real(KIND=C_DOUBLE) :: ccmin
Interface
Function cmin_long() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmin_long
End Function cmin_long
End Interface
ccmin = cmin_long()
cmin = ccmin
End Function min_long
!------------------------------- max_long ----------------------------------
Function max_long() RESULT(cmax)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmax
Real(KIND=C_DOUBLE) :: ccmax
Interface
Function cmax_long() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmax_long
End Function cmax_long
End Interface
ccmax = cmax_long()
cmax = ccmax
End Function max_long
!------------------------------- max_float ----------------------------------
Function max_float() RESULT(cmax)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmax
Real(KIND=C_DOUBLE) :: ccmax
Interface
Function cmax_float() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmax_float
End Function cmax_float
End Interface
ccmax = cmax_float()
cmax = ccmax
End Function max_float
!------------------------------- max_double ----------------------------------
Function max_double() RESULT(cmax)
USE ISO_C_BINDING
Implicit NONE
Integer, Parameter :: RK8=SELECTED_REAL_KIND(P=13, R=307) ! double
Real(RK8) :: cmax
Real(KIND=C_DOUBLE) :: ccmax
Interface
Function cmax_double() BIND(C)
USE ISO_C_BINDING, ONLY: C_DOUBLE
Real(KIND=C_DOUBLE) :: cmax_double
End Function cmax_double
End Interface
ccmax = cmax_double()
cmax = ccmax
End Function max_double
|
