blob: 0f7393c8a9af65ded59ffeb344ff7342db8bc9c7 [file] [log] [blame]
PROGRAM FM514 00010514
C 00020514
C THIS ROUTINE TESTS SUBROUTINE STATEMENT WITH ANS REF. 00030514
C ASTERISK DUMMY ARGUMENTS AND TEST ALTERNATE 15.6.1 00040514
C RETURN SPECIFIER AS AN ACTUAL ARGUMENT. 15.9.3.5 00050514
C 15.6.2.3 00060514
C THIS ROUTINE USES SUBROUTINE SUBPROGRAMS SN515 AND 00070514
C SN516. 00080514
C 00090514
CBB** ********************** BBCCOMNT **********************************00100514
C**** 00110514
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120514
C**** VERSION 2.1 00130514
C**** 00140514
C**** 00150514
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160514
C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170514
C**** SOFTWARE STANDARDS VALIDATION GROUP 00180514
C**** BUILDING 225 RM A266 00190514
C**** GAITHERSBURG, MD 20899 00200514
C**** 00210514
C**** 00220514
C**** 00230514
CBE** ********************** BBCCOMNT **********************************00240514
IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00250514
IMPLICIT CHARACTER*27 (C) 00260514
CBB** ********************** BBCINITA **********************************00270514
C**** SPECIFICATION STATEMENTS 00280514
C**** 00290514
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00300514
1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00310514
CBE** ********************** BBCINITA **********************************00320514
C 00330514
CBB** ********************** BBCINITB **********************************00340514
C**** INITIALIZE SECTION 00350514
DATA ZVERS, ZVERSD, ZDATE 00360514
1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370514
DATA ZCOMPL, ZNAME, ZTAPE 00380514
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390514
DATA ZPROJ, ZTAPED, ZPROG 00400514
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410514
DATA REMRKS /' '/ 00420514
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430514
C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440514
C**** 00450514
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460514
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470514
CZ03 ZPROG = 'PROGRAM NAME' 00480514
CZ04 ZDATE = 'DATE OF TEST' 00490514
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500514
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510514
CZ07 ZNAME = 'NAME OF USER' 00520514
CZ08 ZTAPE = 'TAPE OWNER/ID' 00530514
CZ09 ZTAPED = 'DATE TAPE COPIED' 00540514
C 00550514
IVPASS = 0 00560514
IVFAIL = 0 00570514
IVDELE = 0 00580514
IVINSP = 0 00590514
IVTOTL = 0 00600514
IVTOTN = 0 00610514
ICZERO = 0 00620514
C 00630514
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640514
I01 = 05 00650514
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660514
I02 = 06 00670514
C 00680514
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690514
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700514
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710514
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720514
C 00730514
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740514
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750514
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760514
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770514
C 00780514
CBE** ********************** BBCINITB **********************************00790514
ZPROG = 'FM514' 00800514
IVTOTL = 2 00810514
CBB** ********************** BBCHED0A **********************************00820514
C**** 00830514
C**** WRITE REPORT TITLE 00840514
C**** 00850514
WRITE (I02, 90002) 00860514
WRITE (I02, 90006) 00870514
WRITE (I02, 90007) 00880514
WRITE (I02, 90008) ZVERS, ZVERSD 00890514
WRITE (I02, 90009) ZPROG, ZPROG 00900514
WRITE (I02, 90010) ZDATE, ZCOMPL 00910514
CBE** ********************** BBCHED0A **********************************00920514
CBB** ********************** BBCHED0B **********************************00930514
C**** WRITE DETAIL REPORT HEADERS 00940514
C**** 00950514
WRITE (I02,90004) 00960514
WRITE (I02,90004) 00970514
WRITE (I02,90013) 00980514
WRITE (I02,90014) 00990514
WRITE (I02,90015) IVTOTL 01000514
CBE** ********************** BBCHED0B **********************************01010514
C 01020514
CT001* TEST 001 **** FCVS PROGRAM 514 **** 01030514
C TEST 001 TEST SUBROUTINE STATEMENT WITH ASTERISK DUMMY ARGUMENTS 01040514
C 01050514
IVTNUM = 1 01060514
IVCOMP = 0 01070514
IVCORR = 3 01080514
IVN001 = 1 01090514
0012 CALL SN515(IVN001,*0013,*0014) 01100514
IVCOMP = 10 01110514
0013 CONTINUE 01120514
IVCOMP = IVCOMP + IVN001 01130514
IVN001 = 2 01140514
GO TO 0012 01150514
0014 CONTINUE 01160514
IVCOMP = IVCOMP + IVN001 01170514
40010 IF (IVCOMP - 3) 20010, 10010, 20010 01180514
10010 IVPASS = IVPASS + 1 01190514
WRITE (I02,80002) IVTNUM 01200514
GO TO 0011 01210514
20010 IVFAIL = IVFAIL + 1 01220514
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01230514
0011 CONTINUE 01240514
C 01250514
CT002* TEST 002 **** FCVS PROGRAM 514 **** 01260514
C TEST 002 TESTS THE USE OF AN ALTERNATE RETURN SPECIFIER 01270514
C AS AN ACTUAL ARGUMENT 01280514
C 01290514
IVTNUM = 2 01300514
IVCOMP = 0 01310514
IVCORR = 0 01320514
CALL SN516(5,IVN001,*0024) 01330514
0022 IVCOMP = IVCOMP - IVN001 01340514
GO TO 0025 01350514
0023 CONTINUE 01360514
IVCOMP = IVCOMP - IVN001 01370514
CALL SN516(4,IVN001,*0022) 01380514
IVCOMP = IVCOMP + IVN001 01390514
0024 CONTINUE 01400514
IVCOMP = IVCOMP + IVN001 01410514
CALL SN516(3,IVN001,*0023) 01420514
IVCOMP = IVCOMP + IVN001 01430514
0025 CONTINUE 01440514
40020 IF (IVCOMP - 0) 20020, 10020, 20020 01450514
10020 IVPASS = IVPASS + 1 01460514
WRITE (I02,80002) IVTNUM 01470514
GO TO 0021 01480514
20020 IVFAIL = IVFAIL + 1 01490514
WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01500514
0021 CONTINUE 01510514
C 01520514
CBB** ********************** BBCSUM0 **********************************01530514
C**** WRITE OUT TEST SUMMARY 01540514
C**** 01550514
IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01560514
WRITE (I02, 90004) 01570514
WRITE (I02, 90014) 01580514
WRITE (I02, 90004) 01590514
WRITE (I02, 90020) IVPASS 01600514
WRITE (I02, 90022) IVFAIL 01610514
WRITE (I02, 90024) IVDELE 01620514
WRITE (I02, 90026) IVINSP 01630514
WRITE (I02, 90028) IVTOTN, IVTOTL 01640514
CBE** ********************** BBCSUM0 **********************************01650514
CBB** ********************** BBCFOOT0 **********************************01660514
C**** WRITE OUT REPORT FOOTINGS 01670514
C**** 01680514
WRITE (I02,90016) ZPROG, ZPROG 01690514
WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 01700514
WRITE (I02,90019) 01710514
CBE** ********************** BBCFOOT0 **********************************01720514
90001 FORMAT (" ",56X,"FM514") 01730514
90000 FORMAT (" ",50X,"END OF PROGRAM FM514" ) 01740514
CBB** ********************** BBCFMT0A **********************************01750514
C**** FORMATS FOR TEST DETAIL LINES 01760514
C**** 01770514
80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 01780514
80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 01790514
80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 01800514
80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 01810514
80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 01820514
1I6,/," ",15X,"CORRECT= " ,I6) 01830514
80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01840514
1E12.5,/," ",16X,"CORRECT= " ,E12.5) 01850514
80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01860514
1A21,/," ",16X,"CORRECT= " ,A21) 01870514
80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 01880514
80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 01890514
80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 01900514
80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 01910514
80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 01920514
80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 01930514
80050 FORMAT (" ",48X,A31) 01940514
CBE** ********************** BBCFMT0A **********************************01950514
CBB** ********************** BBCFMAT1 **********************************01960514
C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 01970514
C**** 01980514
80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01990514
1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02000514
80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02010514
80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02020514
80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02030514
80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02040514
80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02050514
80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02060514
80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02070514
1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02080514
2"(",F12.5,", ",F12.5,")") 02090514
CBE** ********************** BBCFMAT1 **********************************02100514
CBB** ********************** BBCFMT0B **********************************02110514
C**** FORMAT STATEMENTS FOR PAGE HEADERS 02120514
C**** 02130514
90002 FORMAT ("1") 02140514
90004 FORMAT (" ") 02150514
90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02160514
90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02170514
90008 FORMAT (" ",21X,A13,A17) 02180514
90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02190514
90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02200514
90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02210514
1 7X,"REMARKS",24X) 02220514
90014 FORMAT (" ","----------------------------------------------" , 02230514
1 "---------------------------------" ) 02240514
90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02250514
C**** 02260514
C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02270514
C**** 02280514
90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02290514
90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02300514
1 A13) 02310514
90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02320514
C**** 02330514
C**** FORMAT STATEMENTS FOR RUN SUMMARY 02340514
C**** 02350514
90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02360514
90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02370514
90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02380514
90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02390514
90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02400514
CBE** ********************** BBCFMT0B **********************************02410514
STOP 02420514
END 02430514
C 00010515
C THIS ROUTINE IS TO BE RUN WITH ROUTINE 514 00020515
C 00030515
C THIS SUBROUTINE IS USED TO TEST SUBROUTINE STATEMENT WITH 00040515
C ASTERISK DUMMY ARGUMENTS 00050515
C 00060515
SUBROUTINE SN515(IVD001,*,*) 00070515
RETURN IVD001 00080515
END 00090515
C THIS ROUTINE IS TO BE RUN WITH ROUTINE 514. 00010516
C 00020516
C THIS SUBROUTINE IS CALLED TO TEST THE USE OF AN ALTERNATE 00030516
C RETURN SPECIFIER AS AN ACTUAL ARGUMENT 00040516
C 00050516
SUBROUTINE SN516(IVD001,IVD002,*) 00060516
IVD002 = IVD001**2 00070516
RETURN 1 00080516
END 00090516