Context Navigation

adBuffer.f

main

Last change on this file was ea777aa, checked in by Alex Wilton <awilton@…>, 3 years ago

Moved examples, include, build_default.properties, common.xml, and README out from dev.civl.com into the root of the repo.

git-svn-id: svn://vsl.cis.udel.edu/civl/trunk@5704 fb995dde-84ed-4084-dfe6-e5aef3e2452c

Property mode set to 100644

File size: 57.3 KB

Rev	Line
[4d61ad0]	1	C$Id: adBuffer.f 5257 2014-07-17 12:45:15Z vmp $
	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 + (((mmftraffic1000)/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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: CIVL/examples/compare/provesa/ADFirstAidKit/adBuffer.f

Download in other formats: