C$Id: adBuffer.f 3723 2011-02-24 13:34:42Z llh $
c PISTES D'AMELIORATIONS:
c Attention aux IF qui peuvent couter cher.
c On pourrait aussi bufferiser les bits avec N entiers,
c (1 bit par entier), passer tout le paquet a C et laisser
c C faire les jongleries de bitsets.
c On pourrait aussi optimiser en -O3 les primitives de ADFirstAidKit
c Regarder l'assembleur (option -S (et -o toto.s))
c Pourchasser les divisions!
c======================== BITS ==========================:
BLOCK DATA BITS
INTEGER adbitbuf, adbitlbuf
INTEGER adbitibuf, adbitilbuf
LOGICAL adbitinlbuf
COMMON /adbitfbuf/adbitbuf,adbitlbuf,
+ adbitibuf,adbitilbuf,adbitinlbuf
DATA adbitbuf/0/
DATA adbitlbuf/0/
DATA adbitibuf/0/
DATA adbitilbuf/-1/
DATA adbitinlbuf/.FALSE./
END
c [0,31] are the bit indices we can use in an INTEGER
SUBROUTINE PUSHBIT(bit)
LOGICAL bit
INTEGER adbitbuf, adbitlbuf
INTEGER adbitibuf, adbitilbuf
LOGICAL adbitinlbuf
COMMON /adbitfbuf/adbitbuf,adbitlbuf,
+ adbitibuf,adbitilbuf,adbitinlbuf
c
IF (adbitilbuf.ne.-1) THEN
adbitilbuf = -1
adbitinlbuf = .FALSE.
ENDIF
IF (bit) THEN
adbitbuf = IBSET(adbitbuf, adbitibuf)
ELSE
adbitbuf = IBCLR(adbitbuf, adbitibuf)
ENDIF
IF (adbitibuf.ge.31) THEN
CALL PUSHINTEGER4(adbitbuf)
adbitbuf = 0
adbitibuf = 0
ELSE
adbitibuf = adbitibuf+1
ENDIF
END
LOGICAL FUNCTION LOOKBIT()
INTEGER adbitbuf, adbitlbuf
INTEGER adbitibuf, adbitilbuf
LOGICAL adbitinlbuf
COMMON /adbitfbuf/adbitbuf,adbitlbuf,
+ adbitibuf,adbitilbuf,adbitinlbuf
c
IF (adbitilbuf.eq.-1) THEN
adbitilbuf=adbitibuf
adbitlbuf = adbitbuf
ENDIF
IF (adbitilbuf.le.0) THEN
CALL LOOKINTEGER4(adbitlbuf)
adbitilbuf = 31
ELSE
adbitilbuf = adbitilbuf-1
ENDIF
LOOKBIT = BTEST(adbitlbuf, adbitilbuf)
END
LOGICAL FUNCTION POPBIT()
INTEGER adbitbuf, adbitlbuf
INTEGER adbitibuf, adbitilbuf
LOGICAL adbitinlbuf
COMMON /adbitfbuf/adbitbuf,adbitlbuf,
+ adbitibuf,adbitilbuf,adbitinlbuf
c
IF (adbitilbuf.ne.-1) THEN
adbitilbuf = -1
adbitinlbuf = .FALSE.
ENDIF
IF (adbitibuf.le.0) THEN
CALL POPINTEGER4(adbitbuf)
adbitibuf = 31
ELSE
adbitibuf = adbitibuf-1
ENDIF
POPBIT = BTEST(adbitbuf, adbitibuf)
END
c====================== CONTROL =========================:
SUBROUTINE PUSHCONTROL1B(cc)
INTEGER cc
CALL PUSHBIT(cc.ne.0)
END
SUBROUTINE POPCONTROL1B(cc)
INTEGER cc
LOGICAL POPBIT
IF (POPBIT()) THEN
cc = 1
ELSE
cc = 0
ENDIF
END
SUBROUTINE LOOKCONTROL1B(cc)
INTEGER cc
LOGICAL LOOKBIT
IF (LOOKBIT()) THEN
cc = 1
ELSE
cc = 0
ENDIF
END
SUBROUTINE PUSHCONTROL2B(cc)
INTEGER cc
CALL PUSHBIT(BTEST(cc,0))
CALL PUSHBIT(BTEST(cc,1))
END
SUBROUTINE POPCONTROL2B(cc)
INTEGER cc
LOGICAL POPBIT
IF (POPBIT()) THEN
cc = 2
ELSE
cc = 0
ENDIF
IF (POPBIT()) cc = IBSET(cc,0)
END
SUBROUTINE LOOKCONTROL2B(cc)
INTEGER cc
LOGICAL LOOKBIT
IF (LOOKBIT()) THEN
cc = 2
ELSE
cc = 0
ENDIF
IF (LOOKBIT()) cc = IBSET(cc,0)
END
SUBROUTINE PUSHCONTROL3B(cc)
INTEGER cc
CALL PUSHBIT(BTEST(cc,0))
CALL PUSHBIT(BTEST(cc,1))
CALL PUSHBIT(BTEST(cc,2))
END
SUBROUTINE POPCONTROL3B(cc)
INTEGER cc
LOGICAL POPBIT
IF (POPBIT()) THEN
cc = 4
ELSE
cc = 0
ENDIF
IF (POPBIT()) cc = IBSET(cc,1)
IF (POPBIT()) cc = IBSET(cc,0)
END
SUBROUTINE LOOKCONTROL3B(cc)
INTEGER cc
LOGICAL LOOKBIT
IF (LOOKBIT()) THEN
cc = 4
ELSE
cc = 0
ENDIF
IF (LOOKBIT()) cc = IBSET(cc,1)
IF (LOOKBIT()) cc = IBSET(cc,0)
END
SUBROUTINE PUSHCONTROL4B(cc)
INTEGER cc
CALL PUSHBIT(BTEST(cc,0))
CALL PUSHBIT(BTEST(cc,1))
CALL PUSHBIT(BTEST(cc,2))
CALL PUSHBIT(BTEST(cc,3))
END
SUBROUTINE POPCONTROL4B(cc)
INTEGER cc
LOGICAL POPBIT
IF (POPBIT()) THEN
cc = 8
ELSE
cc = 0
ENDIF
IF (POPBIT()) cc = IBSET(cc,2)
IF (POPBIT()) cc = IBSET(cc,1)
IF (POPBIT()) cc = IBSET(cc,0)
END
SUBROUTINE LOOKCONTROL4B(cc)
INTEGER cc
LOGICAL LOOKBIT
IF (LOOKBIT()) THEN
cc = 8
ELSE
cc = 0
ENDIF
IF (LOOKBIT()) cc = IBSET(cc,2)
IF (LOOKBIT()) cc = IBSET(cc,1)
IF (LOOKBIT()) cc = IBSET(cc,0)
END
SUBROUTINE PUSHCONTROL5B(cc)
INTEGER cc
CALL PUSHBIT(BTEST(cc,0))
CALL PUSHBIT(BTEST(cc,1))
CALL PUSHBIT(BTEST(cc,2))
CALL PUSHBIT(BTEST(cc,3))
CALL PUSHBIT(BTEST(cc,4))
END
SUBROUTINE POPCONTROL5B(cc)
INTEGER cc
LOGICAL POPBIT
IF (POPBIT()) THEN
cc = 16
ELSE
cc = 0
ENDIF
IF (POPBIT()) cc = IBSET(cc,3)
IF (POPBIT()) cc = IBSET(cc,2)
IF (POPBIT()) cc = IBSET(cc,1)
IF (POPBIT()) cc = IBSET(cc,0)
END
SUBROUTINE LOOKCONTROL5B(cc)
INTEGER cc
LOGICAL LOOKBIT
IF (LOOKBIT()) THEN
cc = 16
ELSE
cc = 0
ENDIF
IF (LOOKBIT()) cc = IBSET(cc,3)
IF (LOOKBIT()) cc = IBSET(cc,2)
IF (LOOKBIT()) cc = IBSET(cc,1)
IF (LOOKBIT()) cc = IBSET(cc,0)
END
c======================= BOOLEANS =========================
SUBROUTINE PUSHBOOLEAN(x)
LOGICAL x
CALL PUSHBIT(x)
END
SUBROUTINE LOOKBOOLEAN(x)
LOGICAL x, LOOKBIT
x = LOOKBIT()
END
SUBROUTINE POPBOOLEAN(x)
LOGICAL x, POPBIT
x = POPBIT()
END
c===================== CHARACTERS =======================:
BLOCK DATA CHARACTERS
CHARACTER ads1buf(512), ads1lbuf(512)
INTEGER ads1ibuf,ads1ilbuf
LOGICAL ads1inlbuf
COMMON /ads1fbuf/ads1buf,ads1lbuf,
+ ads1ibuf,ads1ilbuf,ads1inlbuf
DATA ads1ibuf/1/
DATA ads1ilbuf/-1/
DATA ads1inlbuf/.FALSE./
END
SUBROUTINE PUSHCHARACTER(x)
CHARACTER x, ads1buf(512), ads1lbuf(512)
INTEGER ads1ibuf,ads1ilbuf
LOGICAL ads1inlbuf
COMMON /ads1fbuf/ads1buf,ads1lbuf,
+ ads1ibuf,ads1ilbuf,ads1inlbuf
c
CALL addftraffic(1)
IF (ads1ilbuf.ne.-1) THEN
ads1ilbuf = -1
ads1inlbuf = .FALSE.
ENDIF
IF (ads1ibuf.ge.512) THEN
ads1buf(512) = x
CALL PUSHCHARACTERARRAY(ads1buf, 512)
CALL addftraffic(-512)
ads1ibuf = 1
ELSE
ads1buf(ads1ibuf) = x
ads1ibuf = ads1ibuf+1
ENDIF
END
SUBROUTINE LOOKCHARACTER(x)
CHARACTER x, ads1buf(512), ads1lbuf(512)
INTEGER ads1ibuf,ads1ilbuf
LOGICAL ads1inlbuf
COMMON /ads1fbuf/ads1buf,ads1lbuf,
+ ads1ibuf,ads1ilbuf,ads1inlbuf
c
IF (ads1ilbuf.eq.-1) THEN
ads1ilbuf=ads1ibuf
CALL RESETADLOOKSTACK()
ENDIF
IF (ads1ilbuf.le.1) THEN
CALL LOOKCHARACTERARRAY(ads1lbuf, 512)
ads1inlbuf = .TRUE.
ads1ilbuf = 512
x = ads1lbuf(512)
ELSE
ads1ilbuf = ads1ilbuf-1
if (ads1inlbuf) THEN
x = ads1lbuf(ads1ilbuf)
ELSE
x = ads1buf(ads1ilbuf)
ENDIF
ENDIF
END
SUBROUTINE POPCHARACTER(x)
CHARACTER x, ads1buf(512), ads1lbuf(512)
INTEGER ads1ibuf,ads1ilbuf
LOGICAL ads1inlbuf
COMMON /ads1fbuf/ads1buf,ads1lbuf,
+ ads1ibuf,ads1ilbuf,ads1inlbuf
c
IF (ads1ilbuf.ne.-1) THEN
ads1ilbuf = -1
ads1inlbuf = .FALSE.
ENDIF
IF (ads1ibuf.le.1) THEN
CALL POPCHARACTERARRAY(ads1buf, 512)
ads1ibuf = 512
x = ads1buf(512)
ELSE
ads1ibuf = ads1ibuf-1
x = ads1buf(ads1ibuf)
ENDIF
END
c======================= INTEGER*4 =========================:
BLOCK DATA INTEGERS4
INTEGER*4 adi4buf(512), adi4lbuf(512)
INTEGER adi4ibuf,adi4ilbuf
LOGICAL adi4inlbuf
COMMON /adi4fbuf/adi4buf,adi4lbuf,
+ adi4ibuf,adi4ilbuf,adi4inlbuf
DATA adi4ibuf/1/
DATA adi4ilbuf/-1/
DATA adi4inlbuf/.FALSE./
END
SUBROUTINE PUSHINTEGER4(x)
INTEGER*4 x, adi4buf(512), adi4lbuf(512)
INTEGER adi4ibuf,adi4ilbuf
LOGICAL adi4inlbuf
COMMON /adi4fbuf/adi4buf,adi4lbuf,
+ adi4ibuf,adi4ilbuf,adi4inlbuf
c
CALL addftraffic(4)
IF (adi4ilbuf.ne.-1) THEN
adi4ilbuf = -1
adi4inlbuf = .FALSE.
ENDIF
IF (adi4ibuf.ge.512) THEN
adi4buf(512) = x
CALL PUSHINTEGER4ARRAY(adi4buf, 512)
CALL addftraffic(-2048)
adi4ibuf = 1
ELSE
adi4buf(adi4ibuf) = x
adi4ibuf = adi4ibuf+1
ENDIF
END
SUBROUTINE LOOKINTEGER4(x)
INTEGER*4 x, adi4buf(512), adi4lbuf(512)
INTEGER adi4ibuf,adi4ilbuf
LOGICAL adi4inlbuf
COMMON /adi4fbuf/adi4buf,adi4lbuf,
+ adi4ibuf,adi4ilbuf,adi4inlbuf
c
IF (adi4ilbuf.eq.-1) THEN
adi4ilbuf=adi4ibuf
CALL RESETADLOOKSTACK()
ENDIF
IF (adi4ilbuf.le.1) THEN
CALL LOOKINTEGER4ARRAY(adi4lbuf, 512)
adi4inlbuf = .TRUE.
adi4ilbuf = 512
x = adi4lbuf(512)
ELSE
adi4ilbuf = adi4ilbuf-1
if (adi4inlbuf) THEN
x = adi4lbuf(adi4ilbuf)
ELSE
x = adi4buf(adi4ilbuf)
ENDIF
ENDIF
END
SUBROUTINE POPINTEGER4(x)
INTEGER*4 x, adi4buf(512), adi4lbuf(512)
INTEGER adi4ibuf,adi4ilbuf
LOGICAL adi4inlbuf
COMMON /adi4fbuf/adi4buf,adi4lbuf,
+ adi4ibuf,adi4ilbuf,adi4inlbuf
c
IF (adi4ilbuf.ne.-1) THEN
adi4ilbuf = -1
adi4inlbuf = .FALSE.
ENDIF
IF (adi4ibuf.le.1) THEN
CALL POPINTEGER4ARRAY(adi4buf, 512)
adi4ibuf = 512
x = adi4buf(512)
ELSE
adi4ibuf = adi4ibuf-1
x = adi4buf(adi4ibuf)
ENDIF
END
c======================= INTEGER*8 =========================
BLOCK DATA INTEGERS8
INTEGER*8 adi8buf(512), adi8lbuf(512)
INTEGER adi8ibuf,adi8ilbuf
LOGICAL adi8inlbuf
COMMON /adi8fbuf/adi8buf,adi8lbuf,
+ adi8ibuf,adi8ilbuf,adi8inlbuf
DATA adi8ibuf/1/
DATA adi8ilbuf/-1/
DATA adi8inlbuf/.FALSE./
END
SUBROUTINE PUSHINTEGER8(x)
INTEGER*8 x, adi8buf(512), adi8lbuf(512)
INTEGER adi8ibuf,adi8ilbuf
LOGICAL adi8inlbuf
COMMON /adi8fbuf/adi8buf,adi8lbuf,
+ adi8ibuf,adi8ilbuf,adi8inlbuf
c
CALL addftraffic(8)
IF (adi8ilbuf.ne.-1) THEN
adi8ilbuf = -1
adi8inlbuf = .FALSE.
ENDIF
IF (adi8ibuf.ge.512) THEN
adi8buf(512) = x
CALL PUSHINTEGER8ARRAY(adi8buf, 512)
CALL addftraffic(-4096)
adi8ibuf = 1
ELSE
adi8buf(adi8ibuf) = x
adi8ibuf = adi8ibuf+1
ENDIF
END
SUBROUTINE LOOKINTEGER8(x)
INTEGER*8 x, adi8buf(512), adi8lbuf(512)
INTEGER adi8ibuf,adi8ilbuf
LOGICAL adi8inlbuf
COMMON /adi8fbuf/adi8buf,adi8lbuf,
+ adi8ibuf,adi8ilbuf,adi8inlbuf
c
IF (adi8ilbuf.eq.-1) THEN
adi8ilbuf=adi8ibuf
CALL RESETADLOOKSTACK()
ENDIF
IF (adi8ilbuf.le.1) THEN
CALL LOOKINTEGER8ARRAY(adi8lbuf, 512)
adi8inlbuf = .TRUE.
adi8ilbuf = 512
x = adi8lbuf(512)
ELSE
adi8ilbuf = adi8ilbuf-1
if (adi8inlbuf) THEN
x = adi8lbuf(adi8ilbuf)
ELSE
x = adi8buf(adi8ilbuf)
ENDIF
ENDIF
END
SUBROUTINE POPINTEGER8(x)
INTEGER*8 x, adi8buf(512), adi8lbuf(512)
INTEGER adi8ibuf,adi8ilbuf
LOGICAL adi8inlbuf
COMMON /adi8fbuf/adi8buf,adi8lbuf,
+ adi8ibuf,adi8ilbuf,adi8inlbuf
c
IF (adi8ilbuf.ne.-1) THEN
adi8ilbuf = -1
adi8inlbuf = .FALSE.
ENDIF
IF (adi8ibuf.le.1) THEN
CALL POPINTEGER8ARRAY(adi8buf, 512)
adi8ibuf = 512
x = adi8buf(512)
ELSE
adi8ibuf = adi8ibuf-1
x = adi8buf(adi8ibuf)
ENDIF
END
c======================= REAL*4 =========================
BLOCK DATA REALS4
REAL*4 adr4buf(512), adr4lbuf(512)
INTEGER adr4ibuf,adr4ilbuf
LOGICAL adr4inlbuf
COMMON /adr4fbuf/adr4buf,adr4lbuf,
+ adr4ibuf,adr4ilbuf,adr4inlbuf
DATA adr4ibuf/1/
DATA adr4ilbuf/-1/
DATA adr4inlbuf/.FALSE./
END
SUBROUTINE PUSHREAL4(x)
REAL*4 x, adr4buf(512), adr4lbuf(512)
INTEGER adr4ibuf,adr4ilbuf
LOGICAL adr4inlbuf
COMMON /adr4fbuf/adr4buf,adr4lbuf,
+ adr4ibuf,adr4ilbuf,adr4inlbuf
c
CALL addftraffic(4)
IF (adr4ilbuf.ne.-1) THEN
adr4ilbuf = -1
adr4inlbuf = .FALSE.
ENDIF
IF (adr4ibuf.ge.512) THEN
adr4buf(512) = x
CALL PUSHREAL4ARRAY(adr4buf, 512)
CALL addftraffic(-2048)
adr4ibuf = 1
ELSE
adr4buf(adr4ibuf) = x
adr4ibuf = adr4ibuf+1
ENDIF
END
SUBROUTINE LOOKREAL4(x)
REAL*4 x, adr4buf(512), adr4lbuf(512)
INTEGER adr4ibuf,adr4ilbuf
LOGICAL adr4inlbuf
COMMON /adr4fbuf/adr4buf,adr4lbuf,
+ adr4ibuf,adr4ilbuf,adr4inlbuf
c
IF (adr4ilbuf.eq.-1) THEN
adr4ilbuf=adr4ibuf
CALL RESETADLOOKSTACK()
ENDIF
IF (adr4ilbuf.le.1) THEN
CALL LOOKREAL4ARRAY(adr4lbuf, 512)
adr4inlbuf = .TRUE.
adr4ilbuf = 512
x = adr4lbuf(512)
ELSE
adr4ilbuf = adr4ilbuf-1
if (adr4inlbuf) THEN
x = adr4lbuf(adr4ilbuf)
ELSE
x = adr4buf(adr4ilbuf)
ENDIF
ENDIF
END
SUBROUTINE POPREAL4(x)
REAL*4 x, adr4buf(512), adr4lbuf(512)
INTEGER adr4ibuf,adr4ilbuf
LOGICAL adr4inlbuf
COMMON /adr4fbuf/adr4buf,adr4lbuf,
+ adr4ibuf,adr4ilbuf,adr4inlbuf
c
IF (adr4ilbuf.ne.-1) THEN
adr4ilbuf = -1
adr4inlbuf = .FALSE.
ENDIF
IF (adr4ibuf.le.1) THEN
CALL POPREAL4ARRAY(adr4buf, 512)
adr4ibuf = 512
x = adr4buf(512)
ELSE
adr4ibuf = adr4ibuf-1
x = adr4buf(adr4ibuf)
ENDIF
END
c======================= REAL*8 =========================
BLOCK DATA REALS8
REAL*8 adr8buf(512), adr8lbuf(512)
INTEGER adr8ibuf,adr8ilbuf
LOGICAL adr8inlbuf
COMMON /adr8fbuf/adr8buf,adr8lbuf,
+ adr8ibuf,adr8ilbuf,adr8inlbuf
DATA adr8ibuf/1/
DATA adr8ilbuf/-1/
DATA adr8inlbuf/.FALSE./
END
SUBROUTINE PUSHREAL8(x)
REAL*8 x, adr8buf(512), adr8lbuf(512)
INTEGER adr8ibuf,adr8ilbuf
LOGICAL adr8inlbuf
COMMON /adr8fbuf/adr8buf,adr8lbuf,
+ adr8ibuf,adr8ilbuf,adr8inlbuf
c
CALL addftraffic(8)
IF (adr8ilbuf.ne.-1) THEN
adr8ilbuf = -1
adr8inlbuf = .FALSE.
ENDIF
IF (adr8ibuf.ge.512) THEN
adr8buf(512) = x
CALL PUSHREAL8ARRAY(adr8buf, 512)
CALL addftraffic(-4096)
adr8ibuf = 1
ELSE
adr8buf(adr8ibuf) = x
adr8ibuf = adr8ibuf+1
ENDIF
END
SUBROUTINE LOOKREAL8(x)
REAL*8 x, adr8buf(512), adr8lbuf(512)
INTEGER adr8ibuf,adr8ilbuf
LOGICAL adr8inlbuf
COMMON /adr8fbuf/adr8buf,adr8lbuf,
+ adr8ibuf,adr8ilbuf,adr8inlbuf
c
IF (adr8ilbuf.eq.-1) THEN
adr8ilbuf=adr8ibuf
CALL RESETADLOOKSTACK()
ENDIF
IF (adr8ilbuf.le.1) THEN
CALL LOOKREAL8ARRAY(adr8lbuf, 512)
adr8inlbuf = .TRUE.
adr8ilbuf = 512
x = adr8lbuf(512)
ELSE
adr8ilbuf = adr8ilbuf-1
if (adr8inlbuf) THEN
x = adr8lbuf(adr8ilbuf)
ELSE
x = adr8buf(adr8ilbuf)
ENDIF
ENDIF
END
SUBROUTINE POPREAL8(x)
REAL*8 x, adr8buf(512), adr8lbuf(512)
INTEGER adr8ibuf,adr8ilbuf
LOGICAL adr8inlbuf
COMMON /adr8fbuf/adr8buf,adr8lbuf,
+ adr8ibuf,adr8ilbuf,adr8inlbuf
c
IF (adr8ilbuf.ne.-1) THEN
adr8ilbuf = -1
adr8inlbuf = .FALSE.
ENDIF
IF (adr8ibuf.le.1) THEN
CALL POPREAL8ARRAY(adr8buf, 512)
adr8ibuf = 512
x = adr8buf(512)
ELSE
adr8ibuf = adr8ibuf-1
x = adr8buf(adr8ibuf)
ENDIF
END
c======================= REAL*16 =========================
BLOCK DATA REALS16
DOUBLE PRECISION adr16buf(512), adr16lbuf(512)
INTEGER adr16ibuf,adr16ilbuf
LOGICAL adr16inlbuf
COMMON /adr16fbuf/adr16buf,adr16lbuf,
+ adr16ibuf,adr16ilbuf,adr16inlbuf
DATA adr16ibuf/1/
DATA adr16ilbuf/-1/
DATA adr16inlbuf/.FALSE./
END
SUBROUTINE PUSHREAL16(x)
DOUBLE PRECISION x, adr16buf(512), adr16lbuf(512)
INTEGER adr16ibuf,adr16ilbuf
LOGICAL adr16inlbuf
COMMON /adr16fbuf/adr16buf,adr16lbuf,
+ adr16ibuf,adr16ilbuf,adr16inlbuf
c
CALL addftraffic(16)
IF (adr16ilbuf.ne.-1) THEN
adr16ilbuf = -1
adr16inlbuf = .FALSE.
ENDIF
IF (adr16ibuf.ge.512) THEN
adr16buf(512) = x
CALL PUSHREAL16ARRAY(adr16buf, 512)
CALL addftraffic(-8192)
adr16ibuf = 1
ELSE
adr16buf(adr16ibuf) = x
adr16ibuf = adr16ibuf+1
ENDIF
END
SUBROUTINE LOOKREAL16(x)
DOUBLE PRECISION x, adr16buf(512), adr16lbuf(512)
INTEGER adr16ibuf,adr16ilbuf
LOGICAL adr16inlbuf
COMMON /adr16fbuf/adr16buf,adr16lbuf,
+ adr16ibuf,adr16ilbuf,adr16inlbuf
c
IF (adr16ilbuf.eq.-1) THEN
adr16ilbuf=adr16ibuf
CALL RESETADLOOKSTACK()
ENDIF
IF (adr16ilbuf.le.1) THEN
CALL LOOKREAL16ARRAY(adr16lbuf, 512)
adr16inlbuf = .TRUE.
adr16ilbuf = 512
x = adr16lbuf(512)
ELSE
adr16ilbuf = adr16ilbuf-1
if (adr16inlbuf) THEN
x = adr16lbuf(adr16ilbuf)
ELSE
x = adr16buf(adr16ilbuf)
ENDIF
ENDIF
END
SUBROUTINE POPREAL16(x)
DOUBLE PRECISION x, adr16buf(512), adr16lbuf(512)
INTEGER adr16ibuf,adr16ilbuf
LOGICAL adr16inlbuf
COMMON /adr16fbuf/adr16buf,adr16lbuf,
+ adr16ibuf,adr16ilbuf,adr16inlbuf
c
IF (adr16ilbuf.ne.-1) THEN
adr16ilbuf = -1
adr16inlbuf = .FALSE.
ENDIF
IF (adr16ibuf.le.1) THEN
CALL POPREAL16ARRAY(adr16buf, 512)
adr16ibuf = 512
x = adr16buf(512)
ELSE
adr16ibuf = adr16ibuf-1
x = adr16buf(adr16ibuf)
ENDIF
END
c======================= COMPLEX*8 =========================
BLOCK DATA COMPLEXS8
COMPLEX*8 adc8buf(512), adc8lbuf(512)
INTEGER adc8ibuf,adc8ilbuf
LOGICAL adc8inlbuf
COMMON /adc8fbuf/adc8buf,adc8lbuf,
+ adc8ibuf,adc8ilbuf,adc8inlbuf
DATA adc8ibuf/1/
DATA adc8ilbuf/-1/
DATA adc8inlbuf/.FALSE./
END
SUBROUTINE PUSHCOMPLEX8(x)
COMPLEX*8 x, adc8buf(512), adc8lbuf(512)
INTEGER adc8ibuf,adc8ilbuf
LOGICAL adc8inlbuf
COMMON /adc8fbuf/adc8buf,adc8lbuf,
+ adc8ibuf,adc8ilbuf,adc8inlbuf
c
CALL addftraffic(8)
IF (adc8ilbuf.ne.-1) THEN
adc8ilbuf = -1
adc8inlbuf = .FALSE.
ENDIF
IF (adc8ibuf.ge.512) THEN
adc8buf(512) = x
CALL PUSHCOMPLEX8ARRAY(adc8buf, 512)
CALL addftraffic(-4096)
adc8ibuf = 1
ELSE
adc8buf(adc8ibuf) = x
adc8ibuf = adc8ibuf+1
ENDIF
END
SUBROUTINE LOOKCOMPLEX8(x)
COMPLEX*8 x, adc8buf(512), adc8lbuf(512)
INTEGER adc8ibuf,adc8ilbuf
LOGICAL adc8inlbuf
COMMON /adc8fbuf/adc8buf,adc8lbuf,
+ adc8ibuf,adc8ilbuf,adc8inlbuf
c
IF (adc8ilbuf.eq.-1) THEN
adc8ilbuf=adc8ibuf
CALL RESETADLOOKSTACK()
ENDIF
IF (adc8ilbuf.le.1) THEN
CALL LOOKCOMPLEX8ARRAY(adc8lbuf, 512)
adc8inlbuf = .TRUE.
adc8ilbuf = 512
x = adc8lbuf(512)
ELSE
adc8ilbuf = adc8ilbuf-1
if (adc8inlbuf) THEN
x = adc8lbuf(adc8ilbuf)
ELSE
x = adc8buf(adc8ilbuf)
ENDIF
ENDIF
END
SUBROUTINE POPCOMPLEX8(x)
COMPLEX*8 x, adc8buf(512), adc8lbuf(512)
INTEGER adc8ibuf,adc8ilbuf
LOGICAL adc8inlbuf
COMMON /adc8fbuf/adc8buf,adc8lbuf,
+ adc8ibuf,adc8ilbuf,adc8inlbuf
c
IF (adc8ilbuf.ne.-1) THEN
adc8ilbuf = -1
adc8inlbuf = .FALSE.
ENDIF
IF (adc8ibuf.le.1) THEN
CALL POPCOMPLEX8ARRAY(adc8buf, 512)
adc8ibuf = 512
x = adc8buf(512)
ELSE
adc8ibuf = adc8ibuf-1
x = adc8buf(adc8ibuf)
ENDIF
END
c======================= COMPLEX*16 =========================
BLOCK DATA COMPLEXS16
COMPLEX*16 adc16buf(512), adc16lbuf(512)
INTEGER adc16ibuf,adc16ilbuf
LOGICAL adc16inlbuf
COMMON /adc16fbuf/adc16buf,adc16lbuf,
+ adc16ibuf,adc16ilbuf,adc16inlbuf
DATA adc16ibuf/1/
DATA adc16ilbuf/-1/
DATA adc16inlbuf/.FALSE./
END
SUBROUTINE PUSHCOMPLEX16(x)
COMPLEX*16 x, adc16buf(512), adc16lbuf(512)
INTEGER adc16ibuf,adc16ilbuf
LOGICAL adc16inlbuf
COMMON /adc16fbuf/adc16buf,adc16lbuf,
+ adc16ibuf,adc16ilbuf,adc16inlbuf
c
CALL addftraffic(16)
IF (adc16ilbuf.ne.-1) THEN
adc16ilbuf = -1
adc16inlbuf = .FALSE.
ENDIF
IF (adc16ibuf.ge.512) THEN
adc16buf(512) = x
CALL PUSHCOMPLEX16ARRAY(adc16buf, 512)
CALL addftraffic(-8192)
adc16ibuf = 1
ELSE
adc16buf(adc16ibuf) = x
adc16ibuf = adc16ibuf+1
ENDIF
END
SUBROUTINE LOOKCOMPLEX16(x)
COMPLEX*16 x, adc16buf(512), adc16lbuf(512)
INTEGER adc16ibuf,adc16ilbuf
LOGICAL adc16inlbuf
COMMON /adc16fbuf/adc16buf,adc16lbuf,
+ adc16ibuf,adc16ilbuf,adc16inlbuf
c
IF (adc16ilbuf.eq.-1) THEN
adc16ilbuf=adc16ibuf
CALL RESETADLOOKSTACK()
ENDIF
IF (adc16ilbuf.le.1) THEN
CALL LOOKCOMPLEX16ARRAY(adc16lbuf, 512)
adc16inlbuf = .TRUE.
adc16ilbuf = 512
x = adc16lbuf(512)
ELSE
adc16ilbuf = adc16ilbuf-1
if (adc16inlbuf) THEN
x = adc16lbuf(adc16ilbuf)
ELSE
x = adc16buf(adc16ilbuf)
ENDIF
ENDIF
END
SUBROUTINE POPCOMPLEX16(x)
COMPLEX*16 x, adc16buf(512), adc16lbuf(512)
INTEGER adc16ibuf,adc16ilbuf
LOGICAL adc16inlbuf
COMMON /adc16fbuf/adc16buf,adc16lbuf,
+ adc16ibuf,adc16ilbuf,adc16inlbuf
c
IF (adc16ilbuf.ne.-1) THEN
adc16ilbuf = -1
adc16inlbuf = .FALSE.
ENDIF
IF (adc16ibuf.le.1) THEN
CALL POPCOMPLEX16ARRAY(adc16buf, 512)
adc16ibuf = 512
x = adc16buf(512)
ELSE
adc16ibuf = adc16ibuf-1
x = adc16buf(adc16ibuf)
ENDIF
END
C=========== MEASUREMENT OF PUSH/POP TRAFFIC ==========
BLOCK DATA MEMTRAFFIC
INTEGER*8 mmftraffic,mmftrafficM
COMMON /mmcomtraffic/mmftraffic,mmftrafficM
DATA mmftraffic/0/
DATA mmftrafficM/0/
END
subroutine addftraffic(n)
INTEGER n
INTEGER*8 mmftraffic,mmftrafficM
COMMON /mmcomtraffic/mmftraffic,mmftrafficM
c
mmftraffic = mmftraffic+n
if (mmftraffic.ge.1000000) then
100 mmftraffic = mmftraffic-1000000
mmftrafficM = mmftrafficM+1
if (mmftraffic.ge.1000000) then
goto 100
else
goto 300
endif
else if (mmftraffic.lt.0) then
200 mmftraffic = mmftraffic+1000000
mmftrafficM = mmftrafficM-1
if (mmftraffic.lt.0) then
goto 200
else
goto 300
endif
endif
300 continue
END
SUBROUTINE PRINTTRAFFIC()
INTEGER*8 mmftraffic,mmftrafficM
COMMON /mmcomtraffic/mmftraffic,mmftrafficM
CALL printctraffic()
CALL printftrafficinc(mmftrafficM, 1000000, mmftraffic)
c write (6,1001) ' F Traffic: ',mmftrafficM,' Mb and ',
c + (((mmftraffic*1000)/1024)*1000)/1024, ' millionths'
c 1001 format(a,i6,a,i6,a)
END
C ============ PRINTING THE SIZE OF STACKS AND BUFFERS ==========
SUBROUTINE PRINTBUFFERTOP()
integer*4 SMALLSTACKSIZE
integer*4 size
size = SMALLSTACKSIZE()
print *,'Buffer size:',size,' bytes i.e. ',size/1024.0,' Kbytes'
END
FUNCTION SMALLSTACKSIZE()
CHARACTER ads1buf(512), ads1lbuf(512)
INTEGER ads1ibuf,ads1ilbuf
LOGICAL ads1inlbuf
COMMON /ads1fbuf/ads1buf,ads1lbuf,
+ ads1ibuf,ads1ilbuf,ads1inlbuf
c LOGICAL adl4buf(512), adl4lbuf(512)
c INTEGER adl4ibuf,adl4ilbuf
c LOGICAL adl4inlbuf
c COMMON /adl4fbuf/adl4buf,adl4lbuf,
c + adl4ibuf,adl4ilbuf,adl4inlbuf
INTEGER*4 adi4buf(512), adi4lbuf(512)
INTEGER adi4ibuf,adi4ilbuf
LOGICAL adi4inlbuf
COMMON /adi4fbuf/adi4buf,adi4lbuf,
+ adi4ibuf,adi4ilbuf,adi4inlbuf
INTEGER*8 adi8buf(512), adi8lbuf(512)
INTEGER adi8ibuf,adi8ilbuf
LOGICAL adi8inlbuf
COMMON /adi8fbuf/adi8buf,adi8lbuf,
+ adi8ibuf,adi8ilbuf,adi8inlbuf
c INTEGER*16 adi16buf(512), adi16lbuf(512)
c INTEGER adi16ibuf,adi16ilbuf
c LOGICAL adi16inlbuf
c COMMON /adi16fbuf/adi16buf,adi16lbuf,
c + adi16ibuf,adi16ilbuf,adi16inlbuf
REAL*4 adr4buf(512), adr4lbuf(512)
INTEGER adr4ibuf,adr4ilbuf
LOGICAL adr4inlbuf
COMMON /adr4fbuf/adr4buf,adr4lbuf,
+ adr4ibuf,adr4ilbuf,adr4inlbuf
REAL*8 adr8buf(512), adr8lbuf(512)
INTEGER adr8ibuf,adr8ilbuf
LOGICAL adr8inlbuf
COMMON /adr8fbuf/adr8buf,adr8lbuf,
+ adr8ibuf,adr8ilbuf,adr8inlbuf
DOUBLE PRECISION adr16buf(512), adr16lbuf(512)
INTEGER adr16ibuf,adr16ilbuf
LOGICAL adr16inlbuf
COMMON /adr16fbuf/adr16buf,adr16lbuf,
+ adr16ibuf,adr16ilbuf,adr16inlbuf
c REAL*32 x, adr32buf(512), adr32lbuf(512)
c INTEGER adr32ibuf,adr32ilbuf
c LOGICAL adr32inlbuf
c COMMON /adr32fbuf/adr32buf,adr32lbuf,
c + adr32ibuf,adr32ilbuf,adr32inlbuf
c COMPLEX*4 adc4buf(512), adc4lbuf(512)
c INTEGER adc4ibuf,adc4ilbuf
c LOGICAL adc4inlbuf
c COMMON /adc4fbuf/adc4buf,adc4lbuf,
c + adc4ibuf,adc4ilbuf,adc4inlbuf
COMPLEX*8 adc8buf(512), adc8lbuf(512)
INTEGER adc8ibuf,adc8ilbuf
LOGICAL adc8inlbuf
COMMON /adc8fbuf/adc8buf,adc8lbuf,
+ adc8ibuf,adc8ilbuf,adc8inlbuf
COMPLEX*16 adc16buf(512), adc16lbuf(512)
INTEGER adc16ibuf,adc16ilbuf
LOGICAL adc16inlbuf
COMMON /adc16fbuf/adc16buf,adc16lbuf,
+ adc16ibuf,adc16ilbuf,adc16inlbuf
c COMPLEX*32 adc32buf(512), adc32lbuf(512)
c INTEGER adc32ibuf,adc32ilbuf
c LOGICAL adc32inlbuf
c COMMON /adc32fbuf/adc32buf,adc32lbuf,
c + adc32ibuf,adc32ilbuf,adc32inlbuf
integer*4 smallstacksize
c
smallstacksize = 0
smallstacksize = smallstacksize + (ads1ibuf-1)*1
c smallstacksize = smallstacksize + (adl4ibuf-1)*4
smallstacksize = smallstacksize + (adi4ibuf-1)*4
smallstacksize = smallstacksize + (adi8ibuf-1)*8
c smallstacksize = smallstacksize + (adi16ibuf-1)*16
smallstacksize = smallstacksize + (adr4ibuf-1)*4
smallstacksize = smallstacksize + (adr8ibuf-1)*8
smallstacksize = smallstacksize + (adr16ibuf-1)*16
c smallstacksize = smallstacksize + (adr32ibuf-1)*32
c smallstacksize = smallstacksize + (adc4ibuf-1)*4
smallstacksize = smallstacksize + (adc8ibuf-1)*8
smallstacksize = smallstacksize + (adc16ibuf-1)*16
c smallstacksize = smallstacksize + (adc32ibuf-1)*32
c
end
C FOR INTERNAL DEBUGS ONLY:
SUBROUTINE SHOWALLSTACKS()
INTEGER adbitbuf, adbitlbuf
INTEGER adbitibuf, adbitilbuf
LOGICAL adbitinlbuf
COMMON /adbitfbuf/adbitbuf,adbitlbuf,
+ adbitibuf,adbitilbuf,adbitinlbuf
CHARACTER ads1buf(512), ads1lbuf(512)
INTEGER ads1ibuf,ads1ilbuf
LOGICAL ads1inlbuf
COMMON /ads1fbuf/ads1buf,ads1lbuf,
+ ads1ibuf,ads1ilbuf,ads1inlbuf
INTEGER*4 adi4buf(512), adi4lbuf(512)
INTEGER adi4ibuf,adi4ilbuf
LOGICAL adi4inlbuf
COMMON /adi4fbuf/adi4buf,adi4lbuf,
+ adi4ibuf,adi4ilbuf,adi4inlbuf
INTEGER*8 adi8buf(512), adi8lbuf(512)
INTEGER adi8ibuf,adi8ilbuf
LOGICAL adi8inlbuf
COMMON /adi8fbuf/adi8buf,adi8lbuf,
+ adi8ibuf,adi8ilbuf,adi8inlbuf
REAL*4 adr4buf(512), adr4lbuf(512)
INTEGER adr4ibuf,adr4ilbuf
LOGICAL adr4inlbuf
COMMON /adr4fbuf/adr4buf,adr4lbuf,
+ adr4ibuf,adr4ilbuf,adr4inlbuf
REAL*8 adr8buf(512), adr8lbuf(512)
INTEGER adr8ibuf,adr8ilbuf
LOGICAL adr8inlbuf
COMMON /adr8fbuf/adr8buf,adr8lbuf,
+ adr8ibuf,adr8ilbuf,adr8inlbuf
DOUBLE PRECISION adr16buf(512), adr16lbuf(512)
INTEGER adr16ibuf,adr16ilbuf
LOGICAL adr16inlbuf
COMMON /adr16fbuf/adr16buf,adr16lbuf,
+ adr16ibuf,adr16ilbuf,adr16inlbuf
COMPLEX*8 adc8buf(512), adc8lbuf(512)
INTEGER adc8ibuf,adc8ilbuf
LOGICAL adc8inlbuf
COMMON /adc8fbuf/adc8buf,adc8lbuf,
+ adc8ibuf,adc8ilbuf,adc8inlbuf
COMPLEX*16 adc16buf(512), adc16lbuf(512)
INTEGER adc16ibuf,adc16ilbuf
LOGICAL adc16inlbuf
COMMON /adc16fbuf/adc16buf,adc16lbuf,
+ adc16ibuf,adc16ilbuf,adc16inlbuf
INTEGER i
c
write (6,1010) 'BIT STACK : ',adbitbuf,'==',adbitbuf,
+ ' (',adbitibuf,')'
1010 format(a,i20,a,z16,a,i2,a)
write (6,1011) 'INTEGER*8 BUFFER[',adi8ibuf-1,']: ',
+ (adi8buf(i),i=1,adi8ibuf-1)
write (6,1011) 'INTEGER*4 BUFFER[',adi4ibuf-1,']: ',
+ (adi4buf(i),i=1,adi4ibuf-1)
1011 format(a,i3,a,512(i40))
write (6,1012) 'REAL*16 BUFFER:[',adr16ibuf-1,']: ',
+ (adr16buf(i),i=1,adr16ibuf-1)
write (6,1012) 'REAL*8 BUFFER:[',adr8ibuf-1, ']: ',
+ (adr8buf(i),i=1,adr8ibuf-1)
write (6,1012) 'REAL*4 BUFFER:[',adr4ibuf-1, ']: ',
+ (adr4buf(i),i=1,adr4ibuf-1)
1012 format(a,512(e10.2))
call showrecentcstack()
c
END
C========================================================
C PUSH* POP* SUBROUTINES FOR OTHER DATA TYPES
C Uncomment if these types are available on your compiler
C and they are needed by the reverse differentiated code
C Don't forget to uncomment the corresponding lines in
C subroutine PRINTBUFFERTOP, otherwise these types'
C contribution to buffer occupation will not be seen.
C (not very important anyway...)
c======================= INTEGER*16 =========================
c BLOCK DATA INTEGERS16
c INTEGER*16 adi16buf(512), adi16lbuf(512)
c INTEGER adi16ibuf,adi16ilbuf
c LOGICAL adi16inlbuf
c COMMON /adi16fbuf/adi16buf,adi16lbuf,
c + adi16ibuf,adi16ilbuf,adi16inlbuf
c DATA adi16ibuf/1/
c DATA adi16ilbuf/-1/
c DATA adi16inlbuf/.FALSE./
c END
c c
c SUBROUTINE PUSHINTEGER16(x)
c INTEGER*16 x, adi16buf(512), adi16lbuf(512)
c INTEGER adi16ibuf,adi16ilbuf
c LOGICAL adi16inlbuf
c COMMON /adi16fbuf/adi16buf,adi16lbuf,
c + adi16ibuf,adi16ilbuf,adi16inlbuf
c c
c CALL addftraffic(16)
c IF (adi16ilbuf.ne.-1) THEN
c adi16ilbuf = -1
c adi16inlbuf = .FALSE.
c ENDIF
c IF (adi16ibuf.ge.512) THEN
c adi16buf(512) = x
c CALL PUSHINTEGER16ARRAY(adi16buf, 512)
c CALL addftraffic(-8192)
c adi16ibuf = 1
c ELSE
c adi16buf(adi16ibuf) = x
c adi16ibuf = adi16ibuf+1
c ENDIF
c END
c
c SUBROUTINE LOOKINTEGER16(x)
c INTEGER*16 x, adi16buf(512), adi16lbuf(512)
c INTEGER adi16ibuf,adi16ilbuf
c LOGICAL adi16inlbuf
c COMMON /adi16fbuf/adi16buf,adi16lbuf,
c + adi16ibuf,adi16ilbuf,adi16inlbuf
c c
c IF (adi16ilbuf.eq.-1) THEN
c adi16ilbuf=adi16ibuf
c CALL RESETADLOOKSTACK()
c ENDIF
c IF (adi16ilbuf.le.1) THEN
c CALL LOOKINTEGER16ARRAY(adi16lbuf, 512)
c adi16inlbuf = .TRUE.
c adi16ilbuf = 512
c x = adi16lbuf(512)
c ELSE
c adi16ilbuf = adi16ilbuf-1
c if (adi16inlbuf) THEN
c x = adi16lbuf(adi16ilbuf)
c ELSE
c x = adi16buf(adi16ilbuf)
c ENDIF
c ENDIF
c END
c
c SUBROUTINE POPINTEGER16(x)
c INTEGER*16 x, adi16buf(512), adi16lbuf(512)
c INTEGER adi16ibuf,adi16ilbuf
c LOGICAL adi16inlbuf
c COMMON /adi16fbuf/adi16buf,adi16lbuf,
c + adi16ibuf,adi16ilbuf,adi16inlbuf
c c
c IF (adi16ilbuf.ne.-1) THEN
c adi16ilbuf = -1
c adi16inlbuf = .FALSE.
c ENDIF
c IF (adi16ibuf.le.1) THEN
c CALL POPINTEGER16ARRAY(adi16buf, 512)
c adi16ibuf = 512
c x = adi16buf(512)
c ELSE
c adi16ibuf = adi16ibuf-1
c x = adi16buf(adi16ibuf)
c ENDIF
c END
c======================= REAL*32 =========================
c BLOCK DATA REALS32
c REAL*32 adr32buf(512), adr32lbuf(512)
c INTEGER adr32ibuf,adr32ilbuf
c LOGICAL adr32inlbuf
c COMMON /adr32fbuf/adr32buf,adr32lbuf,
c + adr32ibuf,adr32ilbuf,adr32inlbuf
c DATA adr32ibuf/1/
c DATA adr32ilbuf/-1/
c DATA adr32inlbuf/.FALSE./
c END
c c
c SUBROUTINE PUSHREAL32(x)
c REAL*32 x, adr32buf(512), adr32lbuf(512)
c INTEGER adr32ibuf,adr32ilbuf
c LOGICAL adr32inlbuf
c COMMON /adr32fbuf/adr32buf,adr32lbuf,
c + adr32ibuf,adr32ilbuf,adr32inlbuf
c c
c CALL addftraffic(32)
c IF (adr32ilbuf.ne.-1) THEN
c adr32ilbuf = -1
c adr32inlbuf = .FALSE.
c ENDIF
c IF (adr32ibuf.ge.512) THEN
c adr32buf(512) = x
c CALL PUSHREAL32ARRAY(adr32buf, 512)
c CALL addftraffic(-16384)
c adr32ibuf = 1
c ELSE
c adr32buf(adr32ibuf) = x
c adr32ibuf = adr32ibuf+1
c ENDIF
c END
c
c SUBROUTINE LOOKREAL32(x)
c REAL*32 x, adr32buf(512), adr32lbuf(512)
c INTEGER adr32ibuf,adr32ilbuf
c LOGICAL adr32inlbuf
c COMMON /adr32fbuf/adr32buf,adr32lbuf,
c + adr32ibuf,adr32ilbuf,adr32inlbuf
c c
c IF (adr32ilbuf.eq.-1) THEN
c adr32ilbuf=adr32ibuf
c CALL RESETADLOOKSTACK()
c ENDIF
c IF (adr32ilbuf.le.1) THEN
c CALL LOOKREAL32ARRAY(adr32lbuf, 512)
c adr32inlbuf = .TRUE.
c adr32ilbuf = 512
c x = adr32lbuf(512)
c ELSE
c adr32ilbuf = adr32ilbuf-1
c if (adr32inlbuf) THEN
c x = adr32lbuf(adr32ilbuf)
c ELSE
c x = adr32buf(adr32ilbuf)
c ENDIF
c ENDIF
c END
c
c SUBROUTINE POPREAL32(x)
c REAL*32 x, adr32buf(512), adr32lbuf(512)
c INTEGER adr32ibuf,adr32ilbuf
c LOGICAL adr32inlbuf
c COMMON /adr32fbuf/adr32buf,adr32lbuf,
c + adr32ibuf,adr32ilbuf,adr32inlbuf
c c
c IF (adr32ilbuf.ne.-1) THEN
c adr32ilbuf = -1
c adr32inlbuf = .FALSE.
c ENDIF
c IF (adr32ibuf.le.1) THEN
c CALL POPREAL32ARRAY(adr32buf, 512)
c adr32ibuf = 512
c x = adr32buf(512)
c ELSE
c adr32ibuf = adr32ibuf-1
c x = adr32buf(adr32ibuf)
c ENDIF
c END
c======================= COMPLEX*4 =========================
c BLOCK DATA COMPLEXS4
c COMPLEX*4 adc4buf(512), adc4lbuf(512)
c INTEGER adc4ibuf,adc4ilbuf
c LOGICAL adc4inlbuf
c COMMON /adc4fbuf/adc4buf,adc4lbuf,
c + adc4ibuf,adc4ilbuf,adc4inlbuf
c DATA adc4ibuf/1/
c DATA adc4ilbuf/-1/
c DATA adc4inlbuf/.FALSE./
c END
c c
c SUBROUTINE PUSHCOMPLEX4(x)
c COMPLEX*4 x, adc4buf(512), adc4lbuf(512)
c INTEGER adc4ibuf,adc4ilbuf
c LOGICAL adc4inlbuf
c COMMON /adc4fbuf/adc4buf,adc4lbuf,
c + adc4ibuf,adc4ilbuf,adc4inlbuf
c c
c CALL addftraffic(4)
c IF (adc4ilbuf.ne.-1) THEN
c adc4ilbuf = -1
c adc4inlbuf = .FALSE.
c ENDIF
c IF (adc4ibuf.ge.512) THEN
c adc4buf(512) = x
c CALL PUSHCOMPLEX4ARRAY(adc4buf, 512)
c CALL addftraffic(-2048)
c adc4ibuf = 1
c ELSE
c adc4buf(adc4ibuf) = x
c adc4ibuf = adc4ibuf+1
c ENDIF
c END
c
c SUBROUTINE LOOKCOMPLEX4(x)
c COMPLEX*4 x, adc4buf(512), adc4lbuf(512)
c INTEGER adc4ibuf,adc4ilbuf
c LOGICAL adc4inlbuf
c COMMON /adc4fbuf/adc4buf,adc4lbuf,
c + adc4ibuf,adc4ilbuf,adc4inlbuf
c c
c IF (adc4ilbuf.eq.-1) THEN
c adc4ilbuf=adc4ibuf
c CALL RESETADLOOKSTACK()
c ENDIF
c IF (adc4ilbuf.le.1) THEN
c CALL LOOKCOMPLEX4ARRAY(adc4lbuf, 512)
c adc4inlbuf = .TRUE.
c adc4ilbuf = 512
c x = adc4lbuf(512)
c ELSE
c adc4ilbuf = adc4ilbuf-1
c if (adc4inlbuf) THEN
c x = adc4lbuf(adc4ilbuf)
c ELSE
c x = adc4buf(adc4ilbuf)
c ENDIF
c ENDIF
c END
c
c SUBROUTINE POPCOMPLEX4(x)
c COMPLEX*4 x, adc4buf(512), adc4lbuf(512)
c INTEGER adc4ibuf,adc4ilbuf
c LOGICAL adc4inlbuf
c COMMON /adc4fbuf/adc4buf,adc4lbuf,
c + adc4ibuf,adc4ilbuf,adc4inlbuf
c c
c IF (adc4ilbuf.ne.-1) THEN
c adc4ilbuf = -1
c adc4inlbuf = .FALSE.
c ENDIF
c IF (adc4ibuf.le.1) THEN
c CALL POPCOMPLEX4ARRAY(adc4buf, 512)
c adc4ibuf = 512
c x = adc4buf(512)
c ELSE
c adc4ibuf = adc4ibuf-1
c x = adc4buf(adc4ibuf)
c ENDIF
c END
c======================= COMPLEX*32 =========================
c BLOCK DATA COMPLEXS32
c COMPLEX*32 adc32buf(512), adc32lbuf(512)
c INTEGER adc32ibuf,adc32ilbuf
c LOGICAL adc32inlbuf
c COMMON /adc32fbuf/adc32buf,adc32lbuf,
c + adc32ibuf,adc32ilbuf,adc32inlbuf
c DATA adc32ibuf/1/
c DATA adc32ilbuf/-1/
c DATA adc32inlbuf/.FALSE./
c END
c c
c SUBROUTINE PUSHCOMPLEX32(x)
c COMPLEX*32 x, adc32buf(512), adc32lbuf(512)
c INTEGER adc32ibuf,adc32ilbuf
c LOGICAL adc32inlbuf
c COMMON /adc32fbuf/adc32buf,adc32lbuf,
c + adc32ibuf,adc32ilbuf,adc32inlbuf
c c
c CALL addftraffic(32)
c IF (adc32ilbuf.ne.-1) THEN
c adc32ilbuf = -1
c adc32inlbuf = .FALSE.
c ENDIF
c IF (adc32ibuf.ge.512) THEN
c adc32buf(512) = x
c CALL PUSHCOMPLEX32ARRAY(adc32buf, 512)
c CALL addftraffic(-16384)
c adc32ibuf = 1
c ELSE
c adc32buf(adc32ibuf) = x
c adc32ibuf = adc32ibuf+1
c ENDIF
c END
c
c SUBROUTINE LOOKCOMPLEX32(x)
c COMPLEX*32 x, adc32buf(512), adc32lbuf(512)
c INTEGER adc32ibuf,adc32ilbuf
c LOGICAL adc32inlbuf
c COMMON /adc32fbuf/adc32buf,adc32lbuf,
c + adc32ibuf,adc32ilbuf,adc32inlbuf
c c
c IF (adc32ilbuf.eq.-1) THEN
c adc32ilbuf=adc32ibuf
c CALL RESETADLOOKSTACK()
c ENDIF
c IF (adc32ilbuf.le.1) THEN
c CALL LOOKCOMPLEX32ARRAY(adc32lbuf, 512)
c adc32inlbuf = .TRUE.
c adc32ilbuf = 512
c x = adc32lbuf(512)
c ELSE
c adc32ilbuf = adc32ilbuf-1
c if (adc32inlbuf) THEN
c x = adc32lbuf(adc32ilbuf)
c ELSE
c x = adc32buf(adc32ilbuf)
c ENDIF
c ENDIF
c END
c
c SUBROUTINE POPCOMPLEX32(x)
c COMPLEX*32 x, adc32buf(512), adc32lbuf(512)
c INTEGER adc32ibuf,adc32ilbuf
c LOGICAL adc32inlbuf
c COMMON /adc32fbuf/adc32buf,adc32lbuf,
c + adc32ibuf,adc32ilbuf,adc32inlbuf
c c
c IF (adc32ilbuf.ne.-1) THEN
c adc32ilbuf = -1
c adc32inlbuf = .FALSE.
c ENDIF
c IF (adc32ibuf.le.1) THEN
c CALL POPCOMPLEX32ARRAY(adc32buf, 512)
c adc32ibuf = 512
c x = adc32buf(512)
c ELSE
c adc32ibuf = adc32ibuf-1
c x = adc32buf(adc32ibuf)
c ENDIF
c END
C========================================================
C HOW TO CREATE PUSH* POP* SUBROUTINES
C YET FOR OTHER DATA TYPES
C ** Duplicate the commented program lines below
c ** In the duplicated subroutines, replace:
c TTTT by the basic name of the type
c z9 by the initial and size of the type
c (integer:i real:r complex:c boolean:b character:s)
c 9 by the size of the type
c ** Uncomment the duplicated subroutines
C ** Don't forget to insert the corresponding lines in
C subroutine PRINTBUFFERTOP, otherwise these types'
C contribution to buffer occupation will not be seen.
C (not very important anyway...)
c======================= TTTT*9 =========================
c BLOCK DATA TTTTS9
c TTTT*9 adz9buf(512), adz9lbuf(512)
c INTEGER adz9ibuf,adz9ilbuf
c LOGICAL adz9inlbuf
c COMMON /adz9fbuf/adz9buf,adz9lbuf,
c + adz9ibuf,adz9ilbuf,adz9inlbuf
c DATA adz9ibuf/1/
c DATA adz9ilbuf/-1/
c DATA adz9inlbuf/.FALSE./
c END
c c
c SUBROUTINE PUSHTTTT9(x)
c TTTT*9 x, adz9buf(512), adz9lbuf(512)
c INTEGER adz9ibuf,adz9ilbuf
c LOGICAL adz9inlbuf
c COMMON /adz9fbuf/adz9buf,adz9lbuf,
c + adz9ibuf,adz9ilbuf,adz9inlbuf
c c
c CALL addftraffic(9)
c IF (adz9ilbuf.ne.-1) THEN
c adz9ilbuf = -1
c adz9inlbuf = .FALSE.
c ENDIF
c IF (adz9ibuf.ge.512) THEN
c adz9buf(512) = x
c CALL PUSHTTTT9ARRAY(adz9buf, 512)
c CALL addftraffic(-9*512)
c adz9ibuf = 1
c ELSE
c adz9buf(adz9ibuf) = x
c adz9ibuf = adz9ibuf+1
c ENDIF
c END
c
c SUBROUTINE LOOKTTTT9(x)
c TTTT*9 x, adz9buf(512), adz9lbuf(512)
c INTEGER adz9ibuf,adz9ilbuf
c LOGICAL adz9inlbuf
c COMMON /adz9fbuf/adz9buf,adz9lbuf,
c + adz9ibuf,adz9ilbuf,adz9inlbuf
c c
c IF (adz9ilbuf.eq.-1) THEN
c adz9ilbuf=adz9ibuf
c CALL RESETADLOOKSTACK()
c ENDIF
c IF (adz9ilbuf.le.1) THEN
c CALL LOOKTTTT9ARRAY(adz9lbuf, 512)
c adz9inlbuf = .TRUE.
c adz9ilbuf = 512
c x = adz9lbuf(512)
c ELSE
c adz9ilbuf = adz9ilbuf-1
c if (adz9inlbuf) THEN
c x = adz9lbuf(adz9ilbuf)
c ELSE
c x = adz9buf(adz9ilbuf)
c ENDIF
c ENDIF
c END
c
c SUBROUTINE POPTTTT9(x)
c TTTT*9 x, adz9buf(512), adz9lbuf(512)
c INTEGER adz9ibuf,adz9ilbuf
c LOGICAL adz9inlbuf
c COMMON /adz9fbuf/adz9buf,adz9lbuf,
c + adz9ibuf,adz9ilbuf,adz9inlbuf
c c
c IF (adz9ilbuf.ne.-1) THEN
c adz9ilbuf = -1
c adz9inlbuf = .FALSE.
c ENDIF
c IF (adz9ibuf.le.1) THEN
c CALL POPTTTT9ARRAY(adz9buf, 512)
c adz9ibuf = 512
c x = adz9buf(512)
c ELSE
c adz9ibuf = adz9ibuf-1
c x = adz9buf(adz9ibuf)
c ENDIF
c END