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
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
|
Description: Fix errors/warnings with gfortran 10
Fix some warnings on delete Feature
BOZ elements now more strictly interpreted
Author: Alastair McKinstry <mckinstry@debian.org>
Last-Updated: 2020-04-26
Forwarded: no
Index: pyferret-7.6.0~beta/fer/special/ferret_dispatch.F
===================================================================
--- pyferret-7.6.0~beta.orig/fer/special/ferret_dispatch.F
+++ pyferret-7.6.0~beta/fer/special/ferret_dispatch.F
@@ -188,9 +188,10 @@
* transfer the c-style string into a FORTRAN string
cmnd_buff = ' '
c DO 2 i = 1, 200
- DO 2 i = 1, cmnd_buff_len
+ DO i = 1, cmnd_buff_len
IF ( command(i) .EQ. 0 ) GOTO 5
- 2 cmnd_buff(i:i) = CHAR( command(i) )
+ cmnd_buff(i:i) = CHAR( command(i) )
+ END DO
5 CALL GET_FER_COMMAND( cmnd_buff, status, *300 )
Index: pyferret-7.6.0~beta/ppl/tmapadds/compute_mnstd.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/tmapadds/compute_mnstd.F
+++ pyferret-7.6.0~beta/ppl/tmapadds/compute_mnstd.F
@@ -71,7 +71,7 @@ C**
* internal variable declarations:
REAL*8 sum, dev, sumsq_dev, variance, tol_lo, tol_hi, zmean2
- LOGICAL TM_FPEQ_SNGL, TM_FPEQ, zmax_test, zmin_test, ok
+ LOGICAL TM_FPEQ_SNGL, TM_FPEQ, TM_DFPEQ, zmax_test, zmin_test, ok
REAL zero, rbad
REAL*8 x, xmean, sum2, sumc, variance_c, xdelta,
. z_max_tol, z_min_tol, zlo, zhi
@@ -295,7 +295,7 @@ c Once more.
IF (TM_FPEQ_SNGL(zstd/zmean, zero)) GOTO 5010
ELSE
x = MAX(ABS(zmin), ABS(zmax))
- IF (TM_FPEQ(zstd/x , zero) ) GOTO 5010
+ IF (TM_DFPEQ(zstd/x , zero) ) GOTO 5010
ENDIF
ENDIF
Index: pyferret-7.6.0~beta/ppl/tmapadds/aline_sub.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/tmapadds/aline_sub.F
+++ pyferret-7.6.0~beta/ppl/tmapadds/aline_sub.F
@@ -140,10 +140,11 @@ c acm! IF(ITYPE(a_line).GE.4) THEN ! OLD
. CALL MARK(IMARK(a_line))
IM=0
IF (ITYPE(a_line).EQ.1.OR.ITYPE(a_line).EQ.3)IM=IMARK(a_line)
- DO 60 J=1,2
+ DO J=1,2
CALL TRANS(1,X(J),X(IY+J),XT,YT)
CALL PLOT(XT,YT,1,0)
-60 CALL MARK(IM)
+ CALL MARK(IM)
+ END DO
IF (ITYPE(a_line).EQ.2.OR.ITYPE(a_line).EQ.5)
. CALL MARK(IMARK(a_line))
CALL COLOR(IPEN(0))
Index: pyferret-7.6.0~beta/ppl/tmapadds/kurv.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/tmapadds/kurv.F
+++ pyferret-7.6.0~beta/ppl/tmapadds/kurv.F
@@ -138,10 +138,11 @@ c
c determine polygonal arclengths
c
s(1) = 0.
- do 1 i = 2,n
+ do i = 2,n
im1 = i-1
- 1 s(i) = s(im1)+sqrt((x(i)-x(im1))**2+
- * (y(i)-y(im1))**2)
+ s(i) = s(im1)+sqrt((x(i)-x(im1))**2+
+ * (y(i)-y(im1))**2)
+ end do
c
c denormalize tension factor
c
@@ -194,7 +195,7 @@ c
yp(1) = (dy1-slpp1y)/diag1
temp(1) = sdiag1/diag1
if (n .eq. 2) go to 9
- do 8 i = 2,nm1
+ do i = 2,nm1
dels2 = s(i+1)-s(i)
if (dels2 .eq. 0.) go to 12
dx2 = (x(i+1)-x(i))/dels2
@@ -208,17 +209,19 @@ c
dx1 = dx2
dy1 = dy2
diag1 = diag2
- 8 sdiag1 = sdiag2
+ sdiag1 = sdiag2
+ end do
9 diag = diag1-sdiag1*temp(nm1)
xp(n) = (slppnx-dx1-sdiag1*xp(nm1))/diag
yp(n) = (slppny-dy1-sdiag1*yp(nm1))/diag
c
c perform back substitution
c
- do 10 i = 2,n
+ do i = 2,n
ibak = np1-i
xp(ibak) = xp(ibak)-temp(ibak)*xp(ibak+1)
- 10 yp(ibak) = yp(ibak)-temp(ibak)*yp(ibak+1)
+ yp(ibak) = yp(ibak)-temp(ibak)*yp(ibak+1)
+ end do
return
c
c too few points
Index: pyferret-7.6.0~beta/ppl/tmapadds/fillpol.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/tmapadds/fillpol.F
+++ pyferret-7.6.0~beta/ppl/tmapadds/fillpol.F
@@ -177,9 +177,10 @@ C Check switches
* "zpolybase" is the offset to the ycolor array
xpolybase = 1
ptsbase = ibase - lnum
- DO 2010 I=1,nl
+ DO I=1,nl
llen = x(ptsbase+i-1)
- 2010 xpolybase = xpolybase+llen
+ xpolybase = xpolybase+llen
+ END DO
llen = x(ibase-1) ! Length of color array
Index: pyferret-7.6.0~beta/ppl/tmapadds/line_key.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/tmapadds/line_key.F
+++ pyferret-7.6.0~beta/ppl/tmapadds/line_key.F
@@ -148,10 +148,11 @@ C KTYPE = 1 -XY 0 -Z 2-VECTOR
X(IY+2) = 0.5*(X(IY+1) + X(IY+3))
ENDIF
- DO 60 J=1,NPT
+ DO J=1,NPT
CALL TRANS(1,X(J),X(IY+J),XT,YT)
CALL PLOT(XT,YT,1,0)
-60 CALL MARK(IM)
+ CALL MARK(IM)
+ END DO
IF (ITYPE(a_line).EQ.2.OR.ITYPE(a_line).EQ.5)
. CALL MARK(IMARK(a_line))
Index: pyferret-7.6.0~beta/ppl/tmapadds/setfont.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/tmapadds/setfont.F
+++ pyferret-7.6.0~beta/ppl/tmapadds/setfont.F
@@ -113,11 +113,12 @@ C
C SETUP IOFF
C
IF(II.EQ.4)GOTO 1008
- DO 1007 IJ=II+1,4
+ DO IJ=II+1,4
IOFF(IJ)=12000
KIF(IJ)='@@'
IFN(IJ)='@@'
-1007 IFLEN(IJ)=0
+ IFLEN(IJ)=0
+ END DO
IOFF(II+1)=IOFF(II)+IFLEN(II)
C
C READ NEW FONT
Index: pyferret-7.6.0~beta/ppl/tmapadds/shade_sub.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/tmapadds/shade_sub.F
+++ pyferret-7.6.0~beta/ppl/tmapadds/shade_sub.F
@@ -214,8 +214,9 @@ C data statement of my_trans added
IF ( ITS_CURV_EDGES(1) ) THEN
* ... User gave Ferret edge points as coords -- set indices to point to them
* e.g. 1, 2, 3, ..., N+1
- DO 11 i = 1, nx
- 11 xs(i) = xc(i)
+ DO i = 1, nx
+ xs(i) = xc(i)
+ END DO
xs(nx+1) = xs(nx) + 1
ELSE
* ... User gave Ferret grid points as coords -- set indices to index midpoints
@@ -253,14 +254,15 @@ C data statement of my_trans added
IF (ppl_in_ferret) THEN ! JD 1.2.90
IF ( curvilinear ) THEN
IF ( ITS_CURV_EDGES(2) ) THEN
- DO 21 i = 1, ny
- 21 ys(i) = yc(i)
+ DO i = 1, ny
+ ys(i) = yc(i)
+ END DO
ys(ny+1) = ys(ny) + 1
ELSE
ys(1) = (yc(1) - (yc(2) - yc(1))/2.0)
- DO 22 i = 1,ny-1
+ DO i = 1,ny-1
ys(i+1) = (yc(i) + (yc(i+1) - yc(i))/2.0)
-22 CONTINUE
+ END DO
ys(ny+1) = (yc(ny) + (yc(ny) - yc(ny-1))/2.0)
ENDIF
ELSE
@@ -269,15 +271,15 @@ C data statement of my_trans added
interrupted = .true.
GOTO 3333
ENDIF
- DO 31 j = 1,ny+1
+ DO j = 1,ny+1
ys(j) = ys(j)*yinv
-31 CONTINUE
+ END DO
ENDIF
ELSE
ys(1) = (yc(1) - (yc(2) - yc(1))/2.0)*yinv
- DO 35 j = 1,ny-1
+ DO j = 1,ny-1
ys(j+1) = (yc(j) + (yc(j+1) - yc(j))/2.0)*yinv
-35 CONTINUE
+ END DO
ys(ny+1) = (yc(ny) + (yc(ny) - yc(ny-1))/2.0)*yinv
* END 12.13.89
ENDIF
Index: pyferret-7.6.0~beta/ppl/tmapadds/upnsquish.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/tmapadds/upnsquish.F
+++ pyferret-7.6.0~beta/ppl/tmapadds/upnsquish.F
@@ -70,7 +70,7 @@ C *jd* Mod for linux port *jd* 12.96
x char(iand(mask,ichar(instr(i:i))))
#else
outstr(len_out:len_out) =
- x char(iand('DF'x,ichar(instr(i:i))))
+ x char(iand(z'DF',ichar(instr(i:i))))
#endif
#else
outstr(len_out:len_out) =
Index: pyferret-7.6.0~beta/ppl/complot/igrinpt.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/complot/igrinpt.F
+++ pyferret-7.6.0~beta/ppl/complot/igrinpt.F
@@ -136,7 +136,7 @@ CC Linux port:
#ifdef FORTRAN_90
data octal37/O'37'/
#else
- data octal37/'37'O/
+ data octal37/O'37'/
#endif
#ifdef FORTRAN_90
Index: pyferret-7.6.0~beta/ppl/complot/positon.F
===================================================================
--- pyferret-7.6.0~beta.orig/ppl/complot/positon.F
+++ pyferret-7.6.0~beta/ppl/complot/positon.F
@@ -73,7 +73,7 @@ CC Linux port:
#ifdef FORTRAN_90
data octal37/O'37'/
#else
- data octal37/'37'O/
+ data octal37/O'37'/
#endif
C
Index: pyferret-7.6.0~beta/fmt/src/cd_load_dset_attrs.F
===================================================================
--- pyferret-7.6.0~beta.orig/fmt/src/cd_load_dset_attrs.F
+++ pyferret-7.6.0~beta/fmt/src/cd_load_dset_attrs.F
@@ -105,8 +105,9 @@
ds_t0time(dset) = ' '
ds_ntegrate_tstep(dset) = 1
ds_time_run(dset) = ' '
- DO 120 i = 1,num_aux
- 120 cd_what_isit(i,dset)= ' '
+ DO i = 1,num_aux
+ cd_what_isit(i,dset)= ' '
+ END DO
ENDIF
* time axis
@@ -266,8 +267,8 @@
ds_prog_rev(dset)(1:1) = CHAR( IOR(HEX40,i/26 + 1 ) )
ds_prog_rev(dset)(2:2) = CHAR( IOR(HEX40,MOD(i,26) + 1 ) )
#else
- ds_prog_rev(dset)(1:1) = CHAR( IOR('40'X,i/26 + 1 ) )
- ds_prog_rev(dset)(2:2) = CHAR( IOR('40'X,MOD(i,26) + 1 ) )
+ ds_prog_rev(dset)(1:1) = CHAR( IOR(Z'40',i/26 + 1 ) )
+ ds_prog_rev(dset)(2:2) = CHAR( IOR(Z'40',MOD(i,26) + 1 ) )
#endif
* Allocate a "step file" slot to save CDF id and filename
* Find the next storage position for stepfiles in common
Index: pyferret-7.6.0~beta/fer/rpn/init_uvar.F
===================================================================
--- pyferret-7.6.0~beta.orig/fer/rpn/init_uvar.F
+++ pyferret-7.6.0~beta/fer/rpn/init_uvar.F
@@ -254,13 +254,13 @@
uvar_child = gcf_uvar(gcfstk)
parent = gcf_uvar(gcfstk-1)
ELSE
- DO 850 uvar_child = 1, max_uvar
+ DO uvar_child = 1, max_uvar
IF ( uvar_child .EQ. uvar ) GOTO 850
IF ( uvar_num_items( uvar_child ) .EQ. uvar_deleted ) THEN
parent = gcf_uvar(gcfstk)
GOTO 860
ENDIF
- 850 CONTINUE
+ 850 END DO
GOTO 5900
ENDIF
@@ -311,13 +311,13 @@
IF ( status .NE. ferr_OK ) GOTO 5900
* clean up left-over on-hold variables
- DO 1100 uvar_child = 1, max_uvar
+ DO uvar_child = 1, max_uvar
* IF (uvar_num_items(uvar_child) .EQ. uvar_on_hold)
* . uvar_num_items(uvar_child) = uvar_deleted
IF (uvar_num_items(uvar_child) .EQ. uvar_on_hold)
. CALL deleted_list_modify(uvar_num_items_head, uvar_child,
. uvar_deleted )
- 1100 CONTINUE
+ END DO
* successful completion
status = ferr_ok
@@ -325,12 +325,13 @@
* error exit
* ... remove any holds left on variable slots
- 5000 DO 5010 uvar = 1, max_uvar
+ 5000 DO uvar = 1, max_uvar
* 5010 IF ( uvar_num_items(uvar) .EQ. uvar_on_hold )
* . uvar_num_items(uvar) = uvar_deleted
- 5010 IF ( uvar_num_items(uvar) .EQ. uvar_on_hold )
+ IF ( uvar_num_items(uvar) .EQ. uvar_on_hold )
. CALL deleted_list_modify(uvar_num_items_head, uvar,
. uvar_deleted )
+ END DO
RETURN
5100 CALL ERRMSG( ferr_prog_limit, status,
Index: pyferret-7.6.0~beta/fer/rpn/init_uvar_sub.F
===================================================================
--- pyferret-7.6.0~beta.orig/fer/rpn/init_uvar_sub.F
+++ pyferret-7.6.0~beta/fer/rpn/init_uvar_sub.F
@@ -207,16 +207,16 @@ cc .
ELSE
* ... convert lower case character to upper case
#if defined unix && ! defined NEED_IAND
- uvar_text(uvar)(i2:i2) = CHAR( AND('DF'X, ICHAR(c)) )
+ uvar_text(uvar)(i2:i2) = CHAR( AND(Z'DF', ICHAR(c)) )
#else
# ifdef FORTRAN_90
uvar_text(uvar)(i2:i2) = CHAR( IAND(HEXDF, ICHAR(c)) )
# elif defined gfortran
- uvar_text(uvar)(i2:i2) = CHAR( AND('DF'X, ICHAR(c)) )
+ uvar_text(uvar)(i2:i2) = CHAR( AND(Z'DF', ICHAR(c)) )
#else
* VMS needs IAND
* bug fix - forgot (uvar) in var reference
- uvar_text(uvar)(i2:i2) = CHAR( IAND('DF'X, ICHAR(c)) )
+ uvar_text(uvar)(i2:i2) = CHAR( IAND(Z'DF', ICHAR(c)) )
# endif
#endif
ENDIF
Index: pyferret-7.6.0~beta/fer/utl/upper_case.F
===================================================================
--- pyferret-7.6.0~beta.orig/fer/utl/upper_case.F
+++ pyferret-7.6.0~beta/fer/utl/upper_case.F
@@ -74,7 +74,7 @@
# ifdef FORTRAN_90
upper_case = CHAR( IAND(HEXDF, ICHAR( input_char ) ) )
# elif defined gfortran
- upper_case = CHAR( AND('DF'X , ICHAR( input_char ) ) )
+ upper_case = CHAR( AND(Z'DF' , ICHAR( input_char ) ) )
# else
upper_case = CHAR( IAND('DF'X , ICHAR( input_char ) ) )
# endif
|
