**********00010504 * FORTRAN 77 00020504 FM504 BDS2 (UNNAMED) - (702) 00030504 * THIS BLOCK DATA SUBPROGRAM IS USED BY FM503 00040504 **********00050504 00060504 * GENERAL PURPOSE 00070504 THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS 00080504 * TO BE RUN WITH TEST SEGMENT 261 00090504 THIS SEGMENT WILL TEST INTERNAL DATA FORMS, AS WELL 00100504 * AS THE USE OF UNNAMED BLOCK DATA PROGRAM 00110504 00120504 **********00010505 * FORTRAN 77 00020505 FM505 BLKD2Q - (703) 00030505 * THIS SUBROUTINE IS CALLED BY FM503 00040505 **********00050505 00060505 * GENERAL PURPOSE 00070505 THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 261 00080505 * THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090505 IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY 00100505 * VARIABLES 00110505 00120505
PROGRAM FM503 C***********************************************************************00010503 C***** FORTRAN 77 00020503 C***** FM503 00030503 C***** BLKD2 - (261) 00040503 C***** THIS PROGRAM USES FM504 (UNNAMED BLOCK DATA SUBPROGRAM 00050503 C***** AND SUBROUTINE SN505 00060503 C***********************************************************************00070503 C***** TESTING OF BLOCK DATA SUBPROGRAMS ANS REF 00080503 C***** DATA INTERNAL FORMS 16 00090503 C***** THIS SEGMENT USES SEGMENTS 702 AND 703, BLOCK DATA PROGRAM 00100503 C***** FM504 AND SUBROUTINE SN505 00110503 C***** 00120503 CBB** ********************** BBCCOMNT **********************************00130503 C**** 00140503 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150503 C**** VERSION 2.1 00160503 C**** 00170503 C**** 00180503 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190503 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200503 C**** SOFTWARE STANDARDS VALIDATION GROUP 00210503 C**** BUILDING 225 RM A266 00220503 C**** GAITHERSBURG, MD 20899 00230503 C**** 00240503 C**** 00250503 C**** 00260503 CBE** ********************** BBCCOMNT **********************************00270503 C***** 00280503 C***** S P E C I F I C A T I O N S SEGMENT 261 00290503 C***** 00300503 C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00310503 C***** DOUBLE PRECISION AXVD, DVCORR 00320503 C***** COMPLEX AXVC, ZVCORR 00330503 C***** LOGICAL AXVB 00340503 C***** CHARACTER*6 A6XVK, B6XVK, CVCORR 00350503 C***** 00360503 C***** COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB 00370503 C***** COMMON /BLK7/ A6XVK, B6XVK 00380503 C***** 00390503 C***** 00400503 CALL SN505 00410503 STOP 00420503 C***** 00430503 C***** END OF TEST SEGMENT 261 00440503 END 00450503 C***********************************************************************00010504 C***** FORTRAN 77 00020504 C***** FM504 BDS2 (UNNAMED) - (702) 00030504 C***** THIS BLOCK DATA SUBPROGRAM IS USED BY FM503 00040504 C***********************************************************************00050504 C***** 00060504 C***** GENERAL PURPOSE 00070504 C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS 00080504 C***** TO BE RUN WITH TEST SEGMENT 261 00090504 C***** THIS SEGMENT WILL TEST INTERNAL DATA FORMS, AS WELL 00100504 C***** AS THE USE OF UNNAMED BLOCK DATA PROGRAM 00110504 C***** 00120504 BLOCK DATA 00130504 C***** 00140504 C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00150504 DOUBLE PRECISION AXVD 00160504 COMPLEX AXVC 00170504 LOGICAL AXVB 00180504 CHARACTER*6 A6XVK, B6XVK 00190504 C***** 00200504 COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB 00210504 COMMON /BLK7/ A6XVK, B6XVK 00220504 DATA AXVS, BXVS, IXVI, AXVD, AXVC, AXVB /34.25E-1, 43.23, 21, 00230504 1 1.23456, (234.23, 34.9), .TRUE./ 00240504 DATA A6XVK, B6XVK /'ABCDE', 'FGHIJK'/ 00250504 C***** 00260504 END 00270504 C***********************************************************************00010505 C***** FORTRAN 77 00020505 C***** FM505 BLKD2Q - (703) 00030505 C***** THIS SUBROUTINE IS CALLED BY FM503 00040505 C***********************************************************************00050505 C***** 00060505 C***** GENERAL PURPOSE 00070505 C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 261 00080505 C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090505 C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY 00100505 C***** VARIABLES 00110505 C***** 00120505 SUBROUTINE SN505 00130505 C***** 00140505 C***** 00150505 C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00160505 DOUBLE PRECISION AXVD, DVCORR 00170505 COMPLEX AXVC, ZVCORR 00180505 LOGICAL AXVB 00190505 CHARACTER*6 A6XVK, B6XVK, CVCORR 00200505 C***** 00210505 COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB 00220505 COMMON /BLK7/ A6XVK, B6XVK 00230505 C***** LOCAL DECLARATION 00240505 DOUBLE PRECISION AVD 00250505 COMPLEX AVC 00260505 REAL R2E(2) 00270505 EQUIVALENCE (AVC, R2E) 00280505 C***** 00290505 CBB** ********************** BBCINITA **********************************00300505 C**** SPECIFICATION STATEMENTS 00310505 C**** 00320505 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330505 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340505 CBE** ********************** BBCINITA **********************************00350505 CBB** ********************** BBCINITB **********************************00360505 C**** INITIALIZE SECTION 00370505 DATA ZVERS, ZVERSD, ZDATE 00380505 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390505 DATA ZCOMPL, ZNAME, ZTAPE 00400505 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410505 DATA ZPROJ, ZTAPED, ZPROG 00420505 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430505 DATA REMRKS /' '/ 00440505 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450505 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460505 C**** 00470505 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480505 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490505 CZ03 ZPROG = 'PROGRAM NAME' 00500505 CZ04 ZDATE = 'DATE OF TEST' 00510505 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520505 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530505 CZ07 ZNAME = 'NAME OF USER' 00540505 CZ08 ZTAPE = 'TAPE OWNER/ID' 00550505 CZ09 ZTAPED = 'DATE TAPE COPIED' 00560505 C 00570505 IVPASS = 0 00580505 IVFAIL = 0 00590505 IVDELE = 0 00600505 IVINSP = 0 00610505 IVTOTL = 0 00620505 IVTOTN = 0 00630505 ICZERO = 0 00640505 C 00650505 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660505 I01 = 05 00670505 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680505 I02 = 06 00690505 C 00700505 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710505 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720505 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730505 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740505 C 00750505 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760505 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770505 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780505 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790505 C 00800505 CBE** ********************** BBCINITB **********************************00810505 NUVI = I02 00820505 IVTOTL = 8 00830505 ZPROG = 'FM503' 00840505 CBB** ********************** BBCHED0A **********************************00850505 C**** 00860505 C**** WRITE REPORT TITLE 00870505 C**** 00880505 WRITE (I02, 90002) 00890505 WRITE (I02, 90006) 00900505 WRITE (I02, 90007) 00910505 WRITE (I02, 90008) ZVERS, ZVERSD 00920505 WRITE (I02, 90009) ZPROG, ZPROG 00930505 WRITE (I02, 90010) ZDATE, ZCOMPL 00940505 CBE** ********************** BBCHED0A **********************************00950505 WRITE(NUVI,26100) 00960505 26100 FORMAT( " ", / " BLKD2 - (261) BLOCK DATA SUBPROGRAM --" // 00970505 1 " DATA INTERNAL FORMS" // 00980505 2 " ANS REF. - 16" ) 00990505 CBB** ********************** BBCHED0B **********************************01000505 C**** WRITE DETAIL REPORT HEADERS 01010505 C**** 01020505 WRITE (I02,90004) 01030505 WRITE (I02,90004) 01040505 WRITE (I02,90013) 01050505 WRITE (I02,90014) 01060505 WRITE (I02,90015) IVTOTL 01070505 CBE** ********************** BBCHED0B **********************************01080505 C***** 01090505 CT001* TEST 1 REAL VARIABLE - EXPONENT FORM 01100505 IVTNUM = 1 01110505 AVS = AXVS 01120505 IF (AVS - 0.34248E+01) 20010, 10010, 40010 01130505 40010 IF (AVS - 0.34252E+01) 10010, 10010, 20010 01140505 10010 IVPASS = IVPASS + 1 01150505 WRITE (NUVI, 80002) IVTNUM 01160505 GO TO 0011 01170505 20010 IVFAIL = IVFAIL + 1 01180505 RVCORR = 34.25E-1 01190505 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01200505 0011 CONTINUE 01210505 CT002* TEST 2 REAL VARIABLE - NON EXPONENT FORM 01220505 IVTNUM = 2 01230505 AVS = BXVS 01240505 IF (AVS - 0.43227E+02) 20020, 10020, 40020 01250505 40020 IF (AVS - 0.43233E+02) 10020, 10020, 20020 01260505 10020 IVPASS = IVPASS + 1 01270505 WRITE (NUVI, 80002) IVTNUM 01280505 GO TO 0021 01290505 20020 IVFAIL = IVFAIL + 1 01300505 RVCORR = 43.23 01310505 WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01320505 0021 CONTINUE 01330505 CT003* TEST 3 INTEGER VARIABLE 01340505 IVTNUM = 3 01350505 IVI = IXVI 01360505 IF (IVI - 21) 20030, 10030, 20030 01370505 10030 IVPASS = IVPASS + 1 01380505 WRITE (NUVI, 80002) IVTNUM 01390505 GO TO 0031 01400505 20030 IVFAIL = IVFAIL + 1 01410505 IVCORR = 21 01420505 WRITE (NUVI, 80010) IVTNUM, IVI, IVCORR 01430505 0031 CONTINUE 01440505 CT004* TEST 4 DOUBLE PRECISION VARIABLE 01450505 IVTNUM = 4 01460505 AVD = AXVD 01470505 IF (AVD - 0.12345D+01) 20040, 10040, 40040 01480505 40040 IF (AVD - 0.12347D+01) 10040, 10040, 20040 01490505 10040 IVPASS = IVPASS + 1 01500505 WRITE (NUVI, 80002) IVTNUM 01510505 GO TO 0041 01520505 20040 IVFAIL = IVFAIL + 1 01530505 DVCORR = 1.23456D+0 01540505 WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01550505 0041 CONTINUE 01560505 CT005* TEST 5 COMPLEX VARIABLE 01570505 IVTNUM = 5 01580505 AVC = AXVC 01590505 IF (R2E(1) - 0.23421E+03) 20050, 40052, 40051 01600505 40051 IF (R2E(1) - 0.23425E+03) 40052, 40052, 20050 01610505 40052 IF (R2E(2) - 0.34898E+02) 20050, 10050, 40050 01620505 40050 IF (R2E(2) - 0.34902E+02) 10050, 10050, 20050 01630505 10050 IVPASS = IVPASS + 1 01640505 WRITE (NUVI, 80002) IVTNUM 01650505 GO TO 0051 01660505 20050 IVFAIL = IVFAIL + 1 01670505 ZVCORR = (234.23, 34.9) 01680505 WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01690505 0051 CONTINUE 01700505 CT006* TEST 6 LOGICAL VARIABLE 01710505 IVTNUM = 6 01720505 IVI = 0 01730505 IF (AXVB) IVI = 1 01740505 IF (IVI - 1) 20060, 10060, 20060 01750505 10060 IVPASS = IVPASS + 1 01760505 WRITE (NUVI, 80002) IVTNUM 01770505 GO TO 0061 01780505 20060 IVFAIL = IVFAIL + 1 01790505 LVCORR = 1 01800505 REMRKS = '1 = TRUE ; 0 = FALSE' 01810505 WRITE (NUVI, 80008) IVTNUM, REMRKS 01820505 WRITE (NUVI, 80024) IVI 01830505 WRITE (NUVI, 80026) LVCORR 01840505 0061 CONTINUE 01850505 CT007* TEST 7 6 CHARACTER VARIABLE - INIT WITH 5 CHARACTERS 01860505 IVTNUM = 7 01870505 IVI = 0 01880505 IF (A6XVK.EQ.'ABCDE ') IVI = 1 01890505 IF (IVI - 1) 20070, 10070, 20070 01900505 10070 IVPASS = IVPASS + 1 01910505 WRITE (NUVI, 80002) IVTNUM 01920505 GO TO 0071 01930505 20070 IVFAIL = IVFAIL + 1 01940505 CVCORR = 'ABCDE ' 01950505 WRITE (NUVI, 80018) IVTNUM, A6XVK, CVCORR 01960505 0071 CONTINUE 01970505 CT008* TEST 8 6 CHARACTER VARIABLE - INIT WITH 6 CHARACTERS 01980505 IVTNUM = 8 01990505 IVI = 0 02000505 IF (B6XVK.EQ.'FGHIJK') IVI = 1 02010505 IF (IVI - 1) 20080, 10080, 20080 02020505 10080 IVPASS = IVPASS + 1 02030505 WRITE (NUVI, 80002) IVTNUM 02040505 GO TO 0081 02050505 20080 IVFAIL = IVFAIL + 1 02060505 CVCORR = 'FGHIJK' 02070505 WRITE (NUVI, 80018) IVTNUM, B6XVK, CVCORR 02080505 0081 CONTINUE 02090505 C***** 02100505 CBB** ********************** BBCSUM0 **********************************02110505 C**** WRITE OUT TEST SUMMARY 02120505 C**** 02130505 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02140505 WRITE (I02, 90004) 02150505 WRITE (I02, 90014) 02160505 WRITE (I02, 90004) 02170505 WRITE (I02, 90020) IVPASS 02180505 WRITE (I02, 90022) IVFAIL 02190505 WRITE (I02, 90024) IVDELE 02200505 WRITE (I02, 90026) IVINSP 02210505 WRITE (I02, 90028) IVTOTN, IVTOTL 02220505 CBE** ********************** BBCSUM0 **********************************02230505 CBB** ********************** BBCFOOT0 **********************************02240505 C**** WRITE OUT REPORT FOOTINGS 02250505 C**** 02260505 WRITE (I02,90016) ZPROG, ZPROG 02270505 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02280505 WRITE (I02,90019) 02290505 CBE** ********************** BBCFOOT0 **********************************02300505 CBB** ********************** BBCFMT0A **********************************02310505 C**** FORMATS FOR TEST DETAIL LINES 02320505 C**** 02330505 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02340505 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02350505 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02360505 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02370505 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02380505 1I6,/," ",15X,"CORRECT= " ,I6) 02390505 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02400505 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02410505 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02420505 1A21,/," ",16X,"CORRECT= " ,A21) 02430505 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02440505 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02450505 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02460505 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02470505 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02480505 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02490505 80050 FORMAT (" ",48X,A31) 02500505 CBE** ********************** BBCFMT0A **********************************02510505 CBB** ********************** BBCFMAT1 **********************************02520505 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02530505 C**** 02540505 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02550505 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02560505 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02570505 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02580505 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02590505 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02600505 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02610505 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02620505 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02630505 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02640505 2"(",F12.5,", ",F12.5,")") 02650505 CBE** ********************** BBCFMAT1 **********************************02660505 CBB** ********************** BBCFMT0B **********************************02670505 C**** FORMAT STATEMENTS FOR PAGE HEADERS 02680505 C**** 02690505 90002 FORMAT ("1") 02700505 90004 FORMAT (" ") 02710505 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02720505 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02730505 90008 FORMAT (" ",21X,A13,A17) 02740505 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02750505 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02760505 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02770505 1 7X,"REMARKS",24X) 02780505 90014 FORMAT (" ","----------------------------------------------" , 02790505 1 "---------------------------------" ) 02800505 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02810505 C**** 02820505 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02830505 C**** 02840505 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02850505 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02860505 1 A13) 02870505 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02880505 C**** 02890505 C**** FORMAT STATEMENTS FOR RUN SUMMARY 02900505 C**** 02910505 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02920505 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02930505 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02940505 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02950505 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02960505 CBE** ********************** BBCFMT0B **********************************02970505 C***** 02980505 END 02990505