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