| 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 |
