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
|
C Copyright 1981-2007 ECMWF
C
C Licensed under the GNU Lesser General Public License which
C incorporates the terms and conditions of version 3 of the GNU
C General Public License.
C See LICENSE and gpl-3.0.txt for details.
C
C---->
C
C Functions used in ocean field interpolation.
C
C FUNCTION INTDN(XVAL)
C
C Rounds XVAL to the largest integer less than or equal to XVAL
C ie truncates downwards rather than towards zero.
C
C FUNCTION LENA(HSTRING)
C
C Returns the length of a string, ignoring blank characters at end
C
C FUNCTION HDEGS(RVAL)
C
C Writes a real number into a string, in a way suitable for degs lat/long.
C RVAL The real number
C
C FUNCTION HMETRES(RVAL)
C
C Writes a real number into a string, in a way suitable for metres depth.
C RVAL The real number
C
C----<
INTEGER FUNCTION INTDN(XVAL)
C
C Rounds XVAL to the largest integer less than or equal to XVAL
C ie truncates downwards rather than towards zero.
C
IF((XVAL.GE.0.0).OR.(XVAL.EQ.FLOAT(INT(XVAL)))) THEN
INTDN = INT(XVAL)
ELSE
INTDN = INT(XVAL) - 1
ENDIF
RETURN
END
INTEGER FUNCTION INTUP(XVAL)
C
C Rounds XVAL to the largest integer greater than or equal to XVAL
C ie truncates upwards rather than away from zero.
C
IF(XVAL.EQ.FLOAT(INT(XVAL))) THEN
INTUP=INT(XVAL)
ELSEIF(XVAL.GE.0) THEN
INTUP=INT(XVAL+1)
ELSE
INTUP=INT(XVAL)
ENDIF
RETURN
END
INTEGER FUNCTION LENA(HSTRING)
C
C Returns the length of a string, ignoring blank characters at end
C
CHARACTER*(*) HSTRING
DO 100 J=LEN(HSTRING),1,-1
IF(HSTRING(J:J).NE.' ') GOTO 150
100 CONTINUE
J=0
150 CONTINUE
LENA=J
RETURN
END
FUNCTION HDEGS(RVAL)
C Writes a real number into a string, in a way suitable for degs lat/long.
C RVAL The real number
C
CHARACTER*6 HDEGS
IF(RVAL.GE.0) THEN
IF(RVAL.LT.10.0) THEN
WRITE(HDEGS,'(F4.2)') RVAL
ELSEIF(RVAL.LT.100.0) THEN
WRITE(HDEGS,'(F4.1)') RVAL
ELSEIF(RVAL.LT.1000.0) THEN
WRITE(HDEGS,'(F5.1)') RVAL
ELSE
WRITE(HDEGS,'(F5.0)') RVAL
ENDIF
ELSE
IF(RVAL.GT.-10.0) THEN
WRITE(HDEGS,'(F5.2)') RVAL
ELSEIF(RVAL.GT.-100.0) THEN
WRITE(HDEGS,'(F5.1)') RVAL
ELSEIF(RVAL.GT.-1000.0) THEN
WRITE(HDEGS,'(F6.1)') RVAL
ELSE
WRITE(HDEGS,'(F6.0)') RVAL
ENDIF
ENDIF
RETURN
END
FUNCTION HMETRES(RVAL)
C Writes a real number into a string, in a way suitable for metres depth.
C RVAL The real number
C
CHARACTER*6 HMETRES
IF(RVAL.GE.0) THEN
IF(RVAL.LE.9.99) THEN
IF(INT(RVAL*10)*10.EQ.INT(RVAL*100)) THEN
WRITE(HMETRES,'(F3.1)') RVAL
ELSE
WRITE(HMETRES,'(F4.2)') RVAL
ENDIF
ELSEIF(RVAL.LE.99.9) THEN
WRITE(HMETRES,'(F4.1)') RVAL
ELSEIF(RVAL.LE.999.0) THEN
WRITE(HMETRES,'(F4.0)') RVAL
ELSE
WRITE(HMETRES,'(F5.0)') RVAL
ENDIF
ELSE
IF(RVAL.GE.-9.99) THEN
WRITE(HMETRES,'(F5.2)') RVAL
ELSEIF(RVAL.GE.-99.9) THEN
WRITE(HMETRES,'(F5.1)') RVAL
ELSEIF(RVAL.GE.-999.0) THEN
WRITE(HMETRES,'(F5.0)') RVAL
ELSE
WRITE(HMETRES,'(F6.0)') RVAL
ENDIF
ENDIF
RETURN
END
|
