SURFEX v8.1
General documentation of Surfex
n_precision.c
Go to the documentation of this file.
1 
2 #include <stdio.h>
3 #include <string.h>
4 
5 #define FORTRAN_FUNCTION
6 #define MATCHN( s1, s2, n) (memcmp((s1), (s2), (n)) == 0)
7 #define DIFFERN(s1, s2, n) (memcmp((s1), (s2), (n)) != 0)
8 
9 #define INTEGER long
10 
11 /*
12  ----------------------------------------------------------------
13  Define the number of BYTES and IEEE representations of 1 and 1.0
14  ----------------------------------------------------------------
15 */
16 
17 /*
18  *===============================================*
19  * H_ => HALF precision *
20  * S_ => SINGLE precision *
21  * D_ => DOUBLE precision *
22  * Q_ => QUAD precision *
23  * _I => INTEGER*n *
24  * _R => REAL*n *
25  *===============================================*
26 */
27 
28 #define H_ILEN 2
29 #define S_ILEN 4
30 #define D_ILEN 8
31 #define S_RLEN 4
32 #define D_RLEN 8
33 #define Q_RLEN 16
34 
35 #if defined(LITTLE_ENDIAN) || defined(LITTLE)
36 #define H_IONE "\001\000"
37 #define S_IONE "\001\000\000\000"
38 #define D_IONE "\001\000\000\000\000\000\000\000"
39 #define S_RONE "\000\000\200\077"
40 #define D_RONE "\000\000\000\000\000\000\360\077"
41 #define Q_RONE "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\377\077"
42 #else
43 #define H_IONE "\000\001"
44 #define S_IONE "\000\000\000\001"
45 #define D_IONE "\000\000\000\000\000\000\000\001"
46 #define S_RONE "\077\200\000\000"
47 #define D_RONE "\077\360\000\000\000\000\000\000"
48 #if defined(VPP)
49 #define Q_RONE "\077\377\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
50 #else
51 #define Q_RONE "\077\360\000\000\000\000\000\000\074\260\000\000\000\000\000\000"
52 #endif
53 #endif
54 
55 /*
56  --------------------------------------
57  Modify for specific systems & machines
58  --------------------------------------
59 */
60 
61 #define NPREC n_precision_
62 
63 #ifdef __uxp__
64 #define NPREC n_precision_
65 #endif /* __uxp__ */
66 
67 #ifdef __sgi
68 #define NPREC n_precision_
69 #endif /* __sgi */
70 
71 #ifdef sun
72 #define NPREC n_precision_
73 #endif /* sun */
74 
75 #ifdef __hpux
76 #define NPREC n_precision
77 #endif /* __hpux */
78 
79 #ifndef SV2
80 #ifdef _CRAY
81 #define NPREC N_PRECISION
82 
83 #ifndef _CRAYIEEE /* Not IEEE, (not Cray T3d or Cray T90) */
84 
85 #define H_IONE "\000\001"
86 #define S_IONE "\000\000\000\001"
87 #define D_IONE "\000\000\000\000\000\000\000\001"
88 #define S_RONE "\100\001\200\000\000\000\000\000"
89 #define D_RONE "\100\001\200\000\000\000\000\000\000\000\000\000\000\000\000\000"
90 #define Q_RONE "\100\001\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
91 #endif /* _CRAYIEEE */
92 #endif /* _CRAY */
93 #endif /* not SV2 */
94 
95 #ifndef ECMWF_PROTOTYPING
96 #define ECMWF_PROTOTYPING
97 #ifdef __STDC__
98 
99 /* Use ANSI C protyping and declaration */
100 
101 #ifndef __
102 #define __(_S) _S /* use ANSI prototype */
103 #endif /* __ */
104 
105 #ifndef ___
106 #define ___(_T,_V) _T _V /* use ANSI formal argument declarations */
107 #endif /* ___ */
108 
109 #else /* __STDC__ */
110 
111 /* Use traditional (K & R) C prototyping and declaration */
112 
113 #ifndef __
114 #define __(_S) () /* use K & R prototype */
115 #endif /* __ */
116 
117 #ifndef ___
118 #define ___(_T,_V) _V /* use K & R formal argument decalaration */
119 #endif /* ___ */
120 
121 #define const
122 #define volatile
123 #define void char
124 #endif /* __STDC__ */
125 #endif /* ECMWF_PROTOTYPING */
126 
127 INTEGER NPREC __((char *));
128 
129 /* ========================= */
130 INTEGER FORTRAN_FUNCTION NPREC(___(char *, value))
131 /* ========================= */
132 
133 #ifndef __STDC__
134  char * value;
135 #endif /* !__STDC__ */
136 
137 {
138 /*
139 ******************************************************************************
140 **
141 * NAME
142 * N_PRECISION - Return the no. of bytes in a REAL/DOUBLE_PREC/INTEGER
143 *
144 * SYNOPSIS
145 * INTEGER FUNCTION N_PRECISION(VAL_ARRAY)
146 *
147 * STANDARDS
148 * ECMWF extension. A FORTRAN-CALLABLE routine.
149 *
150 * DESCRIPTION
151 * The N_PRECISION function returns the number of bytes of storage that
152 * are occupied by a variable, whose type is given by the values in the
153 * VAL_ARRAY. The amount of storage is not necessarily the number of
154 * bytes used to represent the quantity. For example, on the C90 the
155 * number of bytes of storage for an INTEGER is 8 (64 bits), while the
156 * internal representation uses only the lower 46 bits!
157 *
158 * VAL_ARRAY is a 2-element array, both of which are set to the value 1.
159 * This value, and the spacing between the 2 values, can then be used to
160 * calculate the number of bytes of storage occupied by a variable of the
161 * same type.
162 *
163 * EXAMPLE
164 *
165 * PROGRAM testit
166 * INTEGER*4 n_precision
167 *
168 * REAL*4 x4(2)
169 * REAL*8 x8(2)
170 * REAL*16 x16(2) ! DOUBLE NOT ALLOWED ON THE T3D
171 * REAL xr(2)
172 * DOUBLE PRECISION xd(2) ! DOUBLE NOT ALLOWED ON THE T3D
173 * INTEGER*2 i2(2)
174 * INTEGER*4 i4(2)
175 * INTEGER*8 i8(2) ! INTEGER*8 NOT ALLOWED ON HP or SUN
176 * INTEGER ii(2)
177 *
178 * DO 10 i = 1, 2
179 * x4 (i) = 1.0
180 * x8 (i) = 1.0
181 * x16(i) = 1.0
182 * xr (i) = 1.0
183 * xd (i) = 1.0
184 * i2 (i) = 1
185 * i4 (i) = 1
186 * i8 (i) = 1
187 * ii (i) = 1
188 * 10 CONTINUE
189 *
190 * print *, 'n_precision(i2 ) = ', n_precision(i2 )
191 * print *, 'n_precision(i4 ) = ', n_precision(i4 )
192 * print *, 'n_precision(i8 ) = ', n_precision(i8 )
193 * print *, 'n_precision(ii ) = ', n_precision(ii )
194 * print *, 'n_precision(x4 ) = ', n_precision(x4 )
195 * print *, 'n_precision(x8 ) = ', n_precision(x8 )
196 * print *, 'n_precision(x16) = ', n_precision(x16)
197 * print *, 'n_precision(xr ) = ', n_precision(xr )
198 * print *, 'n_precision(xd ) = ', n_precision(xd )
199 *
200 * print *, 'n_precision(1.0) = ', n_precision(1.0)
201 * print *, 'n_precision(0.0) = ', n_precision(0.0)
202 *
203 * STOP
204 * END
205 *
206 * On the VPP300, with the default compiler setting, the output is:
207 *
208 * n_precision(i2 ) = 2
209 * n_precision(i4 ) = 4
210 * n_precision(i8 ) = 8
211 * n_precision(ii ) = 4
212 * n_precision(x4 ) = 4
213 * n_precision(x8 ) = 8
214 * n_precision(x16) = 16
215 * n_precision(xr ) = 4
216 * n_precision(xd ) = 8
217 * n_precision(1.0) = 0 # BAD INPUT
218 * n_precision(0.0) = 0 # BAD INPUT
219 *
220 * On the SGI, with the default compiler settings, the output is:
221 *
222 * n_precision(i2 ) = 2
223 * n_precision(i4 ) = 4
224 * n_precision(i8 ) = 8
225 * n_precision(ii ) = 4
226 * n_precision(x4 ) = 4
227 * n_precision(x8 ) = 8
228 * n_precision(x16) = 8 # REAL*16 treated as REAL*8
229 * n_precision(xr ) = 4
230 * n_precision(xd ) = 8
231 * n_precision(1.0) = 0 # BAD INPUT
232 * n_precision(0.0) = 0 # BAD INPUT
233 *
234 * On the HP, with the default compiler settings, the output is:
235 *
236 * n_precision(i2 ) = 2
237 * n_precision(i4 ) = 4
238 * n_precision(i8 ) = 4 # HP DOES NOT ALLOW 8-BYTE INTEGERS
239 * n_precision(ii ) = 4
240 * n_precision(x4 ) = 4
241 * n_precision(x8 ) = 8
242 * n_precision(x16) = 16
243 * n_precision(xr ) = 4
244 * n_precision(xd ) = 8
245 * n_precision(1.0) = 0 # BAD INPUT
246 * n_precision(0.0) = 0 # BAD INPUT
247 *
248 * On the SUN, with the default compiler settings, the output is:
249 *
250 * n_precision(i2 ) = 2
251 * n_precision(i4 ) = 4
252 * n_precision(i8 ) = 4 # SUN DOES NOT ALLOW 8-BYTE INTEGERS
253 * n_precision(ii ) = 4
254 * n_precision(x4 ) = 4
255 * n_precision(x8 ) = 8
256 * n_precision(x16) = 16
257 * n_precision(xr ) = 4
258 * n_precision(xd ) = 8
259 * n_precision(1.0) = 0 # BAD INPUT
260 * n_precision(0.0) = 0 # BAD INPUT
261 *
262 * On the Cray C90, with the default compiler settings, the output is:
263 *
264 * n_precision(i2 ) = 8 # NOT 2, Storage is 1 x 64-bit word
265 * n_precision(i4 ) = 8 # NOT 4, Storage is 1 x 64-bit word
266 * n_precision(i8 ) = 8
267 * n_precision(ii ) = 8
268 * n_precision(x4 ) = 8 # NOT 4, REAL*4 => REAL*8
269 * n_precision(x8 ) = 8
270 * n_precision(x16) = 16
271 * n_precision(xr ) = 8
272 * n_precision(xd ) = 16
273 * n_precision(1.0) = 0 # BAD INPUT
274 * n_precision(0.0) = 0 # BAD INPUT
275 *
276 * On the Cray T3D, with the default compiler settings, the output is:
277 *
278 * n_precision(i2 ) = 8 # NOT 2, Storage is 1 x 64-bit word
279 * n_precision(i4 ) = 8 # NOT 4, Storage is 1 x 64-bit word
280 * n_precision(i8 ) = 8
281 * n_precision(ii ) = 8
282 * n_precision(x4 ) = 8 # NOT 4, REAL*4 => REAL*8
283 * n_precision(x8 ) = 8
284 * n_precision(x16) = 8 # T3D DOES NOT ALLOW DOUBLE-PRECISION
285 * n_precision(xr ) = 8
286 * n_precision(xd ) = 8 # T3D DOES NOT ALLOW DOUBLE-PRECISION
287 * n_precision(1.0) = 0 # BAD INPUT
288 * n_precision(0.0) = 0 # BAD INPUT
289 *
290 * RETURN VALUE
291 * Successful completion is indicated by a non-zero value.
292 *
293 * 0 - The input array was probably incorrect, i.e. it was not a
294 * 2-element array, or one or both of the elements were not set to
295 * the value 1. (See above example)
296 *
297 * n - The number of BYTEs that the array element, and hence the
298 * variable TYPE, occupies. This can be one of: 2, 4, 8, 16.
299 *
300 * SEE ALSO
301 * NR_COMPAT_EC, ND_COMPAT_EC, NI_COMPAT_EC
302 **
303 ******************************************************************************
304 */
305 
306 /* ========= DEBUG ========
307  unsigned char *val = (unsigned char *) value;
308  int i, j;
309 
310  printf("INPUT VALUE=");
311  for (i = 0; i < 16 ; i++)
312  {
313  j = val[i];
314  printf("/%3.3o", j);
315  }
316  printf("\n");
317  ========== DEBUG ======== */
318 
319 /*
320  ----------------------
321  Half-precision INTEGER
322  ----------------------
323 */
324 
325  if (MATCHN(value, H_IONE, H_ILEN))
326  {
327  if (MATCHN(value + H_ILEN, H_IONE, H_ILEN))
328  return H_ILEN;
329  }
330 
331 /*
332  ------------------------
333  Single-precision INTEGER
334  ------------------------
335 */
336 
337  if (MATCHN(value, S_IONE, S_ILEN))
338  {
339  if (MATCHN(value + S_ILEN, S_IONE, S_ILEN))
340  return S_ILEN;
341  }
342 
343 /*
344  ---------------------
345  Single-precision REAL
346  ---------------------
347 */
348 
349  if (MATCHN(value, S_RONE, S_RLEN))
350  {
351  if (MATCHN(value + S_RLEN, S_RONE, S_RLEN))
352  return S_RLEN;
353  }
354 
355 /*
356  ------------------------
357  Double-precision INTEGER
358  ------------------------
359 */
360 
361  if (MATCHN(value, D_IONE, D_ILEN))
362  {
363  if (MATCHN(value + D_ILEN, D_IONE, D_ILEN))
364  return D_ILEN;
365  }
366 
367 /*
368  ---------------------
369  Double-precision REAL
370  ---------------------
371 */
372 
373  if (MATCHN(value, D_RONE, D_RLEN))
374  {
375  if (MATCHN(value + D_RLEN, D_RONE, D_RLEN))
376  return D_RLEN;
377  }
378 
379 /*
380  ------------------------
381  Quadruple-precision REAL
382  ------------------------
383 */
384 
385  if (MATCHN(value, Q_RONE, Q_RLEN))
386  {
387  if (MATCHN(value + Q_RLEN, Q_RONE, Q_RLEN))
388  return Q_RLEN;
389  }
390 
391 /*
392  ------------------=============
393  NONE OF THE ABOVE - ERROR ERROR
394  ------------------=============
395 */
396 
397  return 0;
398 }
399 
__
INTEGER NPREC __((char *))
NPREC
INTEGER FORTRAN_FUNCTION NPREC(___(char *, value))
Definition: n_precision.c:130
INTEGER
INTERFACE SUBROUTINE JPRB IMPLICIT NONE INTEGER(KIND=JPIM)
Generated on Tue Jan 16 2018 16:23:22 for SURFEX v8.1 by   doxygen 1.8.13