wrftladj/adBuffer.F

   1 C$Id: adBuffer.f 3723 2011-02-24 13:34:42Z llh $
   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 c======================== BITS ==========================:
  13       BLOCK DATA BITS
  14       INTEGER adbitbuf, adbitlbuf
  15       INTEGER adbitibuf, adbitilbuf
  16       LOGICAL adbitinlbuf
  17       COMMON /adbitfbuf/adbitbuf,adbitlbuf,
  18      +       adbitibuf,adbitilbuf,adbitinlbuf
  19       DATA adbitbuf/0/
  20       DATA adbitlbuf/0/
  21       DATA adbitibuf/0/
  22       DATA adbitilbuf/-1/
  23       DATA adbitinlbuf/.FALSE./
  24       END
  25
  26 c [0,31] are the bit indices we can use in an INTEGER
  27
  28       SUBROUTINE PUSHBIT(bit)
  29       LOGICAL bit
  30       INTEGER adbitbuf, adbitlbuf
  31       INTEGER adbitibuf, adbitilbuf
  32       LOGICAL adbitinlbuf
  33       COMMON /adbitfbuf/adbitbuf,adbitlbuf,
  34      +       adbitibuf,adbitilbuf,adbitinlbuf
  35 c
  36       IF (adbitilbuf.ne.-1) THEN
  37          adbitilbuf = -1
  38          adbitinlbuf = .FALSE.
  39       ENDIF
  40       IF (bit) THEN
  41          adbitbuf = IBSET(adbitbuf, adbitibuf)
  42       ELSE
  43          adbitbuf = IBCLR(adbitbuf, adbitibuf)
  44       ENDIF
  45       IF (adbitibuf.ge.31) THEN
  46          CALL PUSHINTEGER4(adbitbuf)
  47          adbitbuf = 0
  48          adbitibuf = 0
  49       ELSE
  50          adbitibuf = adbitibuf+1
  51       ENDIF
  52       END
  53
  54       LOGICAL FUNCTION LOOKBIT()
  55       INTEGER adbitbuf, adbitlbuf
  56       INTEGER adbitibuf, adbitilbuf
  57       LOGICAL adbitinlbuf
  58       COMMON /adbitfbuf/adbitbuf,adbitlbuf,
  59      +       adbitibuf,adbitilbuf,adbitinlbuf
  60 c
  61       IF (adbitilbuf.eq.-1) THEN
  62          adbitilbuf=adbitibuf
  63          adbitlbuf = adbitbuf
  64       ENDIF
  65       IF (adbitilbuf.le.0) THEN
  66          CALL LOOKINTEGER4(adbitlbuf)
  67          adbitilbuf = 31
  68       ELSE
  69          adbitilbuf = adbitilbuf-1
  70       ENDIF
  71       LOOKBIT = BTEST(adbitlbuf, adbitilbuf)
  72       END
  73
  74       LOGICAL FUNCTION POPBIT()
  75       INTEGER adbitbuf, adbitlbuf
  76       INTEGER adbitibuf, adbitilbuf
  77       LOGICAL adbitinlbuf
  78       COMMON /adbitfbuf/adbitbuf,adbitlbuf,
  79      +       adbitibuf,adbitilbuf,adbitinlbuf
  80 c
  81       IF (adbitilbuf.ne.-1) THEN
  82          adbitilbuf = -1
  83          adbitinlbuf = .FALSE.
  84       ENDIF
  85       IF (adbitibuf.le.0) THEN
  86          CALL POPINTEGER4(adbitbuf)
  87          adbitibuf = 31
  88       ELSE
  89          adbitibuf = adbitibuf-1
  90       ENDIF
  91       POPBIT = BTEST(adbitbuf, adbitibuf)
  92       END
  93
  94 c====================== CONTROL =========================:
  95
  96       SUBROUTINE PUSHCONTROL1B(cc)
  97       INTEGER cc
  98       CALL PUSHBIT(cc.ne.0)
  99       END
 100
 101       SUBROUTINE POPCONTROL1B(cc)
 102       INTEGER cc
 103       LOGICAL POPBIT
 104       IF (POPBIT()) THEN
 105          cc = 1
 106       ELSE
 107          cc = 0
 108       ENDIF
 109       END
 110
 111       SUBROUTINE LOOKCONTROL1B(cc)
 112       INTEGER cc
 113       LOGICAL LOOKBIT
 114       IF (LOOKBIT()) THEN
 115          cc = 1
 116       ELSE
 117          cc = 0
 118       ENDIF
 119       END
 120
 121       SUBROUTINE PUSHCONTROL2B(cc)
 122       INTEGER cc
 123       CALL PUSHBIT(BTEST(cc,0))
 124       CALL PUSHBIT(BTEST(cc,1))
 125       END
 126
 127       SUBROUTINE POPCONTROL2B(cc)
 128       INTEGER cc
 129       LOGICAL POPBIT
 130       IF (POPBIT()) THEN
 131          cc = 2
 132       ELSE
 133          cc = 0
 134       ENDIF
 135       IF (POPBIT()) cc = IBSET(cc,0)
 136       END
 137
 138       SUBROUTINE LOOKCONTROL2B(cc)
 139       INTEGER cc
 140       LOGICAL LOOKBIT
 141       IF (LOOKBIT()) THEN
 142          cc = 2
 143       ELSE
 144          cc = 0
 145       ENDIF
 146       IF (LOOKBIT()) cc = IBSET(cc,0)
 147       END
 148
 149       SUBROUTINE PUSHCONTROL3B(cc)
 150       INTEGER cc
 151       CALL PUSHBIT(BTEST(cc,0))
 152       CALL PUSHBIT(BTEST(cc,1))
 153       CALL PUSHBIT(BTEST(cc,2))
 154       END
 155
 156       SUBROUTINE POPCONTROL3B(cc)
 157       INTEGER cc
 158       LOGICAL POPBIT
 159       IF (POPBIT()) THEN
 160          cc = 4
 161       ELSE
 162          cc = 0
 163       ENDIF
 164       IF (POPBIT()) cc = IBSET(cc,1)
 165       IF (POPBIT()) cc = IBSET(cc,0)
 166       END
 167
 168       SUBROUTINE LOOKCONTROL3B(cc)
 169       INTEGER cc
 170       LOGICAL LOOKBIT
 171       IF (LOOKBIT()) THEN
 172          cc = 4
 173       ELSE
 174          cc = 0
 175       ENDIF
 176       IF (LOOKBIT()) cc = IBSET(cc,1)
 177       IF (LOOKBIT()) cc = IBSET(cc,0)
 178       END
 179
 180       SUBROUTINE PUSHCONTROL4B(cc)
 181       INTEGER cc
 182       CALL PUSHBIT(BTEST(cc,0))
 183       CALL PUSHBIT(BTEST(cc,1))
 184       CALL PUSHBIT(BTEST(cc,2))
 185       CALL PUSHBIT(BTEST(cc,3))
 186       END
 187
 188       SUBROUTINE POPCONTROL4B(cc)
 189       INTEGER cc
 190       LOGICAL POPBIT
 191       IF (POPBIT()) THEN
 192          cc = 8
 193       ELSE
 194          cc = 0
 195       ENDIF
 196       IF (POPBIT()) cc = IBSET(cc,2)
 197       IF (POPBIT()) cc = IBSET(cc,1)
 198       IF (POPBIT()) cc = IBSET(cc,0)
 199       END
 200
 201       SUBROUTINE LOOKCONTROL4B(cc)
 202       INTEGER cc
 203       LOGICAL LOOKBIT
 204       IF (LOOKBIT()) THEN
 205          cc = 8
 206       ELSE
 207          cc = 0
 208       ENDIF
 209       IF (LOOKBIT()) cc = IBSET(cc,2)
 210       IF (LOOKBIT()) cc = IBSET(cc,1)
 211       IF (LOOKBIT()) cc = IBSET(cc,0)
 212       END
 213
 214       SUBROUTINE PUSHCONTROL5B(cc)
 215       INTEGER cc
 216       CALL PUSHBIT(BTEST(cc,0))
 217       CALL PUSHBIT(BTEST(cc,1))
 218       CALL PUSHBIT(BTEST(cc,2))
 219       CALL PUSHBIT(BTEST(cc,3))
 220       CALL PUSHBIT(BTEST(cc,4))
 221       END
 222
 223       SUBROUTINE POPCONTROL5B(cc)
 224       INTEGER cc
 225       LOGICAL POPBIT
 226       IF (POPBIT()) THEN
 227          cc = 16
 228       ELSE
 229          cc = 0
 230       ENDIF
 231       IF (POPBIT()) cc = IBSET(cc,3)
 232       IF (POPBIT()) cc = IBSET(cc,2)
 233       IF (POPBIT()) cc = IBSET(cc,1)
 234       IF (POPBIT()) cc = IBSET(cc,0)
 235       END
 236
 237       SUBROUTINE LOOKCONTROL5B(cc)
 238       INTEGER cc
 239       LOGICAL LOOKBIT
 240       IF (LOOKBIT()) THEN
 241          cc = 16
 242       ELSE
 243          cc = 0
 244       ENDIF
 245       IF (LOOKBIT()) cc = IBSET(cc,3)
 246       IF (LOOKBIT()) cc = IBSET(cc,2)
 247       IF (LOOKBIT()) cc = IBSET(cc,1)
 248       IF (LOOKBIT()) cc = IBSET(cc,0)
 249       END
 250
 251 c======================= BOOLEANS =========================
 252
 253       SUBROUTINE PUSHBOOLEAN(x)
 254       LOGICAL x
 255       CALL PUSHBIT(x)
 256       END
 257
 258       SUBROUTINE LOOKBOOLEAN(x)
 259       LOGICAL x, LOOKBIT
 260       x = LOOKBIT()
 261       END
 262
 263       SUBROUTINE POPBOOLEAN(x)
 264       LOGICAL x, POPBIT
 265       x = POPBIT()
 266       END
 267
 268 c===================== CHARACTERS =======================:
 269       BLOCK DATA CHARACTERS
 270       CHARACTER ads1buf(512), ads1lbuf(512)
 271       INTEGER ads1ibuf,ads1ilbuf
 272       LOGICAL ads1inlbuf
 273       COMMON /ads1fbuf/ads1buf,ads1lbuf,
 274      +       ads1ibuf,ads1ilbuf,ads1inlbuf
 275       DATA ads1ibuf/1/
 276       DATA ads1ilbuf/-1/
 277       DATA ads1inlbuf/.FALSE./
 278       END
 279
 280       SUBROUTINE PUSHCHARACTER(x)
 281       CHARACTER x, ads1buf(512), ads1lbuf(512)
 282       INTEGER ads1ibuf,ads1ilbuf
 283       LOGICAL ads1inlbuf
 284       COMMON /ads1fbuf/ads1buf,ads1lbuf,
 285      +       ads1ibuf,ads1ilbuf,ads1inlbuf
 286 c
 287       CALL addftraffic(1)
 288       IF (ads1ilbuf.ne.-1) THEN
 289          ads1ilbuf = -1
 290          ads1inlbuf = .FALSE.
 291       ENDIF
 292       IF (ads1ibuf.ge.512) THEN
 293          ads1buf(512) = x
 294          CALL PUSHCHARACTERARRAY(ads1buf, 512)
 295       CALL addftraffic(-512)
 296          ads1ibuf = 1
 297       ELSE
 298          ads1buf(ads1ibuf) = x
 299          ads1ibuf = ads1ibuf+1
 300       ENDIF
 301       END
 302
 303       SUBROUTINE LOOKCHARACTER(x)
 304       CHARACTER x, ads1buf(512), ads1lbuf(512)
 305       INTEGER ads1ibuf,ads1ilbuf
 306       LOGICAL ads1inlbuf
 307       COMMON /ads1fbuf/ads1buf,ads1lbuf,
 308      +       ads1ibuf,ads1ilbuf,ads1inlbuf
 309 c
 310       IF (ads1ilbuf.eq.-1) THEN
 311          ads1ilbuf=ads1ibuf
 312          CALL RESETADLOOKSTACK()
 313       ENDIF
 314       IF (ads1ilbuf.le.1) THEN
 315          CALL LOOKCHARACTERARRAY(ads1lbuf, 512)
 316          ads1inlbuf = .TRUE.
 317          ads1ilbuf = 512
 318          x = ads1lbuf(512)
 319       ELSE
 320          ads1ilbuf = ads1ilbuf-1
 321          if (ads1inlbuf) THEN
 322             x = ads1lbuf(ads1ilbuf)
 323          ELSE
 324             x = ads1buf(ads1ilbuf)
 325          ENDIF
 326       ENDIF
 327       END
 328
 329       SUBROUTINE POPCHARACTER(x)
 330       CHARACTER x, ads1buf(512), ads1lbuf(512)
 331       INTEGER ads1ibuf,ads1ilbuf
 332       LOGICAL ads1inlbuf
 333       COMMON /ads1fbuf/ads1buf,ads1lbuf,
 334      +       ads1ibuf,ads1ilbuf,ads1inlbuf
 335 c
 336       IF (ads1ilbuf.ne.-1) THEN
 337          ads1ilbuf = -1
 338          ads1inlbuf = .FALSE.
 339       ENDIF
 340       IF (ads1ibuf.le.1) THEN
 341          CALL POPCHARACTERARRAY(ads1buf, 512)
 342          ads1ibuf = 512
 343          x = ads1buf(512)
 344       ELSE
 345          ads1ibuf = ads1ibuf-1
 346          x = ads1buf(ads1ibuf)
 347       ENDIF
 348       END
 349
 350 c======================= INTEGER*4 =========================:
 351       BLOCK DATA INTEGERS4
 352       INTEGER*4 adi4buf(512), adi4lbuf(512)
 353       INTEGER adi4ibuf,adi4ilbuf
 354       LOGICAL adi4inlbuf
 355       COMMON /adi4fbuf/adi4buf,adi4lbuf,
 356      +       adi4ibuf,adi4ilbuf,adi4inlbuf
 357       DATA adi4ibuf/1/
 358       DATA adi4ilbuf/-1/
 359       DATA adi4inlbuf/.FALSE./
 360       END
 361
 362       SUBROUTINE PUSHINTEGER4(x)
 363       INTEGER*4 x, adi4buf(512), adi4lbuf(512)
 364       INTEGER adi4ibuf,adi4ilbuf
 365       LOGICAL adi4inlbuf
 366       COMMON /adi4fbuf/adi4buf,adi4lbuf,
 367      +       adi4ibuf,adi4ilbuf,adi4inlbuf
 368 c
 369       CALL addftraffic(4)
 370       IF (adi4ilbuf.ne.-1) THEN
 371          adi4ilbuf = -1
 372          adi4inlbuf = .FALSE.
 373       ENDIF
 374       IF (adi4ibuf.ge.512) THEN
 375          adi4buf(512) = x
 376          CALL PUSHINTEGER4ARRAY(adi4buf, 512)
 377          CALL addftraffic(-2048)
 378          adi4ibuf = 1
 379       ELSE
 380          adi4buf(adi4ibuf) = x
 381          adi4ibuf = adi4ibuf+1
 382       ENDIF
 383       END
 384
 385       SUBROUTINE LOOKINTEGER4(x)
 386       INTEGER*4 x, adi4buf(512), adi4lbuf(512)
 387       INTEGER adi4ibuf,adi4ilbuf
 388       LOGICAL adi4inlbuf
 389       COMMON /adi4fbuf/adi4buf,adi4lbuf,
 390      +       adi4ibuf,adi4ilbuf,adi4inlbuf
 391 c
 392       IF (adi4ilbuf.eq.-1) THEN
 393          adi4ilbuf=adi4ibuf
 394          CALL RESETADLOOKSTACK()
 395       ENDIF
 396       IF (adi4ilbuf.le.1) THEN
 397          CALL LOOKINTEGER4ARRAY(adi4lbuf, 512)
 398          adi4inlbuf = .TRUE.
 399          adi4ilbuf = 512
 400          x = adi4lbuf(512)
 401       ELSE
 402          adi4ilbuf = adi4ilbuf-1
 403          if (adi4inlbuf) THEN
 404             x = adi4lbuf(adi4ilbuf)
 405          ELSE
 406             x = adi4buf(adi4ilbuf)
 407          ENDIF
 408       ENDIF
 409       END
 410
 411       SUBROUTINE POPINTEGER4(x)
 412       INTEGER*4 x, adi4buf(512), adi4lbuf(512)
 413       INTEGER adi4ibuf,adi4ilbuf
 414       LOGICAL adi4inlbuf
 415       COMMON /adi4fbuf/adi4buf,adi4lbuf,
 416      +       adi4ibuf,adi4ilbuf,adi4inlbuf
 417 c
 418       IF (adi4ilbuf.ne.-1) THEN
 419          adi4ilbuf = -1
 420          adi4inlbuf = .FALSE.
 421       ENDIF
 422       IF (adi4ibuf.le.1) THEN
 423          CALL POPINTEGER4ARRAY(adi4buf, 512)
 424          adi4ibuf = 512
 425          x = adi4buf(512)
 426       ELSE
 427          adi4ibuf = adi4ibuf-1
 428          x = adi4buf(adi4ibuf)
 429       ENDIF
 430       END
 431
 432 c======================= INTEGER*8 =========================
 433       BLOCK DATA INTEGERS8
 434       INTEGER*8 adi8buf(512), adi8lbuf(512)
 435       INTEGER adi8ibuf,adi8ilbuf
 436       LOGICAL adi8inlbuf
 437       COMMON /adi8fbuf/adi8buf,adi8lbuf,
 438      +       adi8ibuf,adi8ilbuf,adi8inlbuf
 439       DATA adi8ibuf/1/
 440       DATA adi8ilbuf/-1/
 441       DATA adi8inlbuf/.FALSE./
 442       END
 443
 444       SUBROUTINE PUSHINTEGER8(x)
 445       INTEGER*8 x, adi8buf(512), adi8lbuf(512)
 446       INTEGER adi8ibuf,adi8ilbuf
 447       LOGICAL adi8inlbuf
 448       COMMON /adi8fbuf/adi8buf,adi8lbuf,
 449      +       adi8ibuf,adi8ilbuf,adi8inlbuf
 450 c
 451       CALL addftraffic(8)
 452       IF (adi8ilbuf.ne.-1) THEN
 453          adi8ilbuf = -1
 454          adi8inlbuf = .FALSE.
 455       ENDIF
 456       IF (adi8ibuf.ge.512) THEN
 457          adi8buf(512) = x
 458          CALL PUSHINTEGER8ARRAY(adi8buf, 512)
 459       CALL addftraffic(-4096)
 460          adi8ibuf = 1
 461       ELSE
 462          adi8buf(adi8ibuf) = x
 463          adi8ibuf = adi8ibuf+1
 464       ENDIF
 465       END
 466
 467       SUBROUTINE LOOKINTEGER8(x)
 468       INTEGER*8 x, adi8buf(512), adi8lbuf(512)
 469       INTEGER adi8ibuf,adi8ilbuf
 470       LOGICAL adi8inlbuf
 471       COMMON /adi8fbuf/adi8buf,adi8lbuf,
 472      +       adi8ibuf,adi8ilbuf,adi8inlbuf
 473 c
 474       IF (adi8ilbuf.eq.-1) THEN
 475          adi8ilbuf=adi8ibuf
 476          CALL RESETADLOOKSTACK()
 477       ENDIF
 478       IF (adi8ilbuf.le.1) THEN
 479          CALL LOOKINTEGER8ARRAY(adi8lbuf, 512)
 480          adi8inlbuf = .TRUE.
 481          adi8ilbuf = 512
 482          x = adi8lbuf(512)
 483       ELSE
 484          adi8ilbuf = adi8ilbuf-1
 485          if (adi8inlbuf) THEN
 486             x = adi8lbuf(adi8ilbuf)
 487          ELSE
 488             x = adi8buf(adi8ilbuf)
 489          ENDIF
 490       ENDIF
 491       END
 492
 493       SUBROUTINE POPINTEGER8(x)
 494       INTEGER*8 x, adi8buf(512), adi8lbuf(512)
 495       INTEGER adi8ibuf,adi8ilbuf
 496       LOGICAL adi8inlbuf
 497       COMMON /adi8fbuf/adi8buf,adi8lbuf,
 498      +       adi8ibuf,adi8ilbuf,adi8inlbuf
 499 c
 500       IF (adi8ilbuf.ne.-1) THEN
 501          adi8ilbuf = -1
 502          adi8inlbuf = .FALSE.
 503       ENDIF
 504       IF (adi8ibuf.le.1) THEN
 505          CALL POPINTEGER8ARRAY(adi8buf, 512)
 506          adi8ibuf = 512
 507          x = adi8buf(512)
 508       ELSE
 509          adi8ibuf = adi8ibuf-1
 510          x = adi8buf(adi8ibuf)
 511       ENDIF
 512       END
 513
 514 c======================= REAL*4 =========================
 515       BLOCK DATA REALS4
 516       REAL*4 adr4buf(512), adr4lbuf(512)
 517       INTEGER adr4ibuf,adr4ilbuf
 518       LOGICAL adr4inlbuf
 519       COMMON /adr4fbuf/adr4buf,adr4lbuf,
 520      +       adr4ibuf,adr4ilbuf,adr4inlbuf
 521       DATA adr4ibuf/1/
 522       DATA adr4ilbuf/-1/
 523       DATA adr4inlbuf/.FALSE./
 524       END
 525
 526       SUBROUTINE PUSHREAL4(x)
 527       REAL*4 x, adr4buf(512), adr4lbuf(512)
 528       INTEGER adr4ibuf,adr4ilbuf
 529       LOGICAL adr4inlbuf
 530       COMMON /adr4fbuf/adr4buf,adr4lbuf,
 531      +       adr4ibuf,adr4ilbuf,adr4inlbuf
 532 c
 533       CALL addftraffic(4)
 534       IF (adr4ilbuf.ne.-1) THEN
 535          adr4ilbuf = -1
 536          adr4inlbuf = .FALSE.
 537       ENDIF
 538       IF (adr4ibuf.ge.512) THEN
 539          adr4buf(512) = x
 540          CALL PUSHREAL4ARRAY(adr4buf, 512)
 541       CALL addftraffic(-2048)
 542          adr4ibuf = 1
 543       ELSE
 544          adr4buf(adr4ibuf) = x
 545          adr4ibuf = adr4ibuf+1
 546       ENDIF
 547       END
 548
 549       SUBROUTINE LOOKREAL4(x)
 550       REAL*4 x, adr4buf(512), adr4lbuf(512)
 551       INTEGER adr4ibuf,adr4ilbuf
 552       LOGICAL adr4inlbuf
 553       COMMON /adr4fbuf/adr4buf,adr4lbuf,
 554      +       adr4ibuf,adr4ilbuf,adr4inlbuf
 555 c
 556       IF (adr4ilbuf.eq.-1) THEN
 557          adr4ilbuf=adr4ibuf
 558          CALL RESETADLOOKSTACK()
 559       ENDIF
 560       IF (adr4ilbuf.le.1) THEN
 561          CALL LOOKREAL4ARRAY(adr4lbuf, 512)
 562          adr4inlbuf = .TRUE.
 563          adr4ilbuf = 512
 564          x = adr4lbuf(512)
 565       ELSE
 566          adr4ilbuf = adr4ilbuf-1
 567          if (adr4inlbuf) THEN
 568             x = adr4lbuf(adr4ilbuf)
 569          ELSE
 570             x = adr4buf(adr4ilbuf)
 571          ENDIF
 572       ENDIF
 573       END
 574
 575       SUBROUTINE POPREAL4(x)
 576       REAL*4 x, adr4buf(512), adr4lbuf(512)
 577       INTEGER adr4ibuf,adr4ilbuf
 578       LOGICAL adr4inlbuf
 579       COMMON /adr4fbuf/adr4buf,adr4lbuf,
 580      +       adr4ibuf,adr4ilbuf,adr4inlbuf
 581 c
 582       IF (adr4ilbuf.ne.-1) THEN
 583          adr4ilbuf = -1
 584          adr4inlbuf = .FALSE.
 585       ENDIF
 586       IF (adr4ibuf.le.1) THEN
 587          CALL POPREAL4ARRAY(adr4buf, 512)
 588          adr4ibuf = 512
 589          x = adr4buf(512)
 590       ELSE
 591          adr4ibuf = adr4ibuf-1
 592          x = adr4buf(adr4ibuf)
 593       ENDIF
 594       END
 595
 596 c======================= REAL*8 =========================
 597       BLOCK DATA REALS8
 598       REAL*8 adr8buf(512), adr8lbuf(512)
 599       INTEGER adr8ibuf,adr8ilbuf
 600       LOGICAL adr8inlbuf
 601       COMMON /adr8fbuf/adr8buf,adr8lbuf,
 602      +       adr8ibuf,adr8ilbuf,adr8inlbuf
 603       DATA adr8ibuf/1/
 604       DATA adr8ilbuf/-1/
 605       DATA adr8inlbuf/.FALSE./
 606       END
 607
 608       SUBROUTINE PUSHREAL8(x)
 609       REAL*8 x, adr8buf(512), adr8lbuf(512)
 610       INTEGER adr8ibuf,adr8ilbuf
 611       LOGICAL adr8inlbuf
 612       COMMON /adr8fbuf/adr8buf,adr8lbuf,
 613      +       adr8ibuf,adr8ilbuf,adr8inlbuf
 614 c
 615       CALL addftraffic(8)
 616       IF (adr8ilbuf.ne.-1) THEN
 617          adr8ilbuf = -1
 618          adr8inlbuf = .FALSE.
 619       ENDIF
 620       IF (adr8ibuf.ge.512) THEN
 621          adr8buf(512) = x
 622          CALL PUSHREAL8ARRAY(adr8buf, 512)
 623       CALL addftraffic(-4096)
 624          adr8ibuf = 1
 625       ELSE
 626          adr8buf(adr8ibuf) = x
 627          adr8ibuf = adr8ibuf+1
 628       ENDIF
 629       END
 630
 631       SUBROUTINE LOOKREAL8(x)
 632       REAL*8 x, adr8buf(512), adr8lbuf(512)
 633       INTEGER adr8ibuf,adr8ilbuf
 634       LOGICAL adr8inlbuf
 635       COMMON /adr8fbuf/adr8buf,adr8lbuf,
 636      +       adr8ibuf,adr8ilbuf,adr8inlbuf
 637 c
 638       IF (adr8ilbuf.eq.-1) THEN
 639          adr8ilbuf=adr8ibuf
 640          CALL RESETADLOOKSTACK()
 641       ENDIF
 642       IF (adr8ilbuf.le.1) THEN
 643          CALL LOOKREAL8ARRAY(adr8lbuf, 512)
 644          adr8inlbuf = .TRUE.
 645          adr8ilbuf = 512
 646          x = adr8lbuf(512)
 647       ELSE
 648          adr8ilbuf = adr8ilbuf-1
 649          if (adr8inlbuf) THEN
 650             x = adr8lbuf(adr8ilbuf)
 651          ELSE
 652             x = adr8buf(adr8ilbuf)
 653          ENDIF
 654       ENDIF
 655       END
 656
 657       SUBROUTINE POPREAL8(x)
 658       REAL*8 x, adr8buf(512), adr8lbuf(512)
 659       INTEGER adr8ibuf,adr8ilbuf
 660       LOGICAL adr8inlbuf
 661       COMMON /adr8fbuf/adr8buf,adr8lbuf,
 662      +       adr8ibuf,adr8ilbuf,adr8inlbuf
 663 c
 664       IF (adr8ilbuf.ne.-1) THEN
 665          adr8ilbuf = -1
 666          adr8inlbuf = .FALSE.
 667       ENDIF
 668       IF (adr8ibuf.le.1) THEN
 669          CALL POPREAL8ARRAY(adr8buf, 512)
 670          adr8ibuf = 512
 671          x = adr8buf(512)
 672       ELSE
 673          adr8ibuf = adr8ibuf-1
 674          x = adr8buf(adr8ibuf)
 675       ENDIF
 676       END
 677
 678 c======================= REAL*16 =========================
 679       BLOCK DATA REALS16
 680       DOUBLE PRECISION adr16buf(512), adr16lbuf(512)
 681       INTEGER adr16ibuf,adr16ilbuf
 682       LOGICAL adr16inlbuf
 683       COMMON /adr16fbuf/adr16buf,adr16lbuf,
 684      +       adr16ibuf,adr16ilbuf,adr16inlbuf
 685       DATA adr16ibuf/1/
 686       DATA adr16ilbuf/-1/
 687       DATA adr16inlbuf/.FALSE./
 688       END
 689
 690       SUBROUTINE PUSHREAL16(x)
 691       DOUBLE PRECISION x, adr16buf(512), adr16lbuf(512)
 692       INTEGER adr16ibuf,adr16ilbuf
 693       LOGICAL adr16inlbuf
 694       COMMON /adr16fbuf/adr16buf,adr16lbuf,
 695      +       adr16ibuf,adr16ilbuf,adr16inlbuf
 696 c
 697       CALL addftraffic(16)
 698       IF (adr16ilbuf.ne.-1) THEN
 699          adr16ilbuf = -1
 700          adr16inlbuf = .FALSE.
 701       ENDIF
 702       IF (adr16ibuf.ge.512) THEN
 703          adr16buf(512) = x
 704          CALL PUSHREAL16ARRAY(adr16buf, 512)
 705       CALL addftraffic(-8192)
 706          adr16ibuf = 1
 707       ELSE
 708          adr16buf(adr16ibuf) = x
 709          adr16ibuf = adr16ibuf+1
 710       ENDIF
 711       END
 712
 713       SUBROUTINE LOOKREAL16(x)
 714       DOUBLE PRECISION x, adr16buf(512), adr16lbuf(512)
 715       INTEGER adr16ibuf,adr16ilbuf
 716       LOGICAL adr16inlbuf
 717       COMMON /adr16fbuf/adr16buf,adr16lbuf,
 718      +       adr16ibuf,adr16ilbuf,adr16inlbuf
 719 c
 720       IF (adr16ilbuf.eq.-1) THEN
 721          adr16ilbuf=adr16ibuf
 722          CALL RESETADLOOKSTACK()
 723       ENDIF
 724       IF (adr16ilbuf.le.1) THEN
 725          CALL LOOKREAL16ARRAY(adr16lbuf, 512)
 726          adr16inlbuf = .TRUE.
 727          adr16ilbuf = 512
 728          x = adr16lbuf(512)
 729       ELSE
 730          adr16ilbuf = adr16ilbuf-1
 731          if (adr16inlbuf) THEN
 732             x = adr16lbuf(adr16ilbuf)
 733          ELSE
 734             x = adr16buf(adr16ilbuf)
 735          ENDIF
 736       ENDIF
 737       END
 738
 739       SUBROUTINE POPREAL16(x)
 740       DOUBLE PRECISION x, adr16buf(512), adr16lbuf(512)
 741       INTEGER adr16ibuf,adr16ilbuf
 742       LOGICAL adr16inlbuf
 743       COMMON /adr16fbuf/adr16buf,adr16lbuf,
 744      +       adr16ibuf,adr16ilbuf,adr16inlbuf
 745 c
 746       IF (adr16ilbuf.ne.-1) THEN
 747          adr16ilbuf = -1
 748          adr16inlbuf = .FALSE.
 749       ENDIF
 750       IF (adr16ibuf.le.1) THEN
 751          CALL POPREAL16ARRAY(adr16buf, 512)
 752          adr16ibuf = 512
 753          x = adr16buf(512)
 754       ELSE
 755          adr16ibuf = adr16ibuf-1
 756          x = adr16buf(adr16ibuf)
 757       ENDIF
 758       END
 759
 760 c======================= COMPLEX*8 =========================
 761       BLOCK DATA COMPLEXS8
 762       COMPLEX*8 adc8buf(512), adc8lbuf(512)
 763       INTEGER adc8ibuf,adc8ilbuf
 764       LOGICAL adc8inlbuf
 765       COMMON /adc8fbuf/adc8buf,adc8lbuf,
 766      +       adc8ibuf,adc8ilbuf,adc8inlbuf
 767       DATA adc8ibuf/1/
 768       DATA adc8ilbuf/-1/
 769       DATA adc8inlbuf/.FALSE./
 770       END
 771
 772       SUBROUTINE PUSHCOMPLEX8(x)
 773       COMPLEX*8 x, adc8buf(512), adc8lbuf(512)
 774       INTEGER adc8ibuf,adc8ilbuf
 775       LOGICAL adc8inlbuf
 776       COMMON /adc8fbuf/adc8buf,adc8lbuf,
 777      +       adc8ibuf,adc8ilbuf,adc8inlbuf
 778 c
 779       CALL addftraffic(8)
 780       IF (adc8ilbuf.ne.-1) THEN
 781          adc8ilbuf = -1
 782          adc8inlbuf = .FALSE.
 783       ENDIF
 784       IF (adc8ibuf.ge.512) THEN
 785          adc8buf(512) = x
 786          CALL PUSHCOMPLEX8ARRAY(adc8buf, 512)
 787       CALL addftraffic(-4096)
 788          adc8ibuf = 1
 789       ELSE
 790          adc8buf(adc8ibuf) = x
 791          adc8ibuf = adc8ibuf+1
 792       ENDIF
 793       END
 794
 795       SUBROUTINE LOOKCOMPLEX8(x)
 796       COMPLEX*8 x, adc8buf(512), adc8lbuf(512)
 797       INTEGER adc8ibuf,adc8ilbuf
 798       LOGICAL adc8inlbuf
 799       COMMON /adc8fbuf/adc8buf,adc8lbuf,
 800      +       adc8ibuf,adc8ilbuf,adc8inlbuf
 801 c
 802       IF (adc8ilbuf.eq.-1) THEN
 803          adc8ilbuf=adc8ibuf
 804          CALL RESETADLOOKSTACK()
 805       ENDIF
 806       IF (adc8ilbuf.le.1) THEN
 807          CALL LOOKCOMPLEX8ARRAY(adc8lbuf, 512)
 808          adc8inlbuf = .TRUE.
 809          adc8ilbuf = 512
 810          x = adc8lbuf(512)
 811       ELSE
 812          adc8ilbuf = adc8ilbuf-1
 813          if (adc8inlbuf) THEN
 814             x = adc8lbuf(adc8ilbuf)
 815          ELSE
 816             x = adc8buf(adc8ilbuf)
 817          ENDIF
 818       ENDIF
 819       END
 820
 821       SUBROUTINE POPCOMPLEX8(x)
 822       COMPLEX*8 x, adc8buf(512), adc8lbuf(512)
 823       INTEGER adc8ibuf,adc8ilbuf
 824       LOGICAL adc8inlbuf
 825       COMMON /adc8fbuf/adc8buf,adc8lbuf,
 826      +       adc8ibuf,adc8ilbuf,adc8inlbuf
 827 c
 828       IF (adc8ilbuf.ne.-1) THEN
 829          adc8ilbuf = -1
 830          adc8inlbuf = .FALSE.
 831       ENDIF
 832       IF (adc8ibuf.le.1) THEN
 833          CALL POPCOMPLEX8ARRAY(adc8buf, 512)
 834          adc8ibuf = 512
 835          x = adc8buf(512)
 836       ELSE
 837          adc8ibuf = adc8ibuf-1
 838          x = adc8buf(adc8ibuf)
 839       ENDIF
 840       END
 841
 842 c======================= COMPLEX*16 =========================
 843       BLOCK DATA COMPLEXS16
 844       COMPLEX*16 adc16buf(512), adc16lbuf(512)
 845       INTEGER adc16ibuf,adc16ilbuf
 846       LOGICAL adc16inlbuf
 847       COMMON /adc16fbuf/adc16buf,adc16lbuf,
 848      +       adc16ibuf,adc16ilbuf,adc16inlbuf
 849       DATA adc16ibuf/1/
 850       DATA adc16ilbuf/-1/
 851       DATA adc16inlbuf/.FALSE./
 852       END
 853
 854       SUBROUTINE PUSHCOMPLEX16(x)
 855       COMPLEX*16 x, adc16buf(512), adc16lbuf(512)
 856       INTEGER adc16ibuf,adc16ilbuf
 857       LOGICAL adc16inlbuf
 858       COMMON /adc16fbuf/adc16buf,adc16lbuf,
 859      +       adc16ibuf,adc16ilbuf,adc16inlbuf
 860 c
 861       CALL addftraffic(16)
 862       IF (adc16ilbuf.ne.-1) THEN
 863          adc16ilbuf = -1
 864          adc16inlbuf = .FALSE.
 865       ENDIF
 866       IF (adc16ibuf.ge.512) THEN
 867          adc16buf(512) = x
 868          CALL PUSHCOMPLEX16ARRAY(adc16buf, 512)
 869       CALL addftraffic(-8192)
 870          adc16ibuf = 1
 871       ELSE
 872          adc16buf(adc16ibuf) = x
 873          adc16ibuf = adc16ibuf+1
 874       ENDIF
 875       END
 876
 877       SUBROUTINE LOOKCOMPLEX16(x)
 878       COMPLEX*16 x, adc16buf(512), adc16lbuf(512)
 879       INTEGER adc16ibuf,adc16ilbuf
 880       LOGICAL adc16inlbuf
 881       COMMON /adc16fbuf/adc16buf,adc16lbuf,
 882      +       adc16ibuf,adc16ilbuf,adc16inlbuf
 883 c
 884       IF (adc16ilbuf.eq.-1) THEN
 885          adc16ilbuf=adc16ibuf
 886          CALL RESETADLOOKSTACK()
 887       ENDIF
 888       IF (adc16ilbuf.le.1) THEN
 889          CALL LOOKCOMPLEX16ARRAY(adc16lbuf, 512)
 890          adc16inlbuf = .TRUE.
 891          adc16ilbuf = 512
 892          x = adc16lbuf(512)
 893       ELSE
 894          adc16ilbuf = adc16ilbuf-1
 895          if (adc16inlbuf) THEN
 896             x = adc16lbuf(adc16ilbuf)
 897          ELSE
 898             x = adc16buf(adc16ilbuf)
 899          ENDIF
 900       ENDIF
 901       END
 902
 903       SUBROUTINE POPCOMPLEX16(x)
 904       COMPLEX*16 x, adc16buf(512), adc16lbuf(512)
 905       INTEGER adc16ibuf,adc16ilbuf
 906       LOGICAL adc16inlbuf
 907       COMMON /adc16fbuf/adc16buf,adc16lbuf,
 908      +       adc16ibuf,adc16ilbuf,adc16inlbuf
 909 c
 910       IF (adc16ilbuf.ne.-1) THEN
 911          adc16ilbuf = -1
 912          adc16inlbuf = .FALSE.
 913       ENDIF
 914       IF (adc16ibuf.le.1) THEN
 915          CALL POPCOMPLEX16ARRAY(adc16buf, 512)
 916          adc16ibuf = 512
 917          x = adc16buf(512)
 918       ELSE
 919          adc16ibuf = adc16ibuf-1
 920          x = adc16buf(adc16ibuf)
 921       ENDIF
 922       END
 923
 924 C=========== MEASUREMENT OF PUSH/POP TRAFFIC ==========
 925
 926       BLOCK DATA MEMTRAFFIC
 927       INTEGER*8 mmftraffic,mmftrafficM
 928       COMMON /mmcomtraffic/mmftraffic,mmftrafficM
 929       DATA mmftraffic/0/
 930       DATA mmftrafficM/0/
 931       END
 932
 933       subroutine addftraffic(n)
 934       INTEGER n
 935       INTEGER*8 mmftraffic,mmftrafficM
 936       COMMON /mmcomtraffic/mmftraffic,mmftrafficM
 937 c
 938       mmftraffic = mmftraffic+n
 939       if (mmftraffic.ge.1000000) then
 940  100     mmftraffic = mmftraffic-1000000
 941          mmftrafficM = mmftrafficM+1
 942          if (mmftraffic.ge.1000000) then
 943             goto 100
 944          else
 945             goto 300
 946          endif
 947       else if (mmftraffic.lt.0) then
 948  200     mmftraffic = mmftraffic+1000000
 949          mmftrafficM = mmftrafficM-1
 950          if (mmftraffic.lt.0) then
 951             goto 200
 952          else
 953             goto 300
 954          endif
 955       endif
 956  300  continue
 957       END
 958
 959       SUBROUTINE PRINTTRAFFIC()
 960       INTEGER*8 mmftraffic,mmftrafficM
 961       COMMON /mmcomtraffic/mmftraffic,mmftrafficM
 962       CALL printctraffic()
 963       CALL printftrafficinc(mmftrafficM, 1000000, mmftraffic)
 964 c       write (6,1001) ' F Traffic: ',mmftrafficM,' Mb and ',
 965 c      +     (((mmftraffic*1000)/1024)*1000)/1024, ' millionths'
 966 c 1001  format(a,i6,a,i6,a)
 967       END
 968
 969 C ============ PRINTING THE SIZE OF STACKS AND BUFFERS ==========
 970
 971       SUBROUTINE PRINTBUFFERTOP()
 972       integer*4 SMALLSTACKSIZE
 973       integer*4 size
 974
 975       size = SMALLSTACKSIZE()
 976       print *,'Buffer size:',size,' bytes i.e. ',size/1024.0,' Kbytes'
 977       END
 978
 979       FUNCTION SMALLSTACKSIZE()
 980       CHARACTER ads1buf(512), ads1lbuf(512)
 981       INTEGER ads1ibuf,ads1ilbuf
 982       LOGICAL ads1inlbuf
 983       COMMON /ads1fbuf/ads1buf,ads1lbuf,
 984      +       ads1ibuf,ads1ilbuf,ads1inlbuf
 985 c      LOGICAL adl4buf(512), adl4lbuf(512)
 986 c      INTEGER adl4ibuf,adl4ilbuf
 987 c      LOGICAL adl4inlbuf
 988 c      COMMON /adl4fbuf/adl4buf,adl4lbuf,
 989 c     +       adl4ibuf,adl4ilbuf,adl4inlbuf
 990       INTEGER*4 adi4buf(512), adi4lbuf(512)
 991       INTEGER adi4ibuf,adi4ilbuf
 992       LOGICAL adi4inlbuf
 993       COMMON /adi4fbuf/adi4buf,adi4lbuf,
 994      +       adi4ibuf,adi4ilbuf,adi4inlbuf
 995       INTEGER*8 adi8buf(512), adi8lbuf(512)
 996       INTEGER adi8ibuf,adi8ilbuf
 997       LOGICAL adi8inlbuf
 998       COMMON /adi8fbuf/adi8buf,adi8lbuf,
 999      +       adi8ibuf,adi8ilbuf,adi8inlbuf
1000 c           INTEGER*16 adi16buf(512), adi16lbuf(512)
1001 c           INTEGER adi16ibuf,adi16ilbuf
1002 c           LOGICAL adi16inlbuf
1003 c           COMMON /adi16fbuf/adi16buf,adi16lbuf,
1004 c          +       adi16ibuf,adi16ilbuf,adi16inlbuf
1005       REAL*4 adr4buf(512), adr4lbuf(512)
1006       INTEGER adr4ibuf,adr4ilbuf
1007       LOGICAL adr4inlbuf
1008       COMMON /adr4fbuf/adr4buf,adr4lbuf,
1009      +       adr4ibuf,adr4ilbuf,adr4inlbuf
1010       REAL*8 adr8buf(512), adr8lbuf(512)
1011       INTEGER adr8ibuf,adr8ilbuf
1012       LOGICAL adr8inlbuf
1013       COMMON /adr8fbuf/adr8buf,adr8lbuf,
1014      +       adr8ibuf,adr8ilbuf,adr8inlbuf
1015       DOUBLE PRECISION adr16buf(512), adr16lbuf(512)
1016       INTEGER adr16ibuf,adr16ilbuf
1017       LOGICAL adr16inlbuf
1018       COMMON /adr16fbuf/adr16buf,adr16lbuf,
1019      +       adr16ibuf,adr16ilbuf,adr16inlbuf
1020 c           REAL*32 x, adr32buf(512), adr32lbuf(512)
1021 c           INTEGER adr32ibuf,adr32ilbuf
1022 c           LOGICAL adr32inlbuf
1023 c           COMMON /adr32fbuf/adr32buf,adr32lbuf,
1024 c          +       adr32ibuf,adr32ilbuf,adr32inlbuf
1025 c           COMPLEX*4 adc4buf(512), adc4lbuf(512)
1026 c           INTEGER adc4ibuf,adc4ilbuf
1027 c           LOGICAL adc4inlbuf
1028 c           COMMON /adc4fbuf/adc4buf,adc4lbuf,
1029 c          +       adc4ibuf,adc4ilbuf,adc4inlbuf
1030       COMPLEX*8 adc8buf(512), adc8lbuf(512)
1031       INTEGER adc8ibuf,adc8ilbuf
1032       LOGICAL adc8inlbuf
1033       COMMON /adc8fbuf/adc8buf,adc8lbuf,
1034      +       adc8ibuf,adc8ilbuf,adc8inlbuf
1035       COMPLEX*16 adc16buf(512), adc16lbuf(512)
1036       INTEGER adc16ibuf,adc16ilbuf
1037       LOGICAL adc16inlbuf
1038       COMMON /adc16fbuf/adc16buf,adc16lbuf,
1039      +       adc16ibuf,adc16ilbuf,adc16inlbuf
1040 c           COMPLEX*32 adc32buf(512), adc32lbuf(512)
1041 c           INTEGER adc32ibuf,adc32ilbuf
1042 c           LOGICAL adc32inlbuf
1043 c           COMMON /adc32fbuf/adc32buf,adc32lbuf,
1044 c          +       adc32ibuf,adc32ilbuf,adc32inlbuf
1045       integer*4 smallstacksize
1046 c
1047       smallstacksize = 0
1048       smallstacksize = smallstacksize + (ads1ibuf-1)*1
1049 c           smallstacksize = smallstacksize + (adl4ibuf-1)*4
1050       smallstacksize = smallstacksize + (adi4ibuf-1)*4
1051       smallstacksize = smallstacksize + (adi8ibuf-1)*8
1052 c           smallstacksize = smallstacksize + (adi16ibuf-1)*16
1053       smallstacksize = smallstacksize + (adr4ibuf-1)*4
1054       smallstacksize = smallstacksize + (adr8ibuf-1)*8
1055       smallstacksize = smallstacksize + (adr16ibuf-1)*16
1056 c           smallstacksize = smallstacksize + (adr32ibuf-1)*32
1057 c           smallstacksize = smallstacksize + (adc4ibuf-1)*4
1058       smallstacksize = smallstacksize + (adc8ibuf-1)*8
1059       smallstacksize = smallstacksize + (adc16ibuf-1)*16
1060 c           smallstacksize = smallstacksize + (adc32ibuf-1)*32
1061 c
1062       end
1063
1064 C FOR INTERNAL DEBUGS ONLY:
1065       SUBROUTINE SHOWALLSTACKS()
1066       INTEGER adbitbuf, adbitlbuf
1067       INTEGER adbitibuf, adbitilbuf
1068       LOGICAL adbitinlbuf
1069       COMMON /adbitfbuf/adbitbuf,adbitlbuf,
1070      +       adbitibuf,adbitilbuf,adbitinlbuf
1071       CHARACTER ads1buf(512), ads1lbuf(512)
1072       INTEGER ads1ibuf,ads1ilbuf
1073       LOGICAL ads1inlbuf
1074       COMMON /ads1fbuf/ads1buf,ads1lbuf,
1075      +       ads1ibuf,ads1ilbuf,ads1inlbuf
1076       INTEGER*4 adi4buf(512), adi4lbuf(512)
1077       INTEGER adi4ibuf,adi4ilbuf
1078       LOGICAL adi4inlbuf
1079       COMMON /adi4fbuf/adi4buf,adi4lbuf,
1080      +       adi4ibuf,adi4ilbuf,adi4inlbuf
1081       INTEGER*8 adi8buf(512), adi8lbuf(512)
1082       INTEGER adi8ibuf,adi8ilbuf
1083       LOGICAL adi8inlbuf
1084       COMMON /adi8fbuf/adi8buf,adi8lbuf,
1085      +       adi8ibuf,adi8ilbuf,adi8inlbuf
1086       REAL*4 adr4buf(512), adr4lbuf(512)
1087       INTEGER adr4ibuf,adr4ilbuf
1088       LOGICAL adr4inlbuf
1089       COMMON /adr4fbuf/adr4buf,adr4lbuf,
1090      +       adr4ibuf,adr4ilbuf,adr4inlbuf
1091       REAL*8 adr8buf(512), adr8lbuf(512)
1092       INTEGER adr8ibuf,adr8ilbuf
1093       LOGICAL adr8inlbuf
1094       COMMON /adr8fbuf/adr8buf,adr8lbuf,
1095      +       adr8ibuf,adr8ilbuf,adr8inlbuf
1096       DOUBLE PRECISION adr16buf(512), adr16lbuf(512)
1097       INTEGER adr16ibuf,adr16ilbuf
1098       LOGICAL adr16inlbuf
1099       COMMON /adr16fbuf/adr16buf,adr16lbuf,
1100      +       adr16ibuf,adr16ilbuf,adr16inlbuf
1101       COMPLEX*8 adc8buf(512), adc8lbuf(512)
1102       INTEGER adc8ibuf,adc8ilbuf
1103       LOGICAL adc8inlbuf
1104       COMMON /adc8fbuf/adc8buf,adc8lbuf,
1105      +       adc8ibuf,adc8ilbuf,adc8inlbuf
1106       COMPLEX*16 adc16buf(512), adc16lbuf(512)
1107       INTEGER adc16ibuf,adc16ilbuf
1108       LOGICAL adc16inlbuf
1109       COMMON /adc16fbuf/adc16buf,adc16lbuf,
1110      +       adc16ibuf,adc16ilbuf,adc16inlbuf
1111       INTEGER i
1112 c
1113       write (6,1010) 'BIT STACK       : ',adbitbuf,'==',adbitbuf,
1114      +     ' (',adbitibuf,')'
1115 1010  format(a,i20,a,z16,a,i2,a)
1116       write (6,1011) 'INTEGER*8 BUFFER[',adi8ibuf-1,']: ',
1117      +     (adi8buf(i),i=1,adi8ibuf-1)
1118       write (6,1011) 'INTEGER*4 BUFFER[',adi4ibuf-1,']: ',
1119      +     (adi4buf(i),i=1,adi4ibuf-1)
1120 1011  format(a,i3,a,512(i40))
1121       write (6,1012) 'REAL*16   BUFFER:[',adr16ibuf-1,']: ',
1122      +     (adr16buf(i),i=1,adr16ibuf-1)
1123       write (6,1012) 'REAL*8    BUFFER:[',adr8ibuf-1, ']: ',
1124      +     (adr8buf(i),i=1,adr8ibuf-1)
1125       write (6,1012) 'REAL*4    BUFFER:[',adr4ibuf-1, ']: ',
1126      +     (adr4buf(i),i=1,adr4ibuf-1)
1127 1012  format(a,512(e10.2))
1128       call showrecentcstack()
1129 c
1130       END
1131
1132 C========================================================
1133 C PUSH* POP* SUBROUTINES FOR OTHER DATA TYPES
1134 C Uncomment if these types are available on your compiler
1135 C  and they are needed by the reverse differentiated code
1136 C Don't forget to uncomment the corresponding lines in
1137 C  subroutine PRINTBUFFERTOP, otherwise these types'
1138 C  contribution to buffer occupation will not be seen.
1139 C  (not very important anyway...)
1140
1141 c======================= INTEGER*16 =========================
1142 c           BLOCK DATA INTEGERS16
1143 c           INTEGER*16 adi16buf(512), adi16lbuf(512)
1144 c           INTEGER adi16ibuf,adi16ilbuf
1145 c           LOGICAL adi16inlbuf
1146 c           COMMON /adi16fbuf/adi16buf,adi16lbuf,
1147 c          +       adi16ibuf,adi16ilbuf,adi16inlbuf
1148 c           DATA adi16ibuf/1/
1149 c           DATA adi16ilbuf/-1/
1150 c           DATA adi16inlbuf/.FALSE./
1151 c           END
1152 c     c
1153 c           SUBROUTINE PUSHINTEGER16(x)
1154 c           INTEGER*16 x, adi16buf(512), adi16lbuf(512)
1155 c           INTEGER adi16ibuf,adi16ilbuf
1156 c           LOGICAL adi16inlbuf
1157 c           COMMON /adi16fbuf/adi16buf,adi16lbuf,
1158 c          +       adi16ibuf,adi16ilbuf,adi16inlbuf
1159 c     c
1160 c           CALL addftraffic(16)
1161 c           IF (adi16ilbuf.ne.-1) THEN
1162 c              adi16ilbuf = -1
1163 c              adi16inlbuf = .FALSE.
1164 c           ENDIF
1165 c           IF (adi16ibuf.ge.512) THEN
1166 c              adi16buf(512) = x
1167 c              CALL PUSHINTEGER16ARRAY(adi16buf, 512)
1168 c           CALL addftraffic(-8192)
1169 c              adi16ibuf = 1
1170 c           ELSE
1171 c              adi16buf(adi16ibuf) = x
1172 c              adi16ibuf = adi16ibuf+1
1173 c           ENDIF
1174 c           END
1175 c
1176 c           SUBROUTINE LOOKINTEGER16(x)
1177 c           INTEGER*16 x, adi16buf(512), adi16lbuf(512)
1178 c           INTEGER adi16ibuf,adi16ilbuf
1179 c           LOGICAL adi16inlbuf
1180 c           COMMON /adi16fbuf/adi16buf,adi16lbuf,
1181 c          +       adi16ibuf,adi16ilbuf,adi16inlbuf
1182 c     c
1183 c           IF (adi16ilbuf.eq.-1) THEN
1184 c              adi16ilbuf=adi16ibuf
1185 c              CALL RESETADLOOKSTACK()
1186 c           ENDIF
1187 c           IF (adi16ilbuf.le.1) THEN
1188 c              CALL LOOKINTEGER16ARRAY(adi16lbuf, 512)
1189 c              adi16inlbuf = .TRUE.
1190 c              adi16ilbuf = 512
1191 c              x = adi16lbuf(512)
1192 c           ELSE
1193 c              adi16ilbuf = adi16ilbuf-1
1194 c              if (adi16inlbuf) THEN
1195 c                 x = adi16lbuf(adi16ilbuf)
1196 c              ELSE
1197 c                 x = adi16buf(adi16ilbuf)
1198 c              ENDIF
1199 c           ENDIF
1200 c           END
1201 c
1202 c           SUBROUTINE POPINTEGER16(x)
1203 c           INTEGER*16 x, adi16buf(512), adi16lbuf(512)
1204 c           INTEGER adi16ibuf,adi16ilbuf
1205 c           LOGICAL adi16inlbuf
1206 c           COMMON /adi16fbuf/adi16buf,adi16lbuf,
1207 c          +       adi16ibuf,adi16ilbuf,adi16inlbuf
1208 c     c
1209 c           IF (adi16ilbuf.ne.-1) THEN
1210 c              adi16ilbuf = -1
1211 c              adi16inlbuf = .FALSE.
1212 c           ENDIF
1213 c           IF (adi16ibuf.le.1) THEN
1214 c              CALL POPINTEGER16ARRAY(adi16buf, 512)
1215 c              adi16ibuf = 512
1216 c              x = adi16buf(512)
1217 c           ELSE
1218 c              adi16ibuf = adi16ibuf-1
1219 c              x = adi16buf(adi16ibuf)
1220 c           ENDIF
1221 c           END
1222
1223 c======================= REAL*32 =========================
1224 c           BLOCK DATA REALS32
1225 c           REAL*32 adr32buf(512), adr32lbuf(512)
1226 c           INTEGER adr32ibuf,adr32ilbuf
1227 c           LOGICAL adr32inlbuf
1228 c           COMMON /adr32fbuf/adr32buf,adr32lbuf,
1229 c          +       adr32ibuf,adr32ilbuf,adr32inlbuf
1230 c           DATA adr32ibuf/1/
1231 c           DATA adr32ilbuf/-1/
1232 c           DATA adr32inlbuf/.FALSE./
1233 c           END
1234 c     c
1235 c           SUBROUTINE PUSHREAL32(x)
1236 c           REAL*32 x, adr32buf(512), adr32lbuf(512)
1237 c           INTEGER adr32ibuf,adr32ilbuf
1238 c           LOGICAL adr32inlbuf
1239 c           COMMON /adr32fbuf/adr32buf,adr32lbuf,
1240 c          +       adr32ibuf,adr32ilbuf,adr32inlbuf
1241 c     c
1242 c           CALL addftraffic(32)
1243 c           IF (adr32ilbuf.ne.-1) THEN
1244 c              adr32ilbuf = -1
1245 c              adr32inlbuf = .FALSE.
1246 c           ENDIF
1247 c           IF (adr32ibuf.ge.512) THEN
1248 c              adr32buf(512) = x
1249 c              CALL PUSHREAL32ARRAY(adr32buf, 512)
1250 c           CALL addftraffic(-16384)
1251 c              adr32ibuf = 1
1252 c           ELSE
1253 c              adr32buf(adr32ibuf) = x
1254 c              adr32ibuf = adr32ibuf+1
1255 c           ENDIF
1256 c           END
1257 c
1258 c           SUBROUTINE LOOKREAL32(x)
1259 c           REAL*32 x, adr32buf(512), adr32lbuf(512)
1260 c           INTEGER adr32ibuf,adr32ilbuf
1261 c           LOGICAL adr32inlbuf
1262 c           COMMON /adr32fbuf/adr32buf,adr32lbuf,
1263 c          +       adr32ibuf,adr32ilbuf,adr32inlbuf
1264 c     c
1265 c           IF (adr32ilbuf.eq.-1) THEN
1266 c              adr32ilbuf=adr32ibuf
1267 c              CALL RESETADLOOKSTACK()
1268 c           ENDIF
1269 c           IF (adr32ilbuf.le.1) THEN
1270 c              CALL LOOKREAL32ARRAY(adr32lbuf, 512)
1271 c              adr32inlbuf = .TRUE.
1272 c              adr32ilbuf = 512
1273 c              x = adr32lbuf(512)
1274 c           ELSE
1275 c              adr32ilbuf = adr32ilbuf-1
1276 c              if (adr32inlbuf) THEN
1277 c                 x = adr32lbuf(adr32ilbuf)
1278 c              ELSE
1279 c                 x = adr32buf(adr32ilbuf)
1280 c              ENDIF
1281 c           ENDIF
1282 c           END
1283 c
1284 c           SUBROUTINE POPREAL32(x)
1285 c           REAL*32 x, adr32buf(512), adr32lbuf(512)
1286 c           INTEGER adr32ibuf,adr32ilbuf
1287 c           LOGICAL adr32inlbuf
1288 c           COMMON /adr32fbuf/adr32buf,adr32lbuf,
1289 c          +       adr32ibuf,adr32ilbuf,adr32inlbuf
1290 c     c
1291 c           IF (adr32ilbuf.ne.-1) THEN
1292 c              adr32ilbuf = -1
1293 c              adr32inlbuf = .FALSE.
1294 c           ENDIF
1295 c           IF (adr32ibuf.le.1) THEN
1296 c              CALL POPREAL32ARRAY(adr32buf, 512)
1297 c              adr32ibuf = 512
1298 c              x = adr32buf(512)
1299 c           ELSE
1300 c              adr32ibuf = adr32ibuf-1
1301 c              x = adr32buf(adr32ibuf)
1302 c           ENDIF
1303 c           END
1304
1305 c======================= COMPLEX*4 =========================
1306 c           BLOCK DATA COMPLEXS4
1307 c           COMPLEX*4 adc4buf(512), adc4lbuf(512)
1308 c           INTEGER adc4ibuf,adc4ilbuf
1309 c           LOGICAL adc4inlbuf
1310 c           COMMON /adc4fbuf/adc4buf,adc4lbuf,
1311 c          +       adc4ibuf,adc4ilbuf,adc4inlbuf
1312 c           DATA adc4ibuf/1/
1313 c           DATA adc4ilbuf/-1/
1314 c           DATA adc4inlbuf/.FALSE./
1315 c           END
1316 c     c
1317 c           SUBROUTINE PUSHCOMPLEX4(x)
1318 c           COMPLEX*4 x, adc4buf(512), adc4lbuf(512)
1319 c           INTEGER adc4ibuf,adc4ilbuf
1320 c           LOGICAL adc4inlbuf
1321 c           COMMON /adc4fbuf/adc4buf,adc4lbuf,
1322 c          +       adc4ibuf,adc4ilbuf,adc4inlbuf
1323 c     c
1324 c           CALL addftraffic(4)
1325 c           IF (adc4ilbuf.ne.-1) THEN
1326 c              adc4ilbuf = -1
1327 c              adc4inlbuf = .FALSE.
1328 c           ENDIF
1329 c           IF (adc4ibuf.ge.512) THEN
1330 c              adc4buf(512) = x
1331 c              CALL PUSHCOMPLEX4ARRAY(adc4buf, 512)
1332 c           CALL addftraffic(-2048)
1333 c              adc4ibuf = 1
1334 c           ELSE
1335 c              adc4buf(adc4ibuf) = x
1336 c              adc4ibuf = adc4ibuf+1
1337 c           ENDIF
1338 c           END
1339 c
1340 c           SUBROUTINE LOOKCOMPLEX4(x)
1341 c           COMPLEX*4 x, adc4buf(512), adc4lbuf(512)
1342 c           INTEGER adc4ibuf,adc4ilbuf
1343 c           LOGICAL adc4inlbuf
1344 c           COMMON /adc4fbuf/adc4buf,adc4lbuf,
1345 c          +       adc4ibuf,adc4ilbuf,adc4inlbuf
1346 c     c
1347 c           IF (adc4ilbuf.eq.-1) THEN
1348 c              adc4ilbuf=adc4ibuf
1349 c              CALL RESETADLOOKSTACK()
1350 c           ENDIF
1351 c           IF (adc4ilbuf.le.1) THEN
1352 c              CALL LOOKCOMPLEX4ARRAY(adc4lbuf, 512)
1353 c              adc4inlbuf = .TRUE.
1354 c              adc4ilbuf = 512
1355 c              x = adc4lbuf(512)
1356 c           ELSE
1357 c              adc4ilbuf = adc4ilbuf-1
1358 c              if (adc4inlbuf) THEN
1359 c                 x = adc4lbuf(adc4ilbuf)
1360 c              ELSE
1361 c                 x = adc4buf(adc4ilbuf)
1362 c              ENDIF
1363 c           ENDIF
1364 c           END
1365 c
1366 c           SUBROUTINE POPCOMPLEX4(x)
1367 c           COMPLEX*4 x, adc4buf(512), adc4lbuf(512)
1368 c           INTEGER adc4ibuf,adc4ilbuf
1369 c           LOGICAL adc4inlbuf
1370 c           COMMON /adc4fbuf/adc4buf,adc4lbuf,
1371 c          +       adc4ibuf,adc4ilbuf,adc4inlbuf
1372 c     c
1373 c           IF (adc4ilbuf.ne.-1) THEN
1374 c              adc4ilbuf = -1
1375 c              adc4inlbuf = .FALSE.
1376 c           ENDIF
1377 c           IF (adc4ibuf.le.1) THEN
1378 c              CALL POPCOMPLEX4ARRAY(adc4buf, 512)
1379 c              adc4ibuf = 512
1380 c              x = adc4buf(512)
1381 c           ELSE
1382 c              adc4ibuf = adc4ibuf-1
1383 c              x = adc4buf(adc4ibuf)
1384 c           ENDIF
1385 c           END
1386
1387 c======================= COMPLEX*32 =========================
1388 c           BLOCK DATA COMPLEXS32
1389 c           COMPLEX*32 adc32buf(512), adc32lbuf(512)
1390 c           INTEGER adc32ibuf,adc32ilbuf
1391 c           LOGICAL adc32inlbuf
1392 c           COMMON /adc32fbuf/adc32buf,adc32lbuf,
1393 c          +       adc32ibuf,adc32ilbuf,adc32inlbuf
1394 c           DATA adc32ibuf/1/
1395 c           DATA adc32ilbuf/-1/
1396 c           DATA adc32inlbuf/.FALSE./
1397 c           END
1398 c     c
1399 c           SUBROUTINE PUSHCOMPLEX32(x)
1400 c           COMPLEX*32 x, adc32buf(512), adc32lbuf(512)
1401 c           INTEGER adc32ibuf,adc32ilbuf
1402 c           LOGICAL adc32inlbuf
1403 c           COMMON /adc32fbuf/adc32buf,adc32lbuf,
1404 c          +       adc32ibuf,adc32ilbuf,adc32inlbuf
1405 c     c
1406 c           CALL addftraffic(32)
1407 c           IF (adc32ilbuf.ne.-1) THEN
1408 c              adc32ilbuf = -1
1409 c              adc32inlbuf = .FALSE.
1410 c           ENDIF
1411 c           IF (adc32ibuf.ge.512) THEN
1412 c              adc32buf(512) = x
1413 c              CALL PUSHCOMPLEX32ARRAY(adc32buf, 512)
1414 c           CALL addftraffic(-16384)
1415 c              adc32ibuf = 1
1416 c           ELSE
1417 c              adc32buf(adc32ibuf) = x
1418 c              adc32ibuf = adc32ibuf+1
1419 c           ENDIF
1420 c           END
1421 c
1422 c           SUBROUTINE LOOKCOMPLEX32(x)
1423 c           COMPLEX*32 x, adc32buf(512), adc32lbuf(512)
1424 c           INTEGER adc32ibuf,adc32ilbuf
1425 c           LOGICAL adc32inlbuf
1426 c           COMMON /adc32fbuf/adc32buf,adc32lbuf,
1427 c          +       adc32ibuf,adc32ilbuf,adc32inlbuf
1428 c     c
1429 c           IF (adc32ilbuf.eq.-1) THEN
1430 c              adc32ilbuf=adc32ibuf
1431 c              CALL RESETADLOOKSTACK()
1432 c           ENDIF
1433 c           IF (adc32ilbuf.le.1) THEN
1434 c              CALL LOOKCOMPLEX32ARRAY(adc32lbuf, 512)
1435 c              adc32inlbuf = .TRUE.
1436 c              adc32ilbuf = 512
1437 c              x = adc32lbuf(512)
1438 c           ELSE
1439 c              adc32ilbuf = adc32ilbuf-1
1440 c              if (adc32inlbuf) THEN
1441 c                 x = adc32lbuf(adc32ilbuf)
1442 c              ELSE
1443 c                 x = adc32buf(adc32ilbuf)
1444 c              ENDIF
1445 c           ENDIF
1446 c           END
1447 c
1448 c           SUBROUTINE POPCOMPLEX32(x)
1449 c           COMPLEX*32 x, adc32buf(512), adc32lbuf(512)
1450 c           INTEGER adc32ibuf,adc32ilbuf
1451 c           LOGICAL adc32inlbuf
1452 c           COMMON /adc32fbuf/adc32buf,adc32lbuf,
1453 c          +       adc32ibuf,adc32ilbuf,adc32inlbuf
1454 c     c
1455 c           IF (adc32ilbuf.ne.-1) THEN
1456 c              adc32ilbuf = -1
1457 c              adc32inlbuf = .FALSE.
1458 c           ENDIF
1459 c           IF (adc32ibuf.le.1) THEN
1460 c              CALL POPCOMPLEX32ARRAY(adc32buf, 512)
1461 c              adc32ibuf = 512
1462 c              x = adc32buf(512)
1463 c           ELSE
1464 c              adc32ibuf = adc32ibuf-1
1465 c              x = adc32buf(adc32ibuf)
1466 c           ENDIF
1467 c           END
1468
1469 C========================================================
1470 C        HOW TO CREATE PUSH* POP* SUBROUTINES
1471 C              YET FOR OTHER DATA TYPES
1472 C ** Duplicate the commented program lines below
1473 c ** In the duplicated subroutines, replace:
1474 c            TTTT by the basic name of the type
1475 c            z9   by the initial and size of the type
1476 c                (integer:i real:r complex:c boolean:b character:s)
1477 c            9    by the size of the type
1478 c ** Uncomment the duplicated subroutines
1479 C ** Don't forget to insert the corresponding lines in
1480 C  subroutine PRINTBUFFERTOP, otherwise these types'
1481 C  contribution to buffer occupation will not be seen.
1482 C  (not very important anyway...)
1483
1484 c======================= TTTT*9 =========================
1485 c           BLOCK DATA TTTTS9
1486 c           TTTT*9 adz9buf(512), adz9lbuf(512)
1487 c           INTEGER adz9ibuf,adz9ilbuf
1488 c           LOGICAL adz9inlbuf
1489 c           COMMON /adz9fbuf/adz9buf,adz9lbuf,
1490 c          +       adz9ibuf,adz9ilbuf,adz9inlbuf
1491 c           DATA adz9ibuf/1/
1492 c           DATA adz9ilbuf/-1/
1493 c           DATA adz9inlbuf/.FALSE./
1494 c           END
1495 c     c
1496 c           SUBROUTINE PUSHTTTT9(x)
1497 c           TTTT*9 x, adz9buf(512), adz9lbuf(512)
1498 c           INTEGER adz9ibuf,adz9ilbuf
1499 c           LOGICAL adz9inlbuf
1500 c           COMMON /adz9fbuf/adz9buf,adz9lbuf,
1501 c          +       adz9ibuf,adz9ilbuf,adz9inlbuf
1502 c     c
1503 c           CALL addftraffic(9)
1504 c           IF (adz9ilbuf.ne.-1) THEN
1505 c              adz9ilbuf = -1
1506 c              adz9inlbuf = .FALSE.
1507 c           ENDIF
1508 c           IF (adz9ibuf.ge.512) THEN
1509 c              adz9buf(512) = x
1510 c              CALL PUSHTTTT9ARRAY(adz9buf, 512)
1511 c           CALL addftraffic(-9*512)
1512 c              adz9ibuf = 1
1513 c           ELSE
1514 c              adz9buf(adz9ibuf) = x
1515 c              adz9ibuf = adz9ibuf+1
1516 c           ENDIF
1517 c           END
1518 c
1519 c           SUBROUTINE LOOKTTTT9(x)
1520 c           TTTT*9 x, adz9buf(512), adz9lbuf(512)
1521 c           INTEGER adz9ibuf,adz9ilbuf
1522 c           LOGICAL adz9inlbuf
1523 c           COMMON /adz9fbuf/adz9buf,adz9lbuf,
1524 c          +       adz9ibuf,adz9ilbuf,adz9inlbuf
1525 c     c
1526 c           IF (adz9ilbuf.eq.-1) THEN
1527 c              adz9ilbuf=adz9ibuf
1528 c              CALL RESETADLOOKSTACK()
1529 c           ENDIF
1530 c           IF (adz9ilbuf.le.1) THEN
1531 c              CALL LOOKTTTT9ARRAY(adz9lbuf, 512)
1532 c              adz9inlbuf = .TRUE.
1533 c              adz9ilbuf = 512
1534 c              x = adz9lbuf(512)
1535 c           ELSE
1536 c              adz9ilbuf = adz9ilbuf-1
1537 c              if (adz9inlbuf) THEN
1538 c                 x = adz9lbuf(adz9ilbuf)
1539 c              ELSE
1540 c                 x = adz9buf(adz9ilbuf)
1541 c              ENDIF
1542 c           ENDIF
1543 c           END
1544 c
1545 c           SUBROUTINE POPTTTT9(x)
1546 c           TTTT*9 x, adz9buf(512), adz9lbuf(512)
1547 c           INTEGER adz9ibuf,adz9ilbuf
1548 c           LOGICAL adz9inlbuf
1549 c           COMMON /adz9fbuf/adz9buf,adz9lbuf,
1550 c          +       adz9ibuf,adz9ilbuf,adz9inlbuf
1551 c     c
1552 c           IF (adz9ilbuf.ne.-1) THEN
1553 c              adz9ilbuf = -1
1554 c              adz9inlbuf = .FALSE.
1555 c           ENDIF
1556 c           IF (adz9ibuf.le.1) THEN
1557 c              CALL POPTTTT9ARRAY(adz9buf, 512)
1558 c              adz9ibuf = 512
1559 c              x = adz9buf(512)
1560 c           ELSE
1561 c              adz9ibuf = adz9ibuf-1
1562 c              x = adz9buf(adz9ibuf)
1563 c           ENDIF
1564 c           END