Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	PROGRAM LONG$SYMBOLS
	
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	CHARACTER*20	LONGSUB_FUNCTION$STATEMENT,STAFUN_RESULT
	CHARACTER*5	LONG$DUMMY1,LONG$DUMMY2,LONG$VAR1,LONG$VAR2
	INTEGER 	LONGSUB_FUNCTION$EXTERNAL,EXTFUN_RESULT
	INTEGER		LONG$VAR3,LONG$VAR4,LONG$ARRAY1,LONG$ARRAY2
	INTEGER		LONG$VAR11,LONG$VAR12,LONG$VAR13
	INTEGER		LONG$VAR14,LONG$VAR15,LONG$VAR16
	REAL		LONG$VAR5,LONG$VAR6,LONG$VAR7
	REAL		LONG$VAR8,LONG$VAR9,LONG$VAR10
	REAL		PARAMETER_1,PARAMETER_2

	COMMON	/COMMON_BLOCK1/LONG$VAR5,LONG$VAR6
	COMMON	LONG$VAR7
	COMMON	/COMMON_BLOCK2/LONG$VAR8,LONG$VAR9
	COMMON	LONG$VAR10

	PARAMETER (PARAMETER_1=27.8,PARAMETER_2=89.5)

	DIMENSION LONG$ARRAY1(10),LONG$ARRAY2(20)

	LONGSUB_FUNCTION$STATEMENT(LONG$DUMMY1,LONG$DUMMY2)=
	1	LONG$DUMMY1//LONG$DUMMY2

	LONG$VAR1='ABCDE'
	LONG$VAR2='FGHIJ'
	LONG$VAR3=32
	LONG$VAR4=20
	LONG$VAR5=64.0
	LONG$VAR6=16.0
	LONG$VAR8=2.5
	LONG$VAR9=4.0
	LONG$VAR11=1
	LONG$VAR12=5
	LONG$VAR13=10
	LONG$VAR14=1
	LONG$VAR15=10
	LONG$VAR16=20

C	statement function reference

	STAFUN_RESULT=LONGSUB_FUNCTION$STATEMENT(LONG$VAR1,LONG$VAR2)

	IF (STAFUN_RESULT .NE. 'ABCDEFGHIJ') 
	1	TYPE *,' ?statement function failed'

C	external function reference

	EXTFUN_RESULT=LONGSUB_FUNCTION$EXTERNAL(LONG$VAR3,LONG$VAR4)

	IF (EXTFUN_RESULT .NE. 52)
	1	TYPE *,' ?external function failed'

C	subroutine call

	CALL LONGSUB_SUBROUTINE
	
	IF (LONG$VAR7 .NE. 4.0) TYPE *,' ?subroutine failed'
	IF (LONG$VAR10 .NE. 10.0) TYPE *,' ?subroutine failed'

C	check parameter

	IF (PARAMETER_1 .NE. 27.8) TYPE *,' ?parameter_1 failed'
	IF (PARAMETER_2 .NE. 89.5) TYPE *,' ?parameter_2 failed'

	DO I=1,10
	LONG$ARRAY1(I)=I+20
	END DO

	DO J=1,20
	LONG$ARRAY2(J)=J
	END DO

C	check array names and array elements

	IF (LONG$ARRAY1(LONG$VAR11).NE.21) TYPE *,' ?array1(1) failed'
	IF (LONG$ARRAY1(LONG$VAR12).NE.25) TYPE *,' ?array1(5) failed'
	IF (LONG$ARRAY1(LONG$VAR13).NE.30) TYPE *,' ?array1(10) failed'

	IF (LONG$ARRAY2(LONG$VAR14).NE.1) TYPE *,' ?array2(1) failed'
	IF (LONG$ARRAY2(LONG$VAR15).NE.10) TYPE *,' ?array2(10) failed'
	IF (LONG$ARRAY2(LONG$VAR16).NE.20) TYPE *,' ?array2(20) failed'

	END

	INTEGER FUNCTION LONGSUB_FUNCTION$EXTERNAL
	1	(LONG$DUMMY3,LONG$DUMMY4)
	
	LONGSUB_FUNCTION$EXTERNAL=LONG$DUMMY3+LONG$DUMMY4
	
	RETURN
	END

	SUBROUTINE LONGSUB_SUBROUTINE
	REAL	LONG$DUMMY5,LONG$DUMMY6,LONG$DUMMY7
	REAL	LONG$DUMMY8,LONG$DUMMY9,LONG$DUMMY10
	
	COMMON /COMMON_BLOCK1/LONG$DUMMY5,LONG$DUMMY6
	COMMON LONG$DUMMY7
	COMMON /COMMON_BLOCK2/LONG$DUMMY8,LONG$DUMMY9
	COMMON LONG$DUMMY10

C	check common

	IF (LONG$DUMMY5 .NE. 64.0) TYPE *,' ?common block1 failed'
	IF (LONG$DUMMY6 .NE. 16.0) TYPE *,' ?common block1 failed'
	IF (LONG$DUMMY8 .NE. 2.5)  TYPE *,' ?common block2 failed'
	IF (LONG$DUMMY9 .NE. 4.0)  TYPE *,' ?common block2 failed'

	LONG$DUMMY7=LONG$DUMMY5/LONG$DUMMY6
	LONG$DUMMY10=LONG$DUMMY8*LONG$DUMMY9

	RETURN
	END