PROGRAM FM509 00010509 C 00020509 C THIS ROUTINE TESTS SUBROUTINE SUBPROGRAMS AND ANS REF. 00030509 C FUNCTION SUBPROGRAMS WITH MULTIPLE ENTRIES. 15.6.1 00040509 C THIS ROUTINE ALSO TESTS THE USE OF SYMBOLIC 15.7, 15.7.1 00050509 C NAMES OF CONSTANTS, SUBSTRINGS NAMES, AND 15.9.2 00060509 C ARRAY ELEMENT SUBSTRINGS AS ARGUMENTS. 15.9.3.2 00070509 C 15.9.3.3 00080509 C THIS ROUTINE USES THE SUBROUTINE SUBPROGRAMS SN510, 00090509 C SN511, AND SN512, AND THE FUNCTION SUBPROGRAM RF513. 00100509 C 00110509 CBB** ********************** BBCCOMNT **********************************00120509 C**** 00130509 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140509 C**** VERSION 2.1 00150509 C**** 00160509 C**** 00170509 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180509 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190509 C**** SOFTWARE STANDARDS VALIDATION GROUP 00200509 C**** BUILDING 225 RM A266 00210509 C**** GAITHERSBURG, MD 20899 00220509 C**** 00230509 C**** 00240509 C**** 00250509 CBE** ********************** BBCCOMNT **********************************00260509 IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00270509 IMPLICIT CHARACTER*27 (C) 00280509 CBB** ********************** BBCINITA **********************************00290509 C**** SPECIFICATION STATEMENTS 00300509 C**** 00310509 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320509 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330509 CBE** ********************** BBCINITA **********************************00340509 C 00350509 INTEGER I2N001(2,2) 00360509 CHARACTER CVCOMP*12,CVCORR*12,CVN001*30 00370509 CHARACTER C1N001(6)*10 00380509 PARAMETER (IPN001=31) 00390509 COMMON IVC001, IVC002, IVC003 00400509 EXTERNAL RF513 00410509 DATA I2N001 /1, 3, 5, 7/ 00420509 DATA CVN001 /'REDORANGEYELLOWGREENBLUEVIOLET'/ 00430509 DATA C1N001 /'FIRST-AID:','SECONDRATE','THIRD-TERM', 00440509 1 'FOURTH-DAY','FIFTHROUND','SIXTHMONTH'/ 00450509 C 00460509 C 00470509 CBB** ********************** BBCINITB **********************************00480509 C**** INITIALIZE SECTION 00490509 DATA ZVERS, ZVERSD, ZDATE 00500509 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00510509 DATA ZCOMPL, ZNAME, ZTAPE 00520509 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00530509 DATA ZPROJ, ZTAPED, ZPROG 00540509 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00550509 DATA REMRKS /' '/ 00560509 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00570509 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00580509 C**** 00590509 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00600509 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00610509 CZ03 ZPROG = 'PROGRAM NAME' 00620509 CZ04 ZDATE = 'DATE OF TEST' 00630509 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00640509 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00650509 CZ07 ZNAME = 'NAME OF USER' 00660509 CZ08 ZTAPE = 'TAPE OWNER/ID' 00670509 CZ09 ZTAPED = 'DATE TAPE COPIED' 00680509 C 00690509 IVPASS = 0 00700509 IVFAIL = 0 00710509 IVDELE = 0 00720509 IVINSP = 0 00730509 IVTOTL = 0 00740509 IVTOTN = 0 00750509 ICZERO = 0 00760509 C 00770509 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00780509 I01 = 05 00790509 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00800509 I02 = 06 00810509 C 00820509 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00830509 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00840509 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00850509 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00860509 C 00870509 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00880509 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00890509 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00900509 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00910509 C 00920509 CBE** ********************** BBCINITB **********************************00930509 ZPROG = 'FM509' 00940509 IVTOTL = 16 00950509 CBB** ********************** BBCHED0A **********************************00960509 C**** 00970509 C**** WRITE REPORT TITLE 00980509 C**** 00990509 WRITE (I02, 90002) 01000509 WRITE (I02, 90006) 01010509 WRITE (I02, 90007) 01020509 WRITE (I02, 90008) ZVERS, ZVERSD 01030509 WRITE (I02, 90009) ZPROG, ZPROG 01040509 WRITE (I02, 90010) ZDATE, ZCOMPL 01050509 CBE** ********************** BBCHED0A **********************************01060509 CBB** ********************** BBCHED0B **********************************01070509 C**** WRITE DETAIL REPORT HEADERS 01080509 C**** 01090509 WRITE (I02,90004) 01100509 WRITE (I02,90004) 01110509 WRITE (I02,90013) 01120509 WRITE (I02,90014) 01130509 WRITE (I02,90015) IVTOTL 01140509 CBE** ********************** BBCHED0B **********************************01150509 C 01160509 CT001* TEST 001 **** FCVS PROGRAM 509 **** 01170509 C SUBROUTINE WITH MULTIPLE ENTRIES 01180509 C 01190509 IVTNUM = 1 01200509 IVCOMP = 0 01210509 IVCORR = 25 01220509 IVD020=3 01220509 CALL SN510(IVD020,IVN001) 01230509 CALL EN851(IVN001,IVCOMP) 01240509 40010 IF (IVCOMP - 25) 20010, 10010, 20010 01250509 10010 IVPASS = IVPASS + 1 01260509 WRITE (I02,80002) IVTNUM 01270509 GO TO 0011 01280509 20010 IVFAIL = IVFAIL + 1 01290509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300509 0011 CONTINUE 01310509 C 01320509 CT002* TEST 002 **** FCVS PROGRAM 509 **** 01330509 C ENTRY WITH ONE ARGUMENT 01340509 C 01350509 IVTNUM = 2 01360509 IVCOMP = 0 01370509 IVCORR = 137 01380509 IVN001 = 37 01390509 CALL EN852(IVN001) 01400509 IVCOMP = IVN001 01410509 40020 IF (IVCOMP - 137) 20020, 10020, 20020 01420509 10020 IVPASS = IVPASS + 1 01430509 WRITE (I02,80002) IVTNUM 01440509 GO TO 0021 01450509 20020 IVFAIL = IVFAIL + 1 01460509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01470509 0021 CONTINUE 01480509 C 01490509 CT003* TEST 003 **** FCVS PROGRAM 509 **** 01500509 C ENTRY WITH TWO ARGUMENT 01510509 C 01520509 IVTNUM = 3 01530509 IVCOMP = 0 01540509 IVCORR = -51 01550509 CALL EN853(-9,IVCOMP) 01560509 40030 IF (IVCOMP + 51) 20030, 10030, 20030 01570509 10030 IVPASS = IVPASS + 1 01580509 WRITE (I02,80002) IVTNUM 01590509 GO TO 0031 01600509 20030 IVFAIL = IVFAIL + 1 01610509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01620509 0031 CONTINUE 01630509 C 01640509 CT004* TEST 004 **** FCVS PROGRAM 509 **** 01650509 C ENTRY WITH THREE ARGUMENTS 01660509 C 01670509 IVTNUM = 4 01680509 IVCOMP = 0 01690509 IVCORR = -71 01700509 CALL EN854(275,147,IVCOMP) 01710509 40040 IF (IVCOMP + 71) 20040, 10040, 20040 01720509 10040 IVPASS = IVPASS + 1 01730509 WRITE (I02,80002) IVTNUM 01740509 GO TO 0041 01750509 20040 IVFAIL = IVFAIL + 1 01760509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01770509 0041 CONTINUE 01780509 C 01790509 CT005* TEST 005 **** FCVS PROGRAM 509 **** 01800509 C ENTRY WITH FOUR ARGUMENTS 01810509 C 01820509 IVTNUM = 5 01830509 IVCOMP = 0 01840509 IVCORR = 567 01850509 CALL EN855(12,-15,63,IVCOMP) 01860509 40050 IF (IVCOMP - 567) 20050, 10050, 20050 01870509 10050 IVPASS = IVPASS + 1 01880509 WRITE (I02,80002) IVTNUM 01890509 GO TO 0051 01900509 20050 IVFAIL = IVFAIL + 1 01910509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01920509 0051 CONTINUE 01930509 C 01940509 CT006* TEST 006 **** FCVS PROGRAM 509 **** 01950509 C ENTRY WITH ARRAY AS DUMMY ARGUMENT 01960509 C 01970509 IVTNUM = 6 01980509 IVCOMP = 0 01990509 IVCORR = 16 02000509 IVN001 = 2 02010509 CALL EN856(IVN001,I2N001,IVCOMP) 02020509 40060 IF (IVCOMP - 16) 20060, 10060, 20060 02030509 10060 IVPASS = IVPASS + 1 02040509 WRITE (I02,80002) IVTNUM 02050509 GO TO 0061 02060509 20060 IVFAIL = IVFAIL + 1 02070509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02080509 0061 CONTINUE 02090509 C 02100509 CT007* TEST 007 **** FCVS PROGRAM 509 **** 02110509 C ENTRY WITH PROCEDURE AS DUMMY ARGUMENT 02120509 C 02130509 IVTNUM = 7 02140509 RVCOMP = 0.0 02150509 RVCORR = 2.25 02160509 CALL EN857(1.5,RVCOMP,RF513) 02170509 IF (RVCOMP - 0.22498E+01) 20070, 10070, 40070 02180509 40070 IF (RVCOMP - 0.22502E+01) 10070, 10070, 20070 02190509 10070 IVPASS = IVPASS + 1 02200509 WRITE (I02,80002) IVTNUM 02210509 GO TO 0071 02220509 20070 IVFAIL = IVFAIL + 1 02230509 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02240509 0071 CONTINUE 02250509 C 02260509 CT008* TEST 008 **** FCVS PROGRAM 509 **** 02270509 C ENTRY WITH ASTERISK AS DUMMY ARGUMENT 02280509 C 02290509 IVTNUM = 8 02300509 IVCOMP = 0 02310509 IVCORR = 19 02320509 IVN001 = 2 02330509 CALL EN858(IVN001,*0082,*0083) 02340509 0082 IVCOMP = 5 02350509 GO TO 0084 02360509 0083 IVCOMP = 19 02370509 0084 CONTINUE 02380509 40080 IF (IVCOMP - 19) 20080, 10080, 20080 02390509 10080 IVPASS = IVPASS + 1 02400509 WRITE (I02,80002) IVTNUM 02410509 GO TO 0081 02420509 20080 IVFAIL = IVFAIL + 1 02430509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02440509 0081 CONTINUE 02450509 C 02460509 C TESTS 9 AND 10 TEST ENTRY WITHOUT ARGUMENTS 02470509 C 02480509 CT009* TEST 009 **** FCVS PROGRAM 509 **** 02490509 C 02500509 IVTNUM = 9 02510509 IVCOMP = 0 02520509 IVCORR = 88 02530509 IVC002 = 65 02540509 IVC003 = 23 02550509 CALL EN859( ) 02560509 IVCOMP = IVC001 02570509 40090 IF (IVCOMP - 88) 20090, 10090, 20090 02580509 10090 IVPASS = IVPASS + 1 02590509 WRITE (I02,80002) IVTNUM 02600509 GO TO 0091 02610509 20090 IVFAIL = IVFAIL + 1 02620509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02630509 0091 CONTINUE 02640509 C 02650509 CT010* TEST 010 **** FCVS PROGRAM 509 **** 02660509 C 02670509 IVTNUM = 10 02680509 IVCOMP = 0 02690509 IVCORR = -13 02700509 IVC001 = 4 02710509 IVC002 = -17 02720509 CALL EN860 02730509 IVCOMP = IVC003 02740509 40100 IF (IVCOMP + 13) 20100, 10100, 20100 02750509 10100 IVPASS = IVPASS + 1 02760509 WRITE (I02,80002) IVTNUM 02770509 GO TO 0101 02780509 20100 IVFAIL = IVFAIL + 1 02790509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02800509 0101 CONTINUE 02810509 C 02820509 CT011* TEST 011 **** FCVS PROGRAM 509 **** 02830509 C FUNCTION SUBPROGRAM WITH MULTIPLE ENTRIES 02840509 C 02850509 IVTNUM = 11 02860509 RVCOMP = 0.0 02870509 RVCORR = 3.675E-3 02880509 RVN001 = RF513(3.5E-2) 02890509 RVCOMP = EF852(RVN001) 02900509 IF (RVCOMP - 0.36748E-02) 20110, 10110, 40110 02910509 40110 IF (RVCOMP - 0.36752E-02) 10110, 10110, 20110 02920509 10110 IVPASS = IVPASS + 1 02930509 WRITE (I02,80002) IVTNUM 02940509 GO TO 0111 02950509 20110 IVFAIL = IVFAIL + 1 02960509 WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02970509 0111 CONTINUE 02980509 C 02990509 CT012* TEST 012 **** FCVS PROGRAM 509 **** 03000509 C SYMBOLIC NAME OF A CONSTANT AS AN ACTUAL ARGUMENT 03010509 C 03020509 IVTNUM = 12 03030509 IVCOMP = 0 03040509 IVCORR = 34 03050509 CALL SN510(IPN001,IVCOMP) 03060509 40120 IF (IVCOMP - 34) 20120, 10120, 20120 03070509 10120 IVPASS = IVPASS + 1 03080509 WRITE (I02,80002) IVTNUM 03090509 GO TO 0121 03100509 20120 IVFAIL = IVFAIL + 1 03110509 WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03120509 0121 CONTINUE 03130509 C 03140509 C TESTS 13 AND 14 TEST THE USE OF A SUBSTRING AS AN ACTUAL ARGUMENT 03150509 C WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIABLE 03160509 C 03170509 C 03180509 CT013* TEST 013 **** FCVS PROGRAM 509 **** 03190509 C 03200509 IVTNUM = 13 03210509 CVCOMP = ' ' 03220509 CVCORR = 'COLOR=YELLOW ' 03230509 CALL SN511(CVN001(10:15),CVCOMP) 03240509 IVCOMP = 0 03250509 IF (CVCOMP.EQ.'COLOR=YELLOW ') IVCOMP = 1 03260509 40130 IF (IVCOMP - 1) 20130, 10130, 20130 03270509 10130 IVPASS = IVPASS + 1 03280509 WRITE (I02,80002) IVTNUM 03290509 GO TO 0131 03300509 20130 IVFAIL = IVFAIL + 1 03310509 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03320509 0131 CONTINUE 03330509 C 03340509 CT014* TEST 014 **** FCVS PROGRAM 509 **** 03350509 C 03360509 IVTNUM = 14 03370509 CVCOMP = ' ' 03380509 CVCORR = 'COLOR=VIOLET ' 03390509 CALL SN511(CVN001(25:30),CVCOMP) 03400509 IVCOMP = 0 03410509 IF (CVCOMP.EQ.'COLOR=VIOLET ') IVCOMP = 1 03420509 40140 IF (IVCOMP - 1) 20140, 10140, 20140 03430509 10140 IVPASS = IVPASS + 1 03440509 WRITE (I02,80002) IVTNUM 03450509 GO TO 0141 03460509 20140 IVFAIL = IVFAIL + 1 03470509 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03480509 0141 CONTINUE 03490509 C 03500509 C TESTS 15 AND 16 TEST THE USE OF AN ARRAY ELEMENT SUBSTRING AS AN 03510509 C ACTUAL ARGUMENT WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT 03520509 C IS AN ARRAY 03530509 C 03540509 C 03550509 CT015* TEST 015 **** FCVS PROGRAM 509 **** 03560509 C 03570509 IVTNUM = 15 03580509 CVCOMP = ' ' 03590509 CVCORR = 'RST-AID: ' 03600509 CALL SN512(C1N001(1)(3:10),CVCOMP) 03610509 IVCOMP = 0 03620509 IF (CVCOMP.EQ.'RST-AID: ') IVCOMP = 1 03630509 40150 IF (IVCOMP - 1) 20150, 10150, 20150 03640509 10150 IVPASS = IVPASS + 1 03650509 WRITE (I02,80002) IVTNUM 03660509 GO TO 0151 03670509 20150 IVFAIL = IVFAIL + 1 03680509 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03690509 0151 CONTINUE 03700509 C 03710509 CT016* TEST 016 **** FCVS PROGRAM 509 **** 03720509 C 03730509 IVTNUM = 16 03740509 CVCOMP = ' ' 03750509 CVCORR = 'IFTHROUN ' 03760509 CALL SN512(C1N001(5)(2:9),CVCOMP) 03770509 IVCOMP = 0 03780509 IF (CVCOMP.EQ.'IFTHROUN ') IVCOMP = 1 03790509 40160 IF (IVCOMP - 1) 20160, 10160, 20160 03800509 10160 IVPASS = IVPASS + 1 03810509 WRITE (I02,80002) IVTNUM 03820509 GO TO 0161 03830509 20160 IVFAIL = IVFAIL + 1 03840509 WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03850509 0161 CONTINUE 03860509 C 03870509 CBB** ********************** BBCSUM0 **********************************03880509 C**** WRITE OUT TEST SUMMARY 03890509 C**** 03900509 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03910509 WRITE (I02, 90004) 03920509 WRITE (I02, 90014) 03930509 WRITE (I02, 90004) 03940509 WRITE (I02, 90020) IVPASS 03950509 WRITE (I02, 90022) IVFAIL 03960509 WRITE (I02, 90024) IVDELE 03970509 WRITE (I02, 90026) IVINSP 03980509 WRITE (I02, 90028) IVTOTN, IVTOTL 03990509 CBE** ********************** BBCSUM0 **********************************04000509 CBB** ********************** BBCFOOT0 **********************************04010509 C**** WRITE OUT REPORT FOOTINGS 04020509 C**** 04030509 WRITE (I02,90016) ZPROG, ZPROG 04040509 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04050509 WRITE (I02,90019) 04060509 CBE** ********************** BBCFOOT0 **********************************04070509 90001 FORMAT (" ",56X,"FM509") 04080509 90000 FORMAT (" ",50X,"END OF PROGRAM FM509" ) 04090509 CBB** ********************** BBCFMT0A **********************************04100509 C**** FORMATS FOR TEST DETAIL LINES 04110509 C**** 04120509 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04130509 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04140509 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04150509 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04160509 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04170509 1I6,/," ",15X,"CORRECT= " ,I6) 04180509 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04190509 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04200509 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04210509 1A21,/," ",16X,"CORRECT= " ,A21) 04220509 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04230509 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04240509 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04250509 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04260509 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04270509 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04280509 80050 FORMAT (" ",48X,A31) 04290509 CBE** ********************** BBCFMT0A **********************************04300509 CBB** ********************** BBCFMAT1 **********************************04310509 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04320509 C**** 04330509 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04340509 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04350509 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04360509 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04370509 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04380509 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04390509 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04400509 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04410509 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04420509 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04430509 2"(",F12.5,", ",F12.5,")") 04440509 CBE** ********************** BBCFMAT1 **********************************04450509 CBB** ********************** BBCFMT0B **********************************04460509 C**** FORMAT STATEMENTS FOR PAGE HEADERS 04470509 C**** 04480509 90002 FORMAT ("1") 04490509 90004 FORMAT (" ") 04500509 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04510509 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04520509 90008 FORMAT (" ",21X,A13,A17) 04530509 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04540509 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04550509 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04560509 1 7X,"REMARKS",24X) 04570509 90014 FORMAT (" ","----------------------------------------------" , 04580509 1 "---------------------------------" ) 04590509 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04600509 C**** 04610509 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04620509 C**** 04630509 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04640509 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04650509 1 A13) 04660509 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04670509 C**** 04680509 C**** FORMAT STATEMENTS FOR RUN SUMMARY 04690509 C**** 04700509 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04710509 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04720509 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04730509 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04740509 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04750509 CBE** ********************** BBCFMT0B **********************************04760509 STOP 04770509 END 04780509 C 00010510 C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509. 00020510 C 00030510 C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST IF 00040510 C MULTIPLE ENTRIES ARE PERMITTED IN A SUBROUTINE SUBPROGRAM. 00050510 C 00060510 SUBROUTINE SN510(IVD021,IVD002) 00070510 INTEGER I2D001(2,2) 00080510 COMMON IVC001, IVC002, IVC003 00090510 IVD001 = IVD021 00090510 DO 70010 IVN001 = 1, 3 00100510 IVD001 = IVD001 + 1 00110510 70010 CONTINUE 00120510 IVD002 = IVD001 00130510 RETURN 00140510 ENTRY EN851(IVD003,IVD004) 00150510 IVD004 = 3*IVD003 + 7 00160510 RETURN 00170510 ENTRY EN852(IVD005) 00180510 IVD005 = IVD005 + 100 00190510 RETURN 00200510 ENTRY EN853(IVD006,IVD007) 00210510 IVD007 = 5*(IVD006 + 2) - 16 00220510 RETURN 00230510 ENTRY EN854(IVD008,IVD009,IVD010) 00240510 IVD010 = 4*(IVD008 - 2*IVD009) + 5 00250510 RETURN 00260510 ENTRY EN855(IVD011, IVD012, IVD013, IVD014) 00270510 IVD014 = IVD013*(2*IVD011 + IVD012) 00280510 RETURN 00290510 ENTRY EN856(IVD015,I2D001,IVD016) 00300510 IVD016 = 0 00310510 DO 70020 IVN001 = 1, IVD015 00320510 DO 70020 IVN002 = 1, IVD015 00330510 70020 IVD016 = IVD016 + I2D001(IVN001,IVN002) 00340510 RETURN 00350510 ENTRY EN857(RVD017,RVD018,RFD001) 00360510 RVD018 = RFD001(RVD017) 00370510 RETURN 00380510 ENTRY EN858(IVD019,*,*) 00390510 RETURN IVD019 00400510 ENTRY EN859( ) 00410510 IVC001 = IVC002 + IVC003 00420510 RETURN 00430510 ENTRY EN860 00440510 IVC003 = IVC001 + IVC002 00450510 RETURN 00460510 END 00470510 C 00480510 C 00010511 C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509. 00020511 C 00030511 C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE 00040511 C OF A SUBSTRING NAME AS AN ACTUAL ARGUMENT WHICH IS 00050511 C ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIBLE 00060511 C 00070511 SUBROUTINE SN511(CVD001,CVD002) 00080511 CHARACTER CVD001*6, CVD002*12 00090511 CVD002 = 'COLOR='//CVD001 00100511 RETURN 00110511 END 00120511 C 00010512 C THIS ROUTINE IS TO BE RUN WIHT ROUTINE 509. 00020512 C 00030512 C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE OF 00040512 C AN ARRAY ELEMENT SUBSTRING AS AN ACTUAL ARGUMENT WHICH 00050512 C IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS AN ARRAY. 00060512 C 00070512 SUBROUTINE SN512(C1D001,CVD001) 00080512 CHARACTER C1D001(6)*8,CVD001*8 00090512 CVD001 = C1D001(1) 00100512 RETURN 00110512 END 00120512 C 00010513 C THIS FUNCTION IS TO BE RUN WITH ROUTINE 509. 00020513 C 00030513 C THIS FUNCTION IS REFERENCED IN THE MAIN PROGRAM TO TEST IF 00040513 C MULTIPLE ENTRIES ARE PERMITTED IN A FUNCTION SUBPROGRAM. 00050513 C 00060513 FUNCTION RF513(RVD001) 00070513 RF513 = RVD001**2 00080513 RETURN 00090513 ENTRY EF852(RVD002) 00100513 EF852 = 3*RVD002 00110513 RETURN 00120513 END 00130513