FV3 Bundle
adBuffer.f
Go to the documentation of this file.
1 C$Id: adBuffer.f,v 1.1 2017/07/24 21:18:32 drholdaw Exp $
2 
3 c PISTES D'AMELIORATIONS:
4 c Attention aux IF qui peuvent couter cher.
5 c On pourrait aussi bufferiser les bits avec N entiers,
6 c (1 bit par entier), passer tout le paquet a C et laisser
7 c C faire les jongleries de bitsets.
8 c On pourrait aussi optimiser en -O3 les primitives de ADFirstAidKit
9 c Regarder l'assembleur (option -S (et -o toto.s))
10 c Pourchasser les divisions!
11 
12  BLOCK DATA lookingornot
13  LOGICAL looking
14  COMMON /lookingfbuf/looking
15  DATA looking/.false./
16  END
17 
18 c======================== BITS ==========================:
19  BLOCK DATA bits
20  INTEGER*4 adbitbuf, adbitlbuf
21  INTEGER adbitibuf, adbitilbuf
22  LOGICAL adbitinlbuf
23  COMMON /adbitfbuf/adbitbuf,adbitlbuf,
24  + adbitibuf,adbitilbuf,adbitinlbuf
25  DATA adbitbuf/0/
26  DATA adbitlbuf/0/
27  DATA adbitibuf/0/
28  DATA adbitilbuf/-1/
29  DATA adbitinlbuf/.false./
30  END
31 
32 c [0,31] are the bit indices we can use in an INTEGER
33 
34  SUBROUTINE pushbit(bit)
35  LOGICAL bit
36  INTEGER*4 adbitbuf, adbitlbuf
37  INTEGER adbitibuf, adbitilbuf
38  LOGICAL adbitinlbuf
39  COMMON /adbitfbuf/adbitbuf,adbitlbuf,
40  + adbitibuf,adbitilbuf,adbitinlbuf
41  LOGICAL looking
42  COMMON /lookingfbuf/looking
43 c
44  IF (adbitilbuf.ne.-1) THEN
45  adbitilbuf = -1
46  adbitinlbuf = .false.
47  looking = .false.
48  ENDIF
49  IF (bit) THEN
50  adbitbuf = ibset(adbitbuf, adbitibuf)
51  ELSE
52  adbitbuf = ibclr(adbitbuf, adbitibuf)
53  ENDIF
54  IF (adbitibuf.ge.31) THEN
55  CALL pushinteger4(adbitbuf)
56  adbitbuf = 0
57  adbitibuf = 0
58  ELSE
59  adbitibuf = adbitibuf+1
60  ENDIF
61  END
62 
63  LOGICAL FUNCTION lookbit()
64  INTEGER*4 adbitbuf, adbitlbuf
65  INTEGER adbitibuf, adbitilbuf
66  LOGICAL adbitinlbuf
67  COMMON /adbitfbuf/adbitbuf,adbitlbuf,
68  + adbitibuf,adbitilbuf,adbitinlbuf
69  LOGICAL looking
70  COMMON /lookingfbuf/looking
71 c
72  IF (adbitilbuf.eq.-1) THEN
73  adbitilbuf=adbitibuf
74  adbitlbuf = adbitbuf
75  IF (.not.looking) THEN
76  CALL resetadlookstack()
77  looking = .true.
78  ENDIF
79  ENDIF
80  IF (adbitilbuf.le.0) THEN
81  CALL lookinteger4(adbitlbuf)
82  adbitilbuf = 31
83  ELSE
84  adbitilbuf = adbitilbuf-1
85  ENDIF
86  lookbit = btest(adbitlbuf, adbitilbuf)
87  END
88 
89  LOGICAL FUNCTION popbit()
90  INTEGER*4 adbitbuf, adbitlbuf
91  INTEGER adbitibuf, adbitilbuf
92  LOGICAL adbitinlbuf
93  COMMON /adbitfbuf/adbitbuf,adbitlbuf,
94  + adbitibuf,adbitilbuf,adbitinlbuf
95  LOGICAL looking
96  COMMON /lookingfbuf/looking
97 c
98  IF (adbitilbuf.ne.-1) THEN
99  adbitilbuf = -1
100  adbitinlbuf = .false.
101  looking = .false.
102  ENDIF
103  IF (adbitibuf.le.0) THEN
104  CALL popinteger4(adbitbuf)
105  adbitibuf = 31
106  ELSE
107  adbitibuf = adbitibuf-1
108  ENDIF
109  popbit = btest(adbitbuf, adbitibuf)
110  END
111 
112 c====================== CONTROL =========================:
113 
114  SUBROUTINE pushcontrol1b(cc)
115  INTEGER cc
116  CALL pushbit(cc.ne.0)
117  END
118 
119  SUBROUTINE popcontrol1b(cc)
120  INTEGER cc
121  LOGICAL POPBIT
122  IF (popbit()) THEN
123  cc = 1
124  ELSE
125  cc = 0
126  ENDIF
127  END
128 
129  SUBROUTINE lookcontrol1b(cc)
130  INTEGER cc
131  LOGICAL LOOKBIT
132  IF (lookbit()) THEN
133  cc = 1
134  ELSE
135  cc = 0
136  ENDIF
137  END
138 
139  SUBROUTINE pushcontrol2b(cc)
140  INTEGER cc
141  CALL pushbit(btest(cc,0))
142  CALL pushbit(btest(cc,1))
143  END
144 
145  SUBROUTINE popcontrol2b(cc)
146  INTEGER cc
147  LOGICAL POPBIT
148  IF (popbit()) THEN
149  cc = 2
150  ELSE
151  cc = 0
152  ENDIF
153  IF (popbit()) cc = ibset(cc,0)
154  END
155 
156  SUBROUTINE lookcontrol2b(cc)
157  INTEGER cc
158  LOGICAL LOOKBIT
159  IF (lookbit()) THEN
160  cc = 2
161  ELSE
162  cc = 0
163  ENDIF
164  IF (lookbit()) cc = ibset(cc,0)
165  END
166 
167  SUBROUTINE pushcontrol3b(cc)
168  INTEGER cc
169  CALL pushbit(btest(cc,0))
170  CALL pushbit(btest(cc,1))
171  CALL pushbit(btest(cc,2))
172  END
173 
174  SUBROUTINE popcontrol3b(cc)
175  INTEGER cc
176  LOGICAL POPBIT
177  IF (popbit()) THEN
178  cc = 4
179  ELSE
180  cc = 0
181  ENDIF
182  IF (popbit()) cc = ibset(cc,1)
183  IF (popbit()) cc = ibset(cc,0)
184  END
185 
186  SUBROUTINE lookcontrol3b(cc)
187  INTEGER cc
188  LOGICAL LOOKBIT
189  IF (lookbit()) THEN
190  cc = 4
191  ELSE
192  cc = 0
193  ENDIF
194  IF (lookbit()) cc = ibset(cc,1)
195  IF (lookbit()) cc = ibset(cc,0)
196  END
197 
198  SUBROUTINE pushcontrol4b(cc)
199  INTEGER cc
200  CALL pushbit(btest(cc,0))
201  CALL pushbit(btest(cc,1))
202  CALL pushbit(btest(cc,2))
203  CALL pushbit(btest(cc,3))
204  END
205 
206  SUBROUTINE popcontrol4b(cc)
207  INTEGER cc
208  LOGICAL POPBIT
209  IF (popbit()) THEN
210  cc = 8
211  ELSE
212  cc = 0
213  ENDIF
214  IF (popbit()) cc = ibset(cc,2)
215  IF (popbit()) cc = ibset(cc,1)
216  IF (popbit()) cc = ibset(cc,0)
217  END
218 
219  SUBROUTINE lookcontrol4b(cc)
220  INTEGER cc
221  LOGICAL LOOKBIT
222  IF (lookbit()) THEN
223  cc = 8
224  ELSE
225  cc = 0
226  ENDIF
227  IF (lookbit()) cc = ibset(cc,2)
228  IF (lookbit()) cc = ibset(cc,1)
229  IF (lookbit()) cc = ibset(cc,0)
230  END
231 
232  SUBROUTINE pushcontrol5b(cc)
233  INTEGER cc
234  CALL pushbit(btest(cc,0))
235  CALL pushbit(btest(cc,1))
236  CALL pushbit(btest(cc,2))
237  CALL pushbit(btest(cc,3))
238  CALL pushbit(btest(cc,4))
239  END
240 
241  SUBROUTINE popcontrol5b(cc)
242  INTEGER cc
243  LOGICAL POPBIT
244  IF (popbit()) THEN
245  cc = 16
246  ELSE
247  cc = 0
248  ENDIF
249  IF (popbit()) cc = ibset(cc,3)
250  IF (popbit()) cc = ibset(cc,2)
251  IF (popbit()) cc = ibset(cc,1)
252  IF (popbit()) cc = ibset(cc,0)
253  END
254 
255  SUBROUTINE lookcontrol5b(cc)
256  INTEGER cc
257  LOGICAL LOOKBIT
258  IF (lookbit()) THEN
259  cc = 16
260  ELSE
261  cc = 0
262  ENDIF
263  IF (lookbit()) cc = ibset(cc,3)
264  IF (lookbit()) cc = ibset(cc,2)
265  IF (lookbit()) cc = ibset(cc,1)
266  IF (lookbit()) cc = ibset(cc,0)
267  END
268 
269  SUBROUTINE pushcontrol6b(cc)
270  INTEGER cc
271  CALL pushbit(btest(cc,0))
272  CALL pushbit(btest(cc,1))
273  CALL pushbit(btest(cc,2))
274  CALL pushbit(btest(cc,3))
275  CALL pushbit(btest(cc,4))
276  CALL pushbit(btest(cc,5))
277  END
278 
279  SUBROUTINE popcontrol6b(cc)
280  INTEGER cc
281  LOGICAL POPBIT
282  IF (popbit()) THEN
283  cc = 16
284  ELSE
285  cc = 0
286  ENDIF
287  IF (popbit()) cc = ibset(cc,4)
288  IF (popbit()) cc = ibset(cc,3)
289  IF (popbit()) cc = ibset(cc,2)
290  IF (popbit()) cc = ibset(cc,1)
291  IF (popbit()) cc = ibset(cc,0)
292  END
293 
294  SUBROUTINE lookcontrol6b(cc)
295  INTEGER cc
296  LOGICAL LOOKBIT
297  IF (lookbit()) THEN
298  cc = 16
299  ELSE
300  cc = 0
301  ENDIF
302  IF (lookbit()) cc = ibset(cc,4)
303  IF (lookbit()) cc = ibset(cc,3)
304  IF (lookbit()) cc = ibset(cc,2)
305  IF (lookbit()) cc = ibset(cc,1)
306  IF (lookbit()) cc = ibset(cc,0)
307  END
308 
309 
310 
311  SUBROUTINE pushcontrol9b(cc)
312  INTEGER cc
313  CALL pushbit(btest(cc,0))
314  CALL pushbit(btest(cc,1))
315  CALL pushbit(btest(cc,2))
316  CALL pushbit(btest(cc,3))
317  CALL pushbit(btest(cc,4))
318  CALL pushbit(btest(cc,5))
319  CALL pushbit(btest(cc,6))
320  CALL pushbit(btest(cc,7))
321  CALL pushbit(btest(cc,8))
322  CALL pushbit(btest(cc,9))
323  END
324 
325  SUBROUTINE popcontrol9b(cc)
326  INTEGER cc
327  LOGICAL POPBIT
328  IF (popbit()) THEN
329  cc = 16
330  ELSE
331  cc = 0
332  ENDIF
333  IF (popbit()) cc = ibset(cc,7)
334  IF (popbit()) cc = ibset(cc,6)
335  IF (popbit()) cc = ibset(cc,5)
336  IF (popbit()) cc = ibset(cc,4)
337  IF (popbit()) cc = ibset(cc,3)
338  IF (popbit()) cc = ibset(cc,2)
339  IF (popbit()) cc = ibset(cc,1)
340  IF (popbit()) cc = ibset(cc,0)
341  END
342 
343  SUBROUTINE lookcontrol9b(cc)
344  INTEGER cc
345  LOGICAL LOOKBIT
346  IF (lookbit()) THEN
347  cc = 16
348  ELSE
349  cc = 0
350  ENDIF
351  IF (lookbit()) cc = ibset(cc,7)
352  IF (lookbit()) cc = ibset(cc,6)
353  IF (lookbit()) cc = ibset(cc,5)
354  IF (lookbit()) cc = ibset(cc,4)
355  IF (lookbit()) cc = ibset(cc,3)
356  IF (lookbit()) cc = ibset(cc,2)
357  IF (lookbit()) cc = ibset(cc,1)
358  IF (lookbit()) cc = ibset(cc,0)
359  END
360 
361 c======================= BOOLEANS =========================
362 
363  SUBROUTINE pushboolean(x)
364  LOGICAL x
365  CALL pushbit(x)
366  END
367 
368  SUBROUTINE lookboolean(x)
369  LOGICAL x, LOOKBIT
370  x = lookbit()
371  END
372 
373  SUBROUTINE popboolean(x)
374  LOGICAL x, POPBIT
375  x = popbit()
376  END
377 
378 c===================== CHARACTERS =======================:
379  BLOCK DATA characters
380  CHARACTER ads1buf(512), ads1lbuf(512)
381  INTEGER ads1ibuf,ads1ilbuf
382  LOGICAL ads1inlbuf
383  COMMON /ads1fbuf/ads1buf,ads1lbuf,
384  + ads1ibuf,ads1ilbuf,ads1inlbuf
385  DATA ads1ibuf/1/
386  DATA ads1ilbuf/-1/
387  DATA ads1inlbuf/.false./
388  END
389 
390  SUBROUTINE pushcharacter(x)
391  CHARACTER x, ads1buf(512), ads1lbuf(512)
392  INTEGER ads1ibuf,ads1ilbuf
393  LOGICAL ads1inlbuf
394  COMMON /ads1fbuf/ads1buf,ads1lbuf,
395  + ads1ibuf,ads1ilbuf,ads1inlbuf
396  LOGICAL looking
397  COMMON /lookingfbuf/looking
398 c
399  CALL addftraffic(1)
400  IF (ads1ilbuf.ne.-1) THEN
401  ads1ilbuf = -1
402  ads1inlbuf = .false.
403  looking = .false.
404  ENDIF
405  IF (ads1ibuf.ge.512) THEN
406  ads1buf(512) = x
407  CALL pushcharacterarray(ads1buf, 512)
408  CALL addftraffic(-512)
409  ads1ibuf = 1
410  ELSE
411  ads1buf(ads1ibuf) = x
412  ads1ibuf = ads1ibuf+1
413  ENDIF
414  END
415 
416  SUBROUTINE lookcharacter(x)
417  CHARACTER x, ads1buf(512), ads1lbuf(512)
418  INTEGER ads1ibuf,ads1ilbuf
419  LOGICAL ads1inlbuf
420  COMMON /ads1fbuf/ads1buf,ads1lbuf,
421  + ads1ibuf,ads1ilbuf,ads1inlbuf
422  LOGICAL looking
423  COMMON /lookingfbuf/looking
424 c
425  IF (ads1ilbuf.eq.-1) THEN
426  ads1ilbuf=ads1ibuf
427  IF (.not.looking) THEN
428  CALL resetadlookstack()
429  looking = .true.
430  ENDIF
431  ENDIF
432  IF (ads1ilbuf.le.1) THEN
433  CALL lookcharacterarray(ads1lbuf, 512)
434  ads1inlbuf = .true.
435  ads1ilbuf = 512
436  x = ads1lbuf(512)
437  ELSE
438  ads1ilbuf = ads1ilbuf-1
439  if (ads1inlbuf) THEN
440  x = ads1lbuf(ads1ilbuf)
441  ELSE
442  x = ads1buf(ads1ilbuf)
443  ENDIF
444  ENDIF
445  END
446 
447  SUBROUTINE popcharacter(x)
448  CHARACTER x, ads1buf(512), ads1lbuf(512)
449  INTEGER ads1ibuf,ads1ilbuf
450  LOGICAL ads1inlbuf
451  COMMON /ads1fbuf/ads1buf,ads1lbuf,
452  + ads1ibuf,ads1ilbuf,ads1inlbuf
453  LOGICAL looking
454  COMMON /lookingfbuf/looking
455 c
456  IF (ads1ilbuf.ne.-1) THEN
457  ads1ilbuf = -1
458  ads1inlbuf = .false.
459  looking = .false.
460  ENDIF
461  IF (ads1ibuf.le.1) THEN
462  CALL popcharacterarray(ads1buf, 512)
463  ads1ibuf = 512
464  x = ads1buf(512)
465  ELSE
466  ads1ibuf = ads1ibuf-1
467  x = ads1buf(ads1ibuf)
468  ENDIF
469  END
470 
471 c======================= INTEGER*4 =========================:
472  BLOCK DATA integers4
473  INTEGER*4 adi4buf(512), adi4lbuf(512)
474  INTEGER adi4ibuf,adi4ilbuf
475  LOGICAL adi4inlbuf
476  COMMON /adi4fbuf/adi4buf,adi4lbuf,
477  + adi4ibuf,adi4ilbuf,adi4inlbuf
478  DATA adi4ibuf/1/
479  DATA adi4ilbuf/-1/
480  DATA adi4inlbuf/.false./
481  END
482 
483  SUBROUTINE pushinteger4(x)
484  INTEGER*4 x, adi4buf(512), adi4lbuf(512)
485  INTEGER adi4ibuf,adi4ilbuf
486  LOGICAL adi4inlbuf
487  COMMON /adi4fbuf/adi4buf,adi4lbuf,
488  + adi4ibuf,adi4ilbuf,adi4inlbuf
489  LOGICAL looking
490  COMMON /lookingfbuf/looking
491 c
492  CALL addftraffic(4)
493  IF (adi4ilbuf.ne.-1) THEN
494  adi4ilbuf = -1
495  adi4inlbuf = .false.
496  looking = .false.
497  ENDIF
498  IF (adi4ibuf.ge.512) THEN
499  adi4buf(512) = x
500  CALL pushinteger4array(adi4buf, 512)
501  CALL addftraffic(-2048)
502  adi4ibuf = 1
503  ELSE
504  adi4buf(adi4ibuf) = x
505  adi4ibuf = adi4ibuf+1
506  ENDIF
507  END
508 
509  SUBROUTINE lookinteger4(x)
510  INTEGER*4 x, adi4buf(512), adi4lbuf(512)
511  INTEGER adi4ibuf,adi4ilbuf
512  LOGICAL adi4inlbuf
513  COMMON /adi4fbuf/adi4buf,adi4lbuf,
514  + adi4ibuf,adi4ilbuf,adi4inlbuf
515  LOGICAL looking
516  COMMON /lookingfbuf/looking
517 c
518  IF (adi4ilbuf.eq.-1) THEN
519  adi4ilbuf=adi4ibuf
520  IF (.not.looking) THEN
521  CALL resetadlookstack()
522  looking = .true.
523  ENDIF
524  ENDIF
525  IF (adi4ilbuf.le.1) THEN
526  CALL lookinteger4array(adi4lbuf, 512)
527  adi4inlbuf = .true.
528  adi4ilbuf = 512
529  x = adi4lbuf(512)
530  ELSE
531  adi4ilbuf = adi4ilbuf-1
532  if (adi4inlbuf) THEN
533  x = adi4lbuf(adi4ilbuf)
534  ELSE
535  x = adi4buf(adi4ilbuf)
536  ENDIF
537  ENDIF
538  END
539 
540  SUBROUTINE popinteger4(x)
541  INTEGER*4 x, adi4buf(512), adi4lbuf(512)
542  INTEGER adi4ibuf,adi4ilbuf
543  LOGICAL adi4inlbuf
544  COMMON /adi4fbuf/adi4buf,adi4lbuf,
545  + adi4ibuf,adi4ilbuf,adi4inlbuf
546  LOGICAL looking
547  COMMON /lookingfbuf/looking
548 c
549  IF (adi4ilbuf.ne.-1) THEN
550  adi4ilbuf = -1
551  adi4inlbuf = .false.
552  looking = .false.
553  ENDIF
554  IF (adi4ibuf.le.1) THEN
555  CALL popinteger4array(adi4buf, 512)
556  adi4ibuf = 512
557  x = adi4buf(512)
558  ELSE
559  adi4ibuf = adi4ibuf-1
560  x = adi4buf(adi4ibuf)
561  ENDIF
562  END
563 
564 c======================= INTEGER*8 =========================
565  BLOCK DATA integers8
566  INTEGER*8 adi8buf(512), adi8lbuf(512)
567  INTEGER adi8ibuf,adi8ilbuf
568  LOGICAL adi8inlbuf
569  COMMON /adi8fbuf/adi8buf,adi8lbuf,
570  + adi8ibuf,adi8ilbuf,adi8inlbuf
571  DATA adi8ibuf/1/
572  DATA adi8ilbuf/-1/
573  DATA adi8inlbuf/.false./
574  END
575 
576  SUBROUTINE pushinteger8(x)
577  INTEGER*8 x, adi8buf(512), adi8lbuf(512)
578  INTEGER adi8ibuf,adi8ilbuf
579  LOGICAL adi8inlbuf
580  COMMON /adi8fbuf/adi8buf,adi8lbuf,
581  + adi8ibuf,adi8ilbuf,adi8inlbuf
582  LOGICAL looking
583  COMMON /lookingfbuf/looking
584 c
585  CALL addftraffic(8)
586  IF (adi8ilbuf.ne.-1) THEN
587  adi8ilbuf = -1
588  adi8inlbuf = .false.
589  looking = .false.
590  ENDIF
591  IF (adi8ibuf.ge.512) THEN
592  adi8buf(512) = x
593  CALL pushinteger8array(adi8buf, 512)
594  CALL addftraffic(-4096)
595  adi8ibuf = 1
596  ELSE
597  adi8buf(adi8ibuf) = x
598  adi8ibuf = adi8ibuf+1
599  ENDIF
600  END
601 
602  SUBROUTINE lookinteger8(x)
603  INTEGER*8 x, adi8buf(512), adi8lbuf(512)
604  INTEGER adi8ibuf,adi8ilbuf
605  LOGICAL adi8inlbuf
606  COMMON /adi8fbuf/adi8buf,adi8lbuf,
607  + adi8ibuf,adi8ilbuf,adi8inlbuf
608  LOGICAL looking
609  COMMON /lookingfbuf/looking
610 c
611  IF (adi8ilbuf.eq.-1) THEN
612  adi8ilbuf=adi8ibuf
613  IF (.not.looking) THEN
614  CALL resetadlookstack()
615  looking = .true.
616  ENDIF
617  ENDIF
618  IF (adi8ilbuf.le.1) THEN
619  CALL lookinteger8array(adi8lbuf, 512)
620  adi8inlbuf = .true.
621  adi8ilbuf = 512
622  x = adi8lbuf(512)
623  ELSE
624  adi8ilbuf = adi8ilbuf-1
625  if (adi8inlbuf) THEN
626  x = adi8lbuf(adi8ilbuf)
627  ELSE
628  x = adi8buf(adi8ilbuf)
629  ENDIF
630  ENDIF
631  END
632 
633  SUBROUTINE popinteger8(x)
634  INTEGER*8 x, adi8buf(512), adi8lbuf(512)
635  INTEGER adi8ibuf,adi8ilbuf
636  LOGICAL adi8inlbuf
637  COMMON /adi8fbuf/adi8buf,adi8lbuf,
638  + adi8ibuf,adi8ilbuf,adi8inlbuf
639  LOGICAL looking
640  COMMON /lookingfbuf/looking
641 c
642  IF (adi8ilbuf.ne.-1) THEN
643  adi8ilbuf = -1
644  adi8inlbuf = .false.
645  looking = .false.
646  ENDIF
647  IF (adi8ibuf.le.1) THEN
648  CALL popinteger8array(adi8buf, 512)
649  adi8ibuf = 512
650  x = adi8buf(512)
651  ELSE
652  adi8ibuf = adi8ibuf-1
653  x = adi8buf(adi8ibuf)
654  ENDIF
655  END
656 
657 c======================= REAL*4 =========================
658  BLOCK DATA reals4
659  REAL*4 adr4buf(512), adr4lbuf(512)
660  INTEGER adr4ibuf,adr4ilbuf
661  LOGICAL adr4inlbuf
662  COMMON /adr4fbuf/adr4buf,adr4lbuf,
663  + adr4ibuf,adr4ilbuf,adr4inlbuf
664  DATA adr4ibuf/1/
665  DATA adr4ilbuf/-1/
666  DATA adr4inlbuf/.false./
667  END
668 
669  SUBROUTINE pushreal4(x)
670  REAL*4 x, adr4buf(512), adr4lbuf(512)
671  INTEGER adr4ibuf,adr4ilbuf
672  LOGICAL adr4inlbuf
673  COMMON /adr4fbuf/adr4buf,adr4lbuf,
674  + adr4ibuf,adr4ilbuf,adr4inlbuf
675  LOGICAL looking
676  COMMON /lookingfbuf/looking
677 c
678  CALL addftraffic(4)
679  IF (adr4ilbuf.ne.-1) THEN
680  adr4ilbuf = -1
681  adr4inlbuf = .false.
682  looking = .false.
683  ENDIF
684  IF (adr4ibuf.ge.512) THEN
685  adr4buf(512) = x
686  CALL pushreal4array(adr4buf, 512)
687  CALL addftraffic(-2048)
688  adr4ibuf = 1
689  ELSE
690  adr4buf(adr4ibuf) = x
691  adr4ibuf = adr4ibuf+1
692  ENDIF
693  END
694 
695  SUBROUTINE lookreal4(x)
696  REAL*4 x, adr4buf(512), adr4lbuf(512)
697  INTEGER adr4ibuf,adr4ilbuf
698  LOGICAL adr4inlbuf
699  COMMON /adr4fbuf/adr4buf,adr4lbuf,
700  + adr4ibuf,adr4ilbuf,adr4inlbuf
701  LOGICAL looking
702  COMMON /lookingfbuf/looking
703 c
704  IF (adr4ilbuf.eq.-1) THEN
705  adr4ilbuf=adr4ibuf
706  IF (.not.looking) THEN
707  CALL resetadlookstack()
708  looking = .true.
709  ENDIF
710  ENDIF
711  IF (adr4ilbuf.le.1) THEN
712  CALL lookreal4array(adr4lbuf, 512)
713  adr4inlbuf = .true.
714  adr4ilbuf = 512
715  x = adr4lbuf(512)
716  ELSE
717  adr4ilbuf = adr4ilbuf-1
718  if (adr4inlbuf) THEN
719  x = adr4lbuf(adr4ilbuf)
720  ELSE
721  x = adr4buf(adr4ilbuf)
722  ENDIF
723  ENDIF
724  END
725 
726  SUBROUTINE popreal4(x)
727  REAL*4 x, adr4buf(512), adr4lbuf(512)
728  INTEGER adr4ibuf,adr4ilbuf
729  LOGICAL adr4inlbuf
730  COMMON /adr4fbuf/adr4buf,adr4lbuf,
731  + adr4ibuf,adr4ilbuf,adr4inlbuf
732  LOGICAL looking
733  COMMON /lookingfbuf/looking
734 c
735  IF (adr4ilbuf.ne.-1) THEN
736  adr4ilbuf = -1
737  adr4inlbuf = .false.
738  looking = .false.
739  ENDIF
740  IF (adr4ibuf.le.1) THEN
741  CALL popreal4array(adr4buf, 512)
742  adr4ibuf = 512
743  x = adr4buf(512)
744  ELSE
745  adr4ibuf = adr4ibuf-1
746  x = adr4buf(adr4ibuf)
747  ENDIF
748  END
749 
750 c======================= REAL*8 =========================
751  BLOCK DATA reals8
752  REAL*8 adr8buf(512), adr8lbuf(512)
753  INTEGER adr8ibuf,adr8ilbuf
754  LOGICAL adr8inlbuf
755  COMMON /adr8fbuf/adr8buf,adr8lbuf,
756  + adr8ibuf,adr8ilbuf,adr8inlbuf
757  DATA adr8ibuf/1/
758  DATA adr8ilbuf/-1/
759  DATA adr8inlbuf/.false./
760  END
761 
762  SUBROUTINE pushreal8(x)
763  REAL*8 x, adr8buf(512), adr8lbuf(512)
764  INTEGER adr8ibuf,adr8ilbuf
765  LOGICAL adr8inlbuf
766  COMMON /adr8fbuf/adr8buf,adr8lbuf,
767  + adr8ibuf,adr8ilbuf,adr8inlbuf
768  LOGICAL looking
769  COMMON /lookingfbuf/looking
770 c
771  CALL addftraffic(8)
772  IF (adr8ilbuf.ne.-1) THEN
773  adr8ilbuf = -1
774  adr8inlbuf = .false.
775  looking = .false.
776  ENDIF
777  IF (adr8ibuf.ge.512) THEN
778  adr8buf(512) = x
779  CALL pushreal8array(adr8buf, 512)
780  CALL addftraffic(-4096)
781  adr8ibuf = 1
782  ELSE
783  adr8buf(adr8ibuf) = x
784  adr8ibuf = adr8ibuf+1
785  ENDIF
786  END
787 
788  SUBROUTINE lookreal8(x)
789  REAL*8 x, adr8buf(512), adr8lbuf(512)
790  INTEGER adr8ibuf,adr8ilbuf
791  LOGICAL adr8inlbuf
792  COMMON /adr8fbuf/adr8buf,adr8lbuf,
793  + adr8ibuf,adr8ilbuf,adr8inlbuf
794  LOGICAL looking
795  COMMON /lookingfbuf/looking
796 c
797  IF (adr8ilbuf.eq.-1) THEN
798  adr8ilbuf=adr8ibuf
799  IF (.not.looking) THEN
800  CALL resetadlookstack()
801  looking = .true.
802  ENDIF
803  ENDIF
804  IF (adr8ilbuf.le.1) THEN
805  CALL lookreal8array(adr8lbuf, 512)
806  adr8inlbuf = .true.
807  adr8ilbuf = 512
808  x = adr8lbuf(512)
809  ELSE
810  adr8ilbuf = adr8ilbuf-1
811  if (adr8inlbuf) THEN
812  x = adr8lbuf(adr8ilbuf)
813  ELSE
814  x = adr8buf(adr8ilbuf)
815  ENDIF
816  ENDIF
817  END
818 
819  SUBROUTINE popreal8(x)
820  REAL*8 x, adr8buf(512), adr8lbuf(512)
821  INTEGER adr8ibuf,adr8ilbuf
822  LOGICAL adr8inlbuf
823  COMMON /adr8fbuf/adr8buf,adr8lbuf,
824  + adr8ibuf,adr8ilbuf,adr8inlbuf
825  LOGICAL looking
826  COMMON /lookingfbuf/looking
827 c
828  IF (adr8ilbuf.ne.-1) THEN
829  adr8ilbuf = -1
830  adr8inlbuf = .false.
831  looking = .false.
832  ENDIF
833  IF (adr8ibuf.le.1) THEN
834  CALL popreal8array(adr8buf, 512)
835  adr8ibuf = 512
836  x = adr8buf(512)
837  ELSE
838  adr8ibuf = adr8ibuf-1
839  x = adr8buf(adr8ibuf)
840  ENDIF
841  END
842 
843 c======================= COMPLEX*8 =========================
844  BLOCK DATA complexs8
845  COMPLEX*8 adc8buf(512), adc8lbuf(512)
846  INTEGER adc8ibuf,adc8ilbuf
847  LOGICAL adc8inlbuf
848  COMMON /adc8fbuf/adc8buf,adc8lbuf,
849  + adc8ibuf,adc8ilbuf,adc8inlbuf
850  DATA adc8ibuf/1/
851  DATA adc8ilbuf/-1/
852  DATA adc8inlbuf/.false./
853  END
854 
855  SUBROUTINE pushcomplex8(x)
856  COMPLEX*8 x, adc8buf(512), adc8lbuf(512)
857  INTEGER adc8ibuf,adc8ilbuf
858  LOGICAL adc8inlbuf
859  COMMON /adc8fbuf/adc8buf,adc8lbuf,
860  + adc8ibuf,adc8ilbuf,adc8inlbuf
861  LOGICAL looking
862  COMMON /lookingfbuf/looking
863 c
864  CALL addftraffic(8)
865  IF (adc8ilbuf.ne.-1) THEN
866  adc8ilbuf = -1
867  adc8inlbuf = .false.
868  looking = .false.
869  ENDIF
870  IF (adc8ibuf.ge.512) THEN
871  adc8buf(512) = x
872  CALL pushcomplex8array(adc8buf, 512)
873  CALL addftraffic(-4096)
874  adc8ibuf = 1
875  ELSE
876  adc8buf(adc8ibuf) = x
877  adc8ibuf = adc8ibuf+1
878  ENDIF
879  END
880 
881  SUBROUTINE lookcomplex8(x)
882  COMPLEX*8 x, adc8buf(512), adc8lbuf(512)
883  INTEGER adc8ibuf,adc8ilbuf
884  LOGICAL adc8inlbuf
885  COMMON /adc8fbuf/adc8buf,adc8lbuf,
886  + adc8ibuf,adc8ilbuf,adc8inlbuf
887  LOGICAL looking
888  COMMON /lookingfbuf/looking
889 c
890  IF (adc8ilbuf.eq.-1) THEN
891  adc8ilbuf=adc8ibuf
892  IF (.not.looking) THEN
893  CALL resetadlookstack()
894  looking = .true.
895  ENDIF
896  ENDIF
897  IF (adc8ilbuf.le.1) THEN
898  CALL lookcomplex8array(adc8lbuf, 512)
899  adc8inlbuf = .true.
900  adc8ilbuf = 512
901  x = adc8lbuf(512)
902  ELSE
903  adc8ilbuf = adc8ilbuf-1
904  if (adc8inlbuf) THEN
905  x = adc8lbuf(adc8ilbuf)
906  ELSE
907  x = adc8buf(adc8ilbuf)
908  ENDIF
909  ENDIF
910  END
911 
912  SUBROUTINE popcomplex8(x)
913  COMPLEX*8 x, adc8buf(512), adc8lbuf(512)
914  INTEGER adc8ibuf,adc8ilbuf
915  LOGICAL adc8inlbuf
916  COMMON /adc8fbuf/adc8buf,adc8lbuf,
917  + adc8ibuf,adc8ilbuf,adc8inlbuf
918  LOGICAL looking
919  COMMON /lookingfbuf/looking
920 c
921  IF (adc8ilbuf.ne.-1) THEN
922  adc8ilbuf = -1
923  adc8inlbuf = .false.
924  looking = .false.
925  ENDIF
926  IF (adc8ibuf.le.1) THEN
927  CALL popcomplex8array(adc8buf, 512)
928  adc8ibuf = 512
929  x = adc8buf(512)
930  ELSE
931  adc8ibuf = adc8ibuf-1
932  x = adc8buf(adc8ibuf)
933  ENDIF
934  END
935 
936 c======================= COMPLEX*16 =========================
937  BLOCK DATA complexs16
938  COMPLEX*16 adc16buf(512), adc16lbuf(512)
939  INTEGER adc16ibuf,adc16ilbuf
940  LOGICAL adc16inlbuf
941  COMMON /adc16fbuf/adc16buf,adc16lbuf,
942  + adc16ibuf,adc16ilbuf,adc16inlbuf
943  DATA adc16ibuf/1/
944  DATA adc16ilbuf/-1/
945  DATA adc16inlbuf/.false./
946  END
947 
948  SUBROUTINE pushcomplex16(x)
949  COMPLEX*16 x, adc16buf(512), adc16lbuf(512)
950  INTEGER adc16ibuf,adc16ilbuf
951  LOGICAL adc16inlbuf
952  COMMON /adc16fbuf/adc16buf,adc16lbuf,
953  + adc16ibuf,adc16ilbuf,adc16inlbuf
954  LOGICAL looking
955  COMMON /lookingfbuf/looking
956 c
957  CALL addftraffic(16)
958  IF (adc16ilbuf.ne.-1) THEN
959  adc16ilbuf = -1
960  adc16inlbuf = .false.
961  looking = .false.
962  ENDIF
963  IF (adc16ibuf.ge.512) THEN
964  adc16buf(512) = x
965  CALL pushcomplex16array(adc16buf, 512)
966  CALL addftraffic(-8192)
967  adc16ibuf = 1
968  ELSE
969  adc16buf(adc16ibuf) = x
970  adc16ibuf = adc16ibuf+1
971  ENDIF
972  END
973 
974  SUBROUTINE lookcomplex16(x)
975  COMPLEX*16 x, adc16buf(512), adc16lbuf(512)
976  INTEGER adc16ibuf,adc16ilbuf
977  LOGICAL adc16inlbuf
978  COMMON /adc16fbuf/adc16buf,adc16lbuf,
979  + adc16ibuf,adc16ilbuf,adc16inlbuf
980  LOGICAL looking
981  COMMON /lookingfbuf/looking
982 c
983  IF (adc16ilbuf.eq.-1) THEN
984  adc16ilbuf=adc16ibuf
985  IF (.not.looking) THEN
986  CALL resetadlookstack()
987  looking = .true.
988  ENDIF
989  ENDIF
990  IF (adc16ilbuf.le.1) THEN
991  CALL lookcomplex16array(adc16lbuf, 512)
992  adc16inlbuf = .true.
993  adc16ilbuf = 512
994  x = adc16lbuf(512)
995  ELSE
996  adc16ilbuf = adc16ilbuf-1
997  if (adc16inlbuf) THEN
998  x = adc16lbuf(adc16ilbuf)
999  ELSE
1000  x = adc16buf(adc16ilbuf)
1001  ENDIF
1002  ENDIF
1003  END
1004 
1005  SUBROUTINE popcomplex16(x)
1006  COMPLEX*16 x, adc16buf(512), adc16lbuf(512)
1007  INTEGER adc16ibuf,adc16ilbuf
1008  LOGICAL adc16inlbuf
1009  COMMON /adc16fbuf/adc16buf,adc16lbuf,
1010  + adc16ibuf,adc16ilbuf,adc16inlbuf
1011  LOGICAL looking
1012  COMMON /lookingfbuf/looking
1013 c
1014  IF (adc16ilbuf.ne.-1) THEN
1015  adc16ilbuf = -1
1016  adc16inlbuf = .false.
1017  looking = .false.
1018  ENDIF
1019  IF (adc16ibuf.le.1) THEN
1020  CALL popcomplex16array(adc16buf, 512)
1021  adc16ibuf = 512
1022  x = adc16buf(512)
1023  ELSE
1024  adc16ibuf = adc16ibuf-1
1025  x = adc16buf(adc16ibuf)
1026  ENDIF
1027  END
1028 
1029 C=========== MEASUREMENT OF PUSH/POP TRAFFIC ==========
1030 
1031  BLOCK DATA memtraffic
1032  INTEGER*8 mmftraffic,mmftrafficM
1033  COMMON /mmcomtraffic/mmftraffic,mmftrafficm
1034  DATA mmftraffic/0/
1035  DATA mmftrafficm/0/
1036  END
1037 
1038  subroutine addftraffic(n)
1039  INTEGER n
1040  INTEGER*8 mmftraffic,mmftrafficM
1041  COMMON /mmcomtraffic/mmftraffic,mmftrafficm
1042 c
1043  mmftraffic = mmftraffic+n
1044  if (mmftraffic.ge.1000000) then
1045  100 mmftraffic = mmftraffic-1000000
1046  mmftrafficm = mmftrafficm+1
1047  if (mmftraffic.ge.1000000) then
1048  goto 100
1049  else
1050  goto 300
1051  endif
1052  else if (mmftraffic.lt.0) then
1053  200 mmftraffic = mmftraffic+1000000
1054  mmftrafficm = mmftrafficm-1
1055  if (mmftraffic.lt.0) then
1056  goto 200
1057  else
1058  goto 300
1059  endif
1060  endif
1061  300 continue
1062  END
1063 
1064  SUBROUTINE printtraffic()
1065  INTEGER*8 mmftraffic,mmftrafficM
1066  COMMON /mmcomtraffic/mmftraffic,mmftrafficm
1067  CALL printctraffic()
1068  CALL printftrafficinc(mmftrafficm, 1000000, mmftraffic)
1069  CALL printtotaltraffic(mmftrafficm, 1000000, mmftraffic)
1070 c write (6,1001) ' F Traffic: ',mmftrafficM,' Mb and ',
1071 c + (((mmftraffic*1000)/1024)*1000)/1024, ' millionths'
1072 c 1001 format(a,i6,a,i6,a)
1073  END
1074 
1075 C ============ PRINTING THE SIZE OF STACKS AND BUFFERS ==========
1076 
1077  SUBROUTINE printbuffertop()
1078  integer*4 SMALLSTACKSIZE
1079  integer*4 size
1080 
1081  size = smallstacksize()
1082  print *,'Buffer size:',size,' bytes i.e. ',size/1024.0,' Kbytes'
1083  END
1084 
1085  FUNCTION smallstacksize()
1086  CHARACTER ads1buf(512), ads1lbuf(512)
1087  INTEGER ads1ibuf,ads1ilbuf
1088  LOGICAL ads1inlbuf
1089  COMMON /ads1fbuf/ads1buf,ads1lbuf,
1090  + ads1ibuf,ads1ilbuf,ads1inlbuf
1091 c LOGICAL adl4buf(512), adl4lbuf(512)
1092 c INTEGER adl4ibuf,adl4ilbuf
1093 c LOGICAL adl4inlbuf
1094 c COMMON /adl4fbuf/adl4buf,adl4lbuf,
1095 c + adl4ibuf,adl4ilbuf,adl4inlbuf
1096  INTEGER*4 adi4buf(512), adi4lbuf(512)
1097  INTEGER adi4ibuf,adi4ilbuf
1098  LOGICAL adi4inlbuf
1099  COMMON /adi4fbuf/adi4buf,adi4lbuf,
1100  + adi4ibuf,adi4ilbuf,adi4inlbuf
1101  INTEGER*8 adi8buf(512), adi8lbuf(512)
1102  INTEGER adi8ibuf,adi8ilbuf
1103  LOGICAL adi8inlbuf
1104  COMMON /adi8fbuf/adi8buf,adi8lbuf,
1105  + adi8ibuf,adi8ilbuf,adi8inlbuf
1106 c INTEGER*16 adi16buf(512), adi16lbuf(512)
1107 c INTEGER adi16ibuf,adi16ilbuf
1108 c LOGICAL adi16inlbuf
1109 c COMMON /adi16fbuf/adi16buf,adi16lbuf,
1110 c + adi16ibuf,adi16ilbuf,adi16inlbuf
1111  REAL*4 adr4buf(512), adr4lbuf(512)
1112  INTEGER adr4ibuf,adr4ilbuf
1113  LOGICAL adr4inlbuf
1114  COMMON /adr4fbuf/adr4buf,adr4lbuf,
1115  + adr4ibuf,adr4ilbuf,adr4inlbuf
1116  REAL*8 adr8buf(512), adr8lbuf(512)
1117  INTEGER adr8ibuf,adr8ilbuf
1118  LOGICAL adr8inlbuf
1119  COMMON /adr8fbuf/adr8buf,adr8lbuf,
1120  + adr8ibuf,adr8ilbuf,adr8inlbuf
1121 c REAL*16 adr16buf(512), adr16lbuf(512)
1122 c INTEGER adr16ibuf,adr16ilbuf
1123 c LOGICAL adr16inlbuf
1124 c COMMON /adr16fbuf/adr16buf,adr16lbuf,
1125 c + adr16ibuf,adr16ilbuf,adr16inlbuf
1126 c REAL*32 x, adr32buf(512), adr32lbuf(512)
1127 c INTEGER adr32ibuf,adr32ilbuf
1128 c LOGICAL adr32inlbuf
1129 c COMMON /adr32fbuf/adr32buf,adr32lbuf,
1130 c + adr32ibuf,adr32ilbuf,adr32inlbuf
1131 c COMPLEX*4 adc4buf(512), adc4lbuf(512)
1132 c INTEGER adc4ibuf,adc4ilbuf
1133 c LOGICAL adc4inlbuf
1134 c COMMON /adc4fbuf/adc4buf,adc4lbuf,
1135 c + adc4ibuf,adc4ilbuf,adc4inlbuf
1136  COMPLEX*8 adc8buf(512), adc8lbuf(512)
1137  INTEGER adc8ibuf,adc8ilbuf
1138  LOGICAL adc8inlbuf
1139  COMMON /adc8fbuf/adc8buf,adc8lbuf,
1140  + adc8ibuf,adc8ilbuf,adc8inlbuf
1141  COMPLEX*16 adc16buf(512), adc16lbuf(512)
1142  INTEGER adc16ibuf,adc16ilbuf
1143  LOGICAL adc16inlbuf
1144  COMMON /adc16fbuf/adc16buf,adc16lbuf,
1145  + adc16ibuf,adc16ilbuf,adc16inlbuf
1146 c COMPLEX*32 adc32buf(512), adc32lbuf(512)
1147 c INTEGER adc32ibuf,adc32ilbuf
1148 c LOGICAL adc32inlbuf
1149 c COMMON /adc32fbuf/adc32buf,adc32lbuf,
1150 c + adc32ibuf,adc32ilbuf,adc32inlbuf
1151  integer*4 smallstacksize
1152 c
1153  smallstacksize = 0
1154  smallstacksize = smallstacksize + (ads1ibuf-1)*1
1155 c smallstacksize = smallstacksize + (adl4ibuf-1)*4
1156  smallstacksize = smallstacksize + (adi4ibuf-1)*4
1157  smallstacksize = smallstacksize + (adi8ibuf-1)*8
1158 c smallstacksize = smallstacksize + (adi16ibuf-1)*16
1159  smallstacksize = smallstacksize + (adr4ibuf-1)*4
1160  smallstacksize = smallstacksize + (adr8ibuf-1)*8
1161 c smallstacksize = smallstacksize + (adr16ibuf-1)*16
1162 c smallstacksize = smallstacksize + (adr32ibuf-1)*32
1163 c smallstacksize = smallstacksize + (adc4ibuf-1)*4
1164  smallstacksize = smallstacksize + (adc8ibuf-1)*8
1165  smallstacksize = smallstacksize + (adc16ibuf-1)*16
1166 c smallstacksize = smallstacksize + (adc32ibuf-1)*32
1167 c
1168  end
1169 
1170 c Very complete display of the current size of the
1171 c push/look/pop local Fortran stacks and global C stack.
1172  SUBROUTINE printallbuffers()
1173  CHARACTER ads1buf(512), ads1lbuf(512)
1174  INTEGER ads1ibuf,ads1ilbuf
1175  LOGICAL ads1inlbuf
1176  COMMON /ads1fbuf/ads1buf,ads1lbuf,
1177  + ads1ibuf,ads1ilbuf,ads1inlbuf
1178 c LOGICAL adl4buf(512), adl4lbuf(512)
1179 c INTEGER adl4ibuf,adl4ilbuf
1180 c LOGICAL adl4inlbuf
1181 c COMMON /adl4fbuf/adl4buf,adl4lbuf,
1182 c + adl4ibuf,adl4ilbuf,adl4inlbuf
1183  INTEGER*4 adi4buf(512), adi4lbuf(512)
1184  INTEGER adi4ibuf,adi4ilbuf
1185  LOGICAL adi4inlbuf
1186  COMMON /adi4fbuf/adi4buf,adi4lbuf,
1187  + adi4ibuf,adi4ilbuf,adi4inlbuf
1188  INTEGER*8 adi8buf(512), adi8lbuf(512)
1189  INTEGER adi8ibuf,adi8ilbuf
1190  LOGICAL adi8inlbuf
1191  COMMON /adi8fbuf/adi8buf,adi8lbuf,
1192  + adi8ibuf,adi8ilbuf,adi8inlbuf
1193 c INTEGER*16 adi16buf(512), adi16lbuf(512)
1194 c INTEGER adi16ibuf,adi16ilbuf
1195 c LOGICAL adi16inlbuf
1196 c COMMON /adi16fbuf/adi16buf,adi16lbuf,
1197 c + adi16ibuf,adi16ilbuf,adi16inlbuf
1198  REAL*4 adr4buf(512), adr4lbuf(512)
1199  INTEGER adr4ibuf,adr4ilbuf
1200  LOGICAL adr4inlbuf
1201  COMMON /adr4fbuf/adr4buf,adr4lbuf,
1202  + adr4ibuf,adr4ilbuf,adr4inlbuf
1203  REAL*8 adr8buf(512), adr8lbuf(512)
1204  INTEGER adr8ibuf,adr8ilbuf
1205  LOGICAL adr8inlbuf
1206  COMMON /adr8fbuf/adr8buf,adr8lbuf,
1207  + adr8ibuf,adr8ilbuf,adr8inlbuf
1208 c REAL*16 adr16buf(512), adr16lbuf(512)
1209 c INTEGER adr16ibuf,adr16ilbuf
1210 c LOGICAL adr16inlbuf
1211 c COMMON /adr16fbuf/adr16buf,adr16lbuf,
1212 c + adr16ibuf,adr16ilbuf,adr16inlbuf
1213 c REAL*32 x, adr32buf(512), adr32lbuf(512)
1214 c INTEGER adr32ibuf,adr32ilbuf
1215 c LOGICAL adr32inlbuf
1216 c COMMON /adr32fbuf/adr32buf,adr32lbuf,
1217 c + adr32ibuf,adr32ilbuf,adr32inlbuf
1218 c COMPLEX*4 adc4buf(512), adc4lbuf(512)
1219 c INTEGER adc4ibuf,adc4ilbuf
1220 c LOGICAL adc4inlbuf
1221 c COMMON /adc4fbuf/adc4buf,adc4lbuf,
1222 c + adc4ibuf,adc4ilbuf,adc4inlbuf
1223  COMPLEX*8 adc8buf(512), adc8lbuf(512)
1224  INTEGER adc8ibuf,adc8ilbuf
1225  LOGICAL adc8inlbuf
1226  COMMON /adc8fbuf/adc8buf,adc8lbuf,
1227  + adc8ibuf,adc8ilbuf,adc8inlbuf
1228  COMPLEX*16 adc16buf(512), adc16lbuf(512)
1229  INTEGER adc16ibuf,adc16ilbuf
1230  LOGICAL adc16inlbuf
1231  COMMON /adc16fbuf/adc16buf,adc16lbuf,
1232  + adc16ibuf,adc16ilbuf,adc16inlbuf
1233 c COMPLEX*32 adc32buf(512), adc32lbuf(512)
1234 c INTEGER adc32ibuf,adc32ilbuf
1235 c LOGICAL adc32inlbuf
1236 c COMMON /adc32fbuf/adc32buf,adc32lbuf,
1237 c + adc32ibuf,adc32ilbuf,adc32inlbuf
1238  integer*4 bsize,lookbsize
1239  integer*4 cblocks, csize, lookcblocks, lookcsize
1240 c
1241  call getbigcsizes(cblocks,csize,lookcblocks,lookcsize)
1242  write (6,'(a,i8,a,i5,a,i8,a,i5,a)')
1243  + 'MAIN C stack size :',cblocks,'B +',csize,
1244  + ' bytes (looking:',lookcblocks,'B +',lookcsize,')'
1245  bsize = (ads1ibuf-1)*1
1246  lookbsize = -999
1247  if (ads1inlbuf.or.ads1ilbuf.gt.-1) lookbsize=(ads1ilbuf-1)*1
1248  write (6,'(a,i4,a,i4,a)') ' plus CHARs :',bsize,
1249  + ' bytes (looking:',lookbsize,')'
1250 c bsize = (adl4ibuf-1)*4
1251  bsize = (adi4ibuf-1)*4
1252  lookbsize = -999
1253  if (adi4inlbuf.or.adi4ilbuf.gt.-1) lookbsize=(adi4ilbuf-1)*4
1254  write (6,'(a,i4,a,i4,a)') ' plus INTs4 :',bsize,
1255  + ' bytes (looking:',lookbsize,')'
1256  bsize = (adi8ibuf-1)*8
1257  lookbsize = -999
1258  if (adi8inlbuf.or.adi8ilbuf.gt.-1) lookbsize=(adi8ilbuf-1)*8
1259  write (6,'(a,i4,a,i4,a)') ' plus INTs8 :',bsize,
1260  + ' bytes (looking:',lookbsize,')'
1261 c bsize = (adi16ibuf-1)*16
1262  bsize = (adr4ibuf-1)*4
1263  lookbsize = -999
1264  if (adr4inlbuf.or.adr4ilbuf.gt.-1) lookbsize=(adr4ilbuf-1)*4
1265  write (6,'(a,i4,a,i4,a)') ' plus REALs4 :',bsize,
1266  + ' bytes (looking:',lookbsize,')'
1267  bsize = (adr8ibuf-1)*8
1268  lookbsize = -999
1269  if (adr8inlbuf.or.adr8ilbuf.gt.-1) lookbsize=(adr8ilbuf-1)*8
1270  write (6,'(a,i4,a,i4,a)') ' plus REALs8 :',bsize,
1271  + ' bytes (looking:',lookbsize,')'
1272 c bsize = (adr16ibuf-1)*16
1273 c lookbsize = -999
1274 c if (adr16inlbuf.or.adr16ilbuf.gt.-1) lookbsize=(adr16ilbuf-1)*16
1275 c write (6,'(a,i4,a,i4,a)') ' plus REALs16 :',bsize,
1276 c + ' bytes (looking:',lookbsize,')'
1277 c bsize = (adr32ibuf-1)*32
1278 c bsize = (adc4ibuf-1)*4
1279  bsize = (adc8ibuf-1)*8
1280  lookbsize = -999
1281  if (adc8inlbuf.or.adc8ilbuf.gt.-1) lookbsize=(adc8ilbuf-1)*8
1282  write (6,'(a,i4,a,i4,a)') ' plus CPLXs8 :',bsize,
1283  + ' bytes (looking:',lookbsize,')'
1284  bsize = (adc16ibuf-1)*16
1285  lookbsize = -999
1286  if (adc16inlbuf.or.adc16ilbuf.gt.-1) lookbsize=(adc16ilbuf-1)*16
1287  write (6,'(a,i4,a,i4,a)') ' plus CPLXs16 :',bsize,
1288  + ' bytes (looking:',lookbsize,')'
1289 c bsize = (adc32ibuf-1)*32
1290 c
1291  end
1292 
1293 C FOR INTERNAL DEBUGS ONLY:
1294  SUBROUTINE showallstacks()
1295  INTEGER*4 adbitbuf, adbitlbuf
1296  INTEGER adbitibuf, adbitilbuf
1297  LOGICAL adbitinlbuf
1298  COMMON /adbitfbuf/adbitbuf,adbitlbuf,
1299  + adbitibuf,adbitilbuf,adbitinlbuf
1300  CHARACTER ads1buf(512), ads1lbuf(512)
1301  INTEGER ads1ibuf,ads1ilbuf
1302  LOGICAL ads1inlbuf
1303  COMMON /ads1fbuf/ads1buf,ads1lbuf,
1304  + ads1ibuf,ads1ilbuf,ads1inlbuf
1305  INTEGER*4 adi4buf(512), adi4lbuf(512)
1306  INTEGER adi4ibuf,adi4ilbuf
1307  LOGICAL adi4inlbuf
1308  COMMON /adi4fbuf/adi4buf,adi4lbuf,
1309  + adi4ibuf,adi4ilbuf,adi4inlbuf
1310  INTEGER*8 adi8buf(512), adi8lbuf(512)
1311  INTEGER adi8ibuf,adi8ilbuf
1312  LOGICAL adi8inlbuf
1313  COMMON /adi8fbuf/adi8buf,adi8lbuf,
1314  + adi8ibuf,adi8ilbuf,adi8inlbuf
1315  REAL*4 adr4buf(512), adr4lbuf(512)
1316  INTEGER adr4ibuf,adr4ilbuf
1317  LOGICAL adr4inlbuf
1318  COMMON /adr4fbuf/adr4buf,adr4lbuf,
1319  + adr4ibuf,adr4ilbuf,adr4inlbuf
1320  REAL*8 adr8buf(512), adr8lbuf(512)
1321  INTEGER adr8ibuf,adr8ilbuf
1322  LOGICAL adr8inlbuf
1323  COMMON /adr8fbuf/adr8buf,adr8lbuf,
1324  + adr8ibuf,adr8ilbuf,adr8inlbuf
1325 c REAL*16 adr16buf(512), adr16lbuf(512)
1326 c INTEGER adr16ibuf,adr16ilbuf
1327 c LOGICAL adr16inlbuf
1328 c COMMON /adr16fbuf/adr16buf,adr16lbuf,
1329 c + adr16ibuf,adr16ilbuf,adr16inlbuf
1330  COMPLEX*8 adc8buf(512), adc8lbuf(512)
1331  INTEGER adc8ibuf,adc8ilbuf
1332  LOGICAL adc8inlbuf
1333  COMMON /adc8fbuf/adc8buf,adc8lbuf,
1334  + adc8ibuf,adc8ilbuf,adc8inlbuf
1335  COMPLEX*16 adc16buf(512), adc16lbuf(512)
1336  INTEGER adc16ibuf,adc16ilbuf
1337  LOGICAL adc16inlbuf
1338  COMMON /adc16fbuf/adc16buf,adc16lbuf,
1339  + adc16ibuf,adc16ilbuf,adc16inlbuf
1340  INTEGER i
1341 c
1342  write (6,1010) 'BIT STACK : ',adbitbuf,'==',adbitbuf,
1343  + ' (',adbitibuf,')'
1344 1010 format(a,i20,a,z16,a,i2,a)
1345  write (6,1011) 'INTEGER*8 BUFFER[',adi8ibuf-1,']: ',
1346  + (adi8buf(i),i=1,adi8ibuf-1)
1347  write (6,1011) 'INTEGER*4 BUFFER[',adi4ibuf-1,']: ',
1348  + (adi4buf(i),i=1,adi4ibuf-1)
1349 1011 format(a,i3,a,512(i40))
1350 c write (6,1012) 'REAL*16 BUFFER:[',adr16ibuf-1,']: ',
1351 c + (adr16buf(i),i=1,adr16ibuf-1)
1352  write (6,1012) 'REAL*8 BUFFER:[',adr8ibuf-1, ']: ',
1353  + (adr8buf(i),i=1,adr8ibuf-1)
1354  write (6,1012) 'REAL*4 BUFFER:[',adr4ibuf-1, ']: ',
1355  + (adr4buf(i),i=1,adr4ibuf-1)
1356 1012 format(a,i3,a,512(e8.2))
1357  call showrecentcstack()
1358 c
1359  END
1360 
1361 C========================================================
1362 C PUSH* POP* SUBROUTINES FOR OTHER DATA TYPES
1363 C Uncomment if these types are available on your compiler
1364 C and they are needed by the reverse differentiated code
1365 C Don't forget to uncomment the corresponding lines in
1366 C subroutine PRINTBUFFERTOP, otherwise these types'
1367 C contribution to buffer occupation will not be seen.
1368 C (not very important anyway...)
1369 
1370 c======================= INTEGER*16 =========================
1371 c BLOCK DATA INTEGERS16
1372 c INTEGER*16 adi16buf(512), adi16lbuf(512)
1373 c INTEGER adi16ibuf,adi16ilbuf
1374 c LOGICAL adi16inlbuf
1375 c COMMON /adi16fbuf/adi16buf,adi16lbuf,
1376 c + adi16ibuf,adi16ilbuf,adi16inlbuf
1377 c DATA adi16ibuf/1/
1378 c DATA adi16ilbuf/-1/
1379 c DATA adi16inlbuf/.FALSE./
1380 c END
1381 c c
1382 c SUBROUTINE PUSHINTEGER16(x)
1383 c INTEGER*16 x, adi16buf(512), adi16lbuf(512)
1384 c INTEGER adi16ibuf,adi16ilbuf
1385 c LOGICAL adi16inlbuf
1386 c COMMON /adi16fbuf/adi16buf,adi16lbuf,
1387 c + adi16ibuf,adi16ilbuf,adi16inlbuf
1388 c LOGICAL looking
1389 c COMMON /lookingfbuf/looking
1390 c c
1391 c CALL addftraffic(16)
1392 c IF (adi16ilbuf.ne.-1) THEN
1393 c adi16ilbuf = -1
1394 c adi16inlbuf = .FALSE.
1395 c looking = .FALSE.
1396 c ENDIF
1397 c IF (adi16ibuf.ge.512) THEN
1398 c adi16buf(512) = x
1399 c CALL PUSHINTEGER16ARRAY(adi16buf, 512)
1400 c CALL addftraffic(-8192)
1401 c adi16ibuf = 1
1402 c ELSE
1403 c adi16buf(adi16ibuf) = x
1404 c adi16ibuf = adi16ibuf+1
1405 c ENDIF
1406 c END
1407 c
1408 c SUBROUTINE LOOKINTEGER16(x)
1409 c INTEGER*16 x, adi16buf(512), adi16lbuf(512)
1410 c INTEGER adi16ibuf,adi16ilbuf
1411 c LOGICAL adi16inlbuf
1412 c COMMON /adi16fbuf/adi16buf,adi16lbuf,
1413 c + adi16ibuf,adi16ilbuf,adi16inlbuf
1414 c LOGICAL looking
1415 c COMMON /lookingfbuf/looking
1416 c c
1417 c IF (adi16ilbuf.eq.-1) THEN
1418 c adi16ilbuf=adi16ibuf
1419 c IF (.not.looking) THEN
1420 c CALL RESETADLOOKSTACK()
1421 c looking = .TRUE.
1422 c ENDIF
1423 c ENDIF
1424 c IF (adi16ilbuf.le.1) THEN
1425 c CALL LOOKINTEGER16ARRAY(adi16lbuf, 512)
1426 c adi16inlbuf = .TRUE.
1427 c adi16ilbuf = 512
1428 c x = adi16lbuf(512)
1429 c ELSE
1430 c adi16ilbuf = adi16ilbuf-1
1431 c if (adi16inlbuf) THEN
1432 c x = adi16lbuf(adi16ilbuf)
1433 c ELSE
1434 c x = adi16buf(adi16ilbuf)
1435 c ENDIF
1436 c ENDIF
1437 c END
1438 c
1439 c SUBROUTINE POPINTEGER16(x)
1440 c INTEGER*16 x, adi16buf(512), adi16lbuf(512)
1441 c INTEGER adi16ibuf,adi16ilbuf
1442 c LOGICAL adi16inlbuf
1443 c COMMON /adi16fbuf/adi16buf,adi16lbuf,
1444 c + adi16ibuf,adi16ilbuf,adi16inlbuf
1445 c LOGICAL looking
1446 c COMMON /lookingfbuf/looking
1447 c c
1448 c IF (adi16ilbuf.ne.-1) THEN
1449 c adi16ilbuf = -1
1450 c adi16inlbuf = .FALSE.
1451 c looking = .FALSE.
1452 c ENDIF
1453 c IF (adi16ibuf.le.1) THEN
1454 c CALL POPINTEGER16ARRAY(adi16buf, 512)
1455 c adi16ibuf = 512
1456 c x = adi16buf(512)
1457 c ELSE
1458 c adi16ibuf = adi16ibuf-1
1459 c x = adi16buf(adi16ibuf)
1460 c ENDIF
1461 c END
1462 
1463 c======================= REAL*16 =========================
1464 c BLOCK DATA REALS16
1465 c REAL*16 adr16buf(512), adr16lbuf(512)
1466 c INTEGER adr16ibuf,adr16ilbuf
1467 c LOGICAL adr16inlbuf
1468 c COMMON /adr16fbuf/adr16buf,adr16lbuf,
1469 c + adr16ibuf,adr16ilbuf,adr16inlbuf
1470 c DATA adr16ibuf/1/
1471 c DATA adr16ilbuf/-1/
1472 c DATA adr16inlbuf/.FALSE./
1473 c END
1474 c
1475 c SUBROUTINE PUSHREAL16(x)
1476 c REAL*16 x, adr16buf(512), adr16lbuf(512)
1477 c INTEGER adr16ibuf,adr16ilbuf
1478 c LOGICAL adr16inlbuf
1479 c COMMON /adr16fbuf/adr16buf,adr16lbuf,
1480 c + adr16ibuf,adr16ilbuf,adr16inlbuf
1481 c LOGICAL looking
1482 c COMMON /lookingfbuf/looking
1483 c c
1484 c CALL addftraffic(16)
1485 c IF (adr16ilbuf.ne.-1) THEN
1486 c adr16ilbuf = -1
1487 c adr16inlbuf = .FALSE.
1488 c looking = .FALSE.
1489 c ENDIF
1490 c IF (adr16ibuf.ge.512) THEN
1491 c adr16buf(512) = x
1492 c CALL PUSHREAL16ARRAY(adr16buf, 512)
1493 c CALL addftraffic(-8192)
1494 c adr16ibuf = 1
1495 c ELSE
1496 c adr16buf(adr16ibuf) = x
1497 c adr16ibuf = adr16ibuf+1
1498 c ENDIF
1499 c END
1500 c
1501 c SUBROUTINE LOOKREAL16(x)
1502 c REAL*16 x, adr16buf(512), adr16lbuf(512)
1503 c INTEGER adr16ibuf,adr16ilbuf
1504 c LOGICAL adr16inlbuf
1505 c COMMON /adr16fbuf/adr16buf,adr16lbuf,
1506 c + adr16ibuf,adr16ilbuf,adr16inlbuf
1507 c LOGICAL looking
1508 c COMMON /lookingfbuf/looking
1509 c c
1510 c IF (adr16ilbuf.eq.-1) THEN
1511 c adr16ilbuf=adr16ibuf
1512 c IF (.not.looking) THEN
1513 c CALL RESETADLOOKSTACK()
1514 c looking = .TRUE.
1515 c ENDIF
1516 c ENDIF
1517 c IF (adr16ilbuf.le.1) THEN
1518 c CALL LOOKREAL16ARRAY(adr16lbuf, 512)
1519 c adr16inlbuf = .TRUE.
1520 c adr16ilbuf = 512
1521 c x = adr16lbuf(512)
1522 c ELSE
1523 c adr16ilbuf = adr16ilbuf-1
1524 c if (adr16inlbuf) THEN
1525 c x = adr16lbuf(adr16ilbuf)
1526 c ELSE
1527 c x = adr16buf(adr16ilbuf)
1528 c ENDIF
1529 c ENDIF
1530 c END
1531 c
1532 c SUBROUTINE POPREAL16(x)
1533 c REAL*16 x, adr16buf(512), adr16lbuf(512)
1534 c INTEGER adr16ibuf,adr16ilbuf
1535 c LOGICAL adr16inlbuf
1536 c COMMON /adr16fbuf/adr16buf,adr16lbuf,
1537 c + adr16ibuf,adr16ilbuf,adr16inlbuf
1538 c LOGICAL looking
1539 c COMMON /lookingfbuf/looking
1540 c c
1541 c IF (adr16ilbuf.ne.-1) THEN
1542 c adr16ilbuf = -1
1543 c adr16inlbuf = .FALSE.
1544 c looking = .FALSE.
1545 c ENDIF
1546 c IF (adr16ibuf.le.1) THEN
1547 c CALL POPREAL16ARRAY(adr16buf, 512)
1548 c adr16ibuf = 512
1549 c x = adr16buf(512)
1550 c ELSE
1551 c adr16ibuf = adr16ibuf-1
1552 c x = adr16buf(adr16ibuf)
1553 c ENDIF
1554 c END
1555 
1556 c======================= REAL*32 =========================
1557 c BLOCK DATA REALS32
1558 c REAL*32 adr32buf(512), adr32lbuf(512)
1559 c INTEGER adr32ibuf,adr32ilbuf
1560 c LOGICAL adr32inlbuf
1561 c COMMON /adr32fbuf/adr32buf,adr32lbuf,
1562 c + adr32ibuf,adr32ilbuf,adr32inlbuf
1563 c DATA adr32ibuf/1/
1564 c DATA adr32ilbuf/-1/
1565 c DATA adr32inlbuf/.FALSE./
1566 c END
1567 c c
1568 c SUBROUTINE PUSHREAL32(x)
1569 c REAL*32 x, adr32buf(512), adr32lbuf(512)
1570 c INTEGER adr32ibuf,adr32ilbuf
1571 c LOGICAL adr32inlbuf
1572 c COMMON /adr32fbuf/adr32buf,adr32lbuf,
1573 c + adr32ibuf,adr32ilbuf,adr32inlbuf
1574 c LOGICAL looking
1575 c COMMON /lookingfbuf/looking
1576 c c
1577 c CALL addftraffic(32)
1578 c IF (adr32ilbuf.ne.-1) THEN
1579 c adr32ilbuf = -1
1580 c adr32inlbuf = .FALSE.
1581 c looking = .FALSE.
1582 c ENDIF
1583 c IF (adr32ibuf.ge.512) THEN
1584 c adr32buf(512) = x
1585 c CALL PUSHREAL32ARRAY(adr32buf, 512)
1586 c CALL addftraffic(-16384)
1587 c adr32ibuf = 1
1588 c ELSE
1589 c adr32buf(adr32ibuf) = x
1590 c adr32ibuf = adr32ibuf+1
1591 c ENDIF
1592 c END
1593 c
1594 c SUBROUTINE LOOKREAL32(x)
1595 c REAL*32 x, adr32buf(512), adr32lbuf(512)
1596 c INTEGER adr32ibuf,adr32ilbuf
1597 c LOGICAL adr32inlbuf
1598 c COMMON /adr32fbuf/adr32buf,adr32lbuf,
1599 c + adr32ibuf,adr32ilbuf,adr32inlbuf
1600 c LOGICAL looking
1601 c COMMON /lookingfbuf/looking
1602 c c
1603 c IF (adr32ilbuf.eq.-1) THEN
1604 c adr32ilbuf=adr32ibuf
1605 c IF (.not.looking) THEN
1606 c CALL RESETADLOOKSTACK()
1607 c looking = .TRUE.
1608 c ENDIF
1609 c ENDIF
1610 c IF (adr32ilbuf.le.1) THEN
1611 c CALL LOOKREAL32ARRAY(adr32lbuf, 512)
1612 c adr32inlbuf = .TRUE.
1613 c adr32ilbuf = 512
1614 c x = adr32lbuf(512)
1615 c ELSE
1616 c adr32ilbuf = adr32ilbuf-1
1617 c if (adr32inlbuf) THEN
1618 c x = adr32lbuf(adr32ilbuf)
1619 c ELSE
1620 c x = adr32buf(adr32ilbuf)
1621 c ENDIF
1622 c ENDIF
1623 c END
1624 c
1625 c SUBROUTINE POPREAL32(x)
1626 c REAL*32 x, adr32buf(512), adr32lbuf(512)
1627 c INTEGER adr32ibuf,adr32ilbuf
1628 c LOGICAL adr32inlbuf
1629 c COMMON /adr32fbuf/adr32buf,adr32lbuf,
1630 c + adr32ibuf,adr32ilbuf,adr32inlbuf
1631 c LOGICAL looking
1632 c COMMON /lookingfbuf/looking
1633 c c
1634 c IF (adr32ilbuf.ne.-1) THEN
1635 c adr32ilbuf = -1
1636 c adr32inlbuf = .FALSE.
1637 c looking = .FALSE.
1638 c ENDIF
1639 c IF (adr32ibuf.le.1) THEN
1640 c CALL POPREAL32ARRAY(adr32buf, 512)
1641 c adr32ibuf = 512
1642 c x = adr32buf(512)
1643 c ELSE
1644 c adr32ibuf = adr32ibuf-1
1645 c x = adr32buf(adr32ibuf)
1646 c ENDIF
1647 c END
1648 
1649 c======================= COMPLEX*4 =========================
1650 c BLOCK DATA COMPLEXS4
1651 c COMPLEX*4 adc4buf(512), adc4lbuf(512)
1652 c INTEGER adc4ibuf,adc4ilbuf
1653 c LOGICAL adc4inlbuf
1654 c COMMON /adc4fbuf/adc4buf,adc4lbuf,
1655 c + adc4ibuf,adc4ilbuf,adc4inlbuf
1656 c DATA adc4ibuf/1/
1657 c DATA adc4ilbuf/-1/
1658 c DATA adc4inlbuf/.FALSE./
1659 c END
1660 c c
1661 c SUBROUTINE PUSHCOMPLEX4(x)
1662 c COMPLEX*4 x, adc4buf(512), adc4lbuf(512)
1663 c INTEGER adc4ibuf,adc4ilbuf
1664 c LOGICAL adc4inlbuf
1665 c COMMON /adc4fbuf/adc4buf,adc4lbuf,
1666 c + adc4ibuf,adc4ilbuf,adc4inlbuf
1667 c LOGICAL looking
1668 c COMMON /lookingfbuf/looking
1669 c c
1670 c CALL addftraffic(4)
1671 c IF (adc4ilbuf.ne.-1) THEN
1672 c adc4ilbuf = -1
1673 c adc4inlbuf = .FALSE.
1674 c looking = .FALSE.
1675 c ENDIF
1676 c IF (adc4ibuf.ge.512) THEN
1677 c adc4buf(512) = x
1678 c CALL PUSHCOMPLEX4ARRAY(adc4buf, 512)
1679 c CALL addftraffic(-2048)
1680 c adc4ibuf = 1
1681 c ELSE
1682 c adc4buf(adc4ibuf) = x
1683 c adc4ibuf = adc4ibuf+1
1684 c ENDIF
1685 c END
1686 c
1687 c SUBROUTINE LOOKCOMPLEX4(x)
1688 c COMPLEX*4 x, adc4buf(512), adc4lbuf(512)
1689 c INTEGER adc4ibuf,adc4ilbuf
1690 c LOGICAL adc4inlbuf
1691 c COMMON /adc4fbuf/adc4buf,adc4lbuf,
1692 c + adc4ibuf,adc4ilbuf,adc4inlbuf
1693 c LOGICAL looking
1694 c COMMON /lookingfbuf/looking
1695 c c
1696 c IF (adc4ilbuf.eq.-1) THEN
1697 c adc4ilbuf=adc4ibuf
1698 c IF (.not.looking) THEN
1699 c CALL RESETADLOOKSTACK()
1700 c looking = .TRUE.
1701 c ENDIF
1702 c ENDIF
1703 c IF (adc4ilbuf.le.1) THEN
1704 c CALL LOOKCOMPLEX4ARRAY(adc4lbuf, 512)
1705 c adc4inlbuf = .TRUE.
1706 c adc4ilbuf = 512
1707 c x = adc4lbuf(512)
1708 c ELSE
1709 c adc4ilbuf = adc4ilbuf-1
1710 c if (adc4inlbuf) THEN
1711 c x = adc4lbuf(adc4ilbuf)
1712 c ELSE
1713 c x = adc4buf(adc4ilbuf)
1714 c ENDIF
1715 c ENDIF
1716 c END
1717 c
1718 c SUBROUTINE POPCOMPLEX4(x)
1719 c COMPLEX*4 x, adc4buf(512), adc4lbuf(512)
1720 c INTEGER adc4ibuf,adc4ilbuf
1721 c LOGICAL adc4inlbuf
1722 c COMMON /adc4fbuf/adc4buf,adc4lbuf,
1723 c + adc4ibuf,adc4ilbuf,adc4inlbuf
1724 c LOGICAL looking
1725 c COMMON /lookingfbuf/looking
1726 c c
1727 c IF (adc4ilbuf.ne.-1) THEN
1728 c adc4ilbuf = -1
1729 c adc4inlbuf = .FALSE.
1730 c looking = .FALSE.
1731 c ENDIF
1732 c IF (adc4ibuf.le.1) THEN
1733 c CALL POPCOMPLEX4ARRAY(adc4buf, 512)
1734 c adc4ibuf = 512
1735 c x = adc4buf(512)
1736 c ELSE
1737 c adc4ibuf = adc4ibuf-1
1738 c x = adc4buf(adc4ibuf)
1739 c ENDIF
1740 c END
1741 
1742 c======================= COMPLEX*32 =========================
1743 c BLOCK DATA COMPLEXS32
1744 c COMPLEX*32 adc32buf(512), adc32lbuf(512)
1745 c INTEGER adc32ibuf,adc32ilbuf
1746 c LOGICAL adc32inlbuf
1747 c COMMON /adc32fbuf/adc32buf,adc32lbuf,
1748 c + adc32ibuf,adc32ilbuf,adc32inlbuf
1749 c DATA adc32ibuf/1/
1750 c DATA adc32ilbuf/-1/
1751 c DATA adc32inlbuf/.FALSE./
1752 c END
1753 c c
1754 c SUBROUTINE PUSHCOMPLEX32(x)
1755 c COMPLEX*32 x, adc32buf(512), adc32lbuf(512)
1756 c INTEGER adc32ibuf,adc32ilbuf
1757 c LOGICAL adc32inlbuf
1758 c COMMON /adc32fbuf/adc32buf,adc32lbuf,
1759 c + adc32ibuf,adc32ilbuf,adc32inlbuf
1760 c LOGICAL looking
1761 c COMMON /lookingfbuf/looking
1762 c c
1763 c CALL addftraffic(32)
1764 c IF (adc32ilbuf.ne.-1) THEN
1765 c adc32ilbuf = -1
1766 c adc32inlbuf = .FALSE.
1767 c looking = .FALSE.
1768 c ENDIF
1769 c IF (adc32ibuf.ge.512) THEN
1770 c adc32buf(512) = x
1771 c CALL PUSHCOMPLEX32ARRAY(adc32buf, 512)
1772 c CALL addftraffic(-16384)
1773 c adc32ibuf = 1
1774 c ELSE
1775 c adc32buf(adc32ibuf) = x
1776 c adc32ibuf = adc32ibuf+1
1777 c ENDIF
1778 c END
1779 c
1780 c SUBROUTINE LOOKCOMPLEX32(x)
1781 c COMPLEX*32 x, adc32buf(512), adc32lbuf(512)
1782 c INTEGER adc32ibuf,adc32ilbuf
1783 c LOGICAL adc32inlbuf
1784 c COMMON /adc32fbuf/adc32buf,adc32lbuf,
1785 c + adc32ibuf,adc32ilbuf,adc32inlbuf
1786 c LOGICAL looking
1787 c COMMON /lookingfbuf/looking
1788 c c
1789 c IF (adc32ilbuf.eq.-1) THEN
1790 c adc32ilbuf=adc32ibuf
1791 c IF (.not.looking) THEN
1792 c CALL RESETADLOOKSTACK()
1793 c looking = .TRUE.
1794 c ENDIF
1795 c ENDIF
1796 c IF (adc32ilbuf.le.1) THEN
1797 c CALL LOOKCOMPLEX32ARRAY(adc32lbuf, 512)
1798 c adc32inlbuf = .TRUE.
1799 c adc32ilbuf = 512
1800 c x = adc32lbuf(512)
1801 c ELSE
1802 c adc32ilbuf = adc32ilbuf-1
1803 c if (adc32inlbuf) THEN
1804 c x = adc32lbuf(adc32ilbuf)
1805 c ELSE
1806 c x = adc32buf(adc32ilbuf)
1807 c ENDIF
1808 c ENDIF
1809 c END
1810 c
1811 c SUBROUTINE POPCOMPLEX32(x)
1812 c COMPLEX*32 x, adc32buf(512), adc32lbuf(512)
1813 c INTEGER adc32ibuf,adc32ilbuf
1814 c LOGICAL adc32inlbuf
1815 c COMMON /adc32fbuf/adc32buf,adc32lbuf,
1816 c + adc32ibuf,adc32ilbuf,adc32inlbuf
1817 c LOGICAL looking
1818 c COMMON /lookingfbuf/looking
1819 c c
1820 c IF (adc32ilbuf.ne.-1) THEN
1821 c adc32ilbuf = -1
1822 c adc32inlbuf = .FALSE.
1823 c looking = .FALSE.
1824 c ENDIF
1825 c IF (adc32ibuf.le.1) THEN
1826 c CALL POPCOMPLEX32ARRAY(adc32buf, 512)
1827 c adc32ibuf = 512
1828 c x = adc32buf(512)
1829 c ELSE
1830 c adc32ibuf = adc32ibuf-1
1831 c x = adc32buf(adc32ibuf)
1832 c ENDIF
1833 c END
1834 
1835 C========================================================
1836 C HOW TO CREATE PUSH* POP* SUBROUTINES
1837 C YET FOR OTHER DATA TYPES
1838 C ** Duplicate the commented program lines below
1839 c ** In the duplicated subroutines, replace:
1840 c TTTT by the basic name of the type
1841 c z9 by the initial and size of the type
1842 c (integer:i real:r complex:c boolean:b character:s)
1843 c 9 by the size of the type
1844 c ** Uncomment the duplicated subroutines
1845 C ** Don't forget to insert the corresponding lines in
1846 C subroutine PRINTBUFFERTOP, otherwise these types'
1847 C contribution to buffer occupation will not be seen.
1848 C (not very important anyway...)
1849 
1850 c======================= TTTT*9 =========================
1851 c BLOCK DATA TTTTS9
1852 c TTTT*9 adz9buf(512), adz9lbuf(512)
1853 c INTEGER adz9ibuf,adz9ilbuf
1854 c LOGICAL adz9inlbuf
1855 c COMMON /adz9fbuf/adz9buf,adz9lbuf,
1856 c + adz9ibuf,adz9ilbuf,adz9inlbuf
1857 c DATA adz9ibuf/1/
1858 c DATA adz9ilbuf/-1/
1859 c DATA adz9inlbuf/.FALSE./
1860 c END
1861 c c
1862 c SUBROUTINE PUSHTTTT9(x)
1863 c TTTT*9 x, adz9buf(512), adz9lbuf(512)
1864 c INTEGER adz9ibuf,adz9ilbuf
1865 c LOGICAL adz9inlbuf
1866 c COMMON /adz9fbuf/adz9buf,adz9lbuf,
1867 c + adz9ibuf,adz9ilbuf,adz9inlbuf
1868 c LOGICAL looking
1869 c COMMON /lookingfbuf/looking
1870 c c
1871 c CALL addftraffic(9)
1872 c IF (adz9ilbuf.ne.-1) THEN
1873 c adz9ilbuf = -1
1874 c adz9inlbuf = .FALSE.
1875 c looking = .FALSE.
1876 c ENDIF
1877 c IF (adz9ibuf.ge.512) THEN
1878 c adz9buf(512) = x
1879 c CALL PUSHTTTT9ARRAY(adz9buf, 512)
1880 c CALL addftraffic(-9*512)
1881 c adz9ibuf = 1
1882 c ELSE
1883 c adz9buf(adz9ibuf) = x
1884 c adz9ibuf = adz9ibuf+1
1885 c ENDIF
1886 c END
1887 c
1888 c SUBROUTINE LOOKTTTT9(x)
1889 c TTTT*9 x, adz9buf(512), adz9lbuf(512)
1890 c INTEGER adz9ibuf,adz9ilbuf
1891 c LOGICAL adz9inlbuf
1892 c COMMON /adz9fbuf/adz9buf,adz9lbuf,
1893 c + adz9ibuf,adz9ilbuf,adz9inlbuf
1894 c LOGICAL looking
1895 c COMMON /lookingfbuf/looking
1896 c c
1897 c IF (adz9ilbuf.eq.-1) THEN
1898 c adz9ilbuf=adz9ibuf
1899 c IF (.not.looking) THEN
1900 c CALL RESETADLOOKSTACK()
1901 c looking = .TRUE.
1902 c ENDIF
1903 c ENDIF
1904 c IF (adz9ilbuf.le.1) THEN
1905 c CALL LOOKTTTT9ARRAY(adz9lbuf, 512)
1906 c adz9inlbuf = .TRUE.
1907 c adz9ilbuf = 512
1908 c x = adz9lbuf(512)
1909 c ELSE
1910 c adz9ilbuf = adz9ilbuf-1
1911 c if (adz9inlbuf) THEN
1912 c x = adz9lbuf(adz9ilbuf)
1913 c ELSE
1914 c x = adz9buf(adz9ilbuf)
1915 c ENDIF
1916 c ENDIF
1917 c END
1918 c
1919 c SUBROUTINE POPTTTT9(x)
1920 c TTTT*9 x, adz9buf(512), adz9lbuf(512)
1921 c INTEGER adz9ibuf,adz9ilbuf
1922 c LOGICAL adz9inlbuf
1923 c COMMON /adz9fbuf/adz9buf,adz9lbuf,
1924 c + adz9ibuf,adz9ilbuf,adz9inlbuf
1925 c LOGICAL looking
1926 c COMMON /lookingfbuf/looking
1927 c c
1928 c IF (adz9ilbuf.ne.-1) THEN
1929 c adz9ilbuf = -1
1930 c adz9inlbuf = .FALSE.
1931 c looking = .FALSE.
1932 c ENDIF
1933 c IF (adz9ibuf.le.1) THEN
1934 c CALL POPTTTT9ARRAY(adz9buf, 512)
1935 c adz9ibuf = 512
1936 c x = adz9buf(512)
1937 c ELSE
1938 c adz9ibuf = adz9ibuf-1
1939 c x = adz9buf(adz9ibuf)
1940 c ENDIF
1941 c END
pushcontrol5b
subroutine pushcontrol5b(cc)
Definition: adBuffer.f:233
popinteger4
subroutine popinteger4(x)
Definition: adBuffer.f:541
popbit
logical function popbit()
Definition: adBuffer.f:90
popcharacter
subroutine popcharacter(x)
Definition: adBuffer.f:448
popcontrol2b
subroutine popcontrol2b(cc)
Definition: adBuffer.f:146
lookcontrol4b
subroutine lookcontrol4b(cc)
Definition: adBuffer.f:220
popinteger4array
void popinteger4array(int *x, int n)
Definition: adStack.c:335
popreal8array
void popreal8array(double *x, int n)
Definition: adStack.c:375
lookcomplex16array
void lookcomplex16array(void *x, int n)
Definition: adStack.c:428
popcomplex16
subroutine popcomplex16(x)
Definition: adBuffer.f:1006
lookcontrol2b
subroutine lookcontrol2b(cc)
Definition: adBuffer.f:157
pushcomplex16
subroutine pushcomplex16(x)
Definition: adBuffer.f:949
lookinteger4
subroutine lookinteger4(x)
Definition: adBuffer.f:510
lookcharacterarray
void lookcharacterarray(char *x, int n)
Definition: adStack.c:318
pushcharacterarray
void pushcharacterarray(char *x, int n)
Definition: adStack.c:312
lookinteger4array
void lookinteger4array(int *x, int n)
Definition: adStack.c:338
pushcontrol1b
subroutine pushcontrol1b(cc)
Definition: adBuffer.f:115
lookcontrol9b
subroutine lookcontrol9b(cc)
Definition: adBuffer.f:344
pushinteger4array
void pushinteger4array(int *x, int n)
Definition: adStack.c:332
pushcontrol2b
subroutine pushcontrol2b(cc)
Definition: adBuffer.f:140
lookreal8array
void lookreal8array(double *x, int n)
Definition: adStack.c:378
showallstacks
subroutine showallstacks()
Definition: adBuffer.f:1295
lookcontrol5b
subroutine lookcontrol5b(cc)
Definition: adBuffer.f:256
lookcontrol3b
subroutine lookcontrol3b(cc)
Definition: adBuffer.f:187
smallstacksize
integer *4 function smallstacksize()
Definition: adBuffer.f:1086
lookboolean
subroutine lookboolean(x)
Definition: adBuffer.f:369
pushreal8array
void pushreal8array(double *x, int n)
Definition: adStack.c:372
lookcontrol1b
subroutine lookcontrol1b(cc)
Definition: adBuffer.f:130
printallbuffers
subroutine printallbuffers()
Definition: adBuffer.f:1173
popinteger8array
void popinteger8array(long int *x, int n)
Definition: adStack.c:345
popreal8
subroutine popreal8(x)
Definition: adBuffer.f:820
pushinteger8
subroutine pushinteger8(x)
Definition: adBuffer.f:577
pushreal4array
void pushreal4array(float *x, int n)
Definition: adStack.c:362
popcontrol6b
subroutine popcontrol6b(cc)
Definition: adBuffer.f:280
popcomplex16array
void popcomplex16array(void *x, int n)
Definition: adStack.c:425
lookbit
logical function lookbit()
Definition: adBuffer.f:64
lookcomplex8array
void lookcomplex8array(void *x, int n)
Definition: adStack.c:418
lookcomplex8
subroutine lookcomplex8(x)
Definition: adBuffer.f:882
popcontrol5b
subroutine popcontrol5b(cc)
Definition: adBuffer.f:242
lookcontrol6b
subroutine lookcontrol6b(cc)
Definition: adBuffer.f:295
pushreal4
subroutine pushreal4(x)
Definition: adBuffer.f:670
pushbit
subroutine pushbit(bit)
Definition: adBuffer.f:35
popcomplex8
subroutine popcomplex8(x)
Definition: adBuffer.f:913
printtraffic
subroutine printtraffic()
Definition: adBuffer.f:1065
popcontrol3b
subroutine popcontrol3b(cc)
Definition: adBuffer.f:175
pushboolean
subroutine pushboolean(x)
Definition: adBuffer.f:364
popboolean
subroutine popboolean(x)
Definition: adBuffer.f:374
pushreal8
subroutine pushreal8(x)
Definition: adBuffer.f:763
addftraffic
subroutine addftraffic(n)
Definition: adBuffer.f:1039
printbuffertop
subroutine printbuffertop()
Definition: adBuffer.f:1078
pushcomplex16array
void pushcomplex16array(void *x, int n)
Definition: adStack.c:422
popcontrol1b
subroutine popcontrol1b(cc)
Definition: adBuffer.f:120
lookcomplex16
subroutine lookcomplex16(x)
Definition: adBuffer.f:975
pushinteger8array
void pushinteger8array(long int *x, int n)
Definition: adStack.c:342
popcontrol4b
subroutine popcontrol4b(cc)
Definition: adBuffer.f:207
pushcomplex8array
void pushcomplex8array(void *x, int n)
Definition: adStack.c:412
lookinteger8array
void lookinteger8array(long int *x, int n)
Definition: adStack.c:348
popinteger8
subroutine popinteger8(x)
Definition: adBuffer.f:634
pushcontrol4b
subroutine pushcontrol4b(cc)
Definition: adBuffer.f:199
lookreal8
subroutine lookreal8(x)
Definition: adBuffer.f:789
lookinteger8
subroutine lookinteger8(x)
Definition: adBuffer.f:603
lookcharacter
subroutine lookcharacter(x)
Definition: adBuffer.f:417
lookreal4
subroutine lookreal4(x)
Definition: adBuffer.f:696
pushcontrol9b
subroutine pushcontrol9b(cc)
Definition: adBuffer.f:312
pushcontrol3b
subroutine pushcontrol3b(cc)
Definition: adBuffer.f:168
lookreal4array
void lookreal4array(float *x, int n)
Definition: adStack.c:368
popcontrol9b
subroutine popcontrol9b(cc)
Definition: adBuffer.f:326
popcharacterarray
void popcharacterarray(char *x, int n)
Definition: adStack.c:315
pushcharacter
subroutine pushcharacter(x)
Definition: adBuffer.f:391
pushcomplex8
subroutine pushcomplex8(x)
Definition: adBuffer.f:856
popcomplex8array
void popcomplex8array(void *x, int n)
Definition: adStack.c:415
popreal4array
void popreal4array(float *x, int n)
Definition: adStack.c:365
pushinteger4
subroutine pushinteger4(x)
Definition: adBuffer.f:484
pushcontrol6b
subroutine pushcontrol6b(cc)
Definition: adBuffer.f:270
popreal4
subroutine popreal4(x)
Definition: adBuffer.f:727