**********00010501 * FORTRAN 77 00020501 FM501 SN501 - (251) 00030501 * THIS SUBROUTINE IS CALLED BY PROGRAM FM500 00040501 **********00050501 00060501 * GENERAL PURPOSE 00070501 THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 250 00080501 * THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090501 IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY 00100501 * VARIABLES 00110501 00120501 BB *** BBCCOMNT ******00130501 00140501 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150501 VERSION 2.1 00160501 00170501 00180501 SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190501 NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200501 SOFTWARE STANDARDS VALIDATION GROUP 00210501 BUILDING 225 RM A266 00220501 GAITHERSBURG, MD 20899 00230501 00240501 00250501 00260501 BE *** BBCCOMNT ******00270501 **********00010502 FORTRAN 77 00020502 * FM502 AN502 00030502 THIS BLOCK DATA SUBPROGRAM IS USED BY MIAN PROGRAM FM500 00040502 **********00050502 * 00060502 GENERAL PURPOSE 00070502 * THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS 00080502 TO BE RUN WITH SEGMENT FM500 00090502 * THIS SEGMENT WILL USE IMPLICIT, PARAMETER, EXTERNAL 00100502 AND SAVE STATEMENTS WITHIN IT. 00110502 ** 00120502
PROGRAM FM500 C***********************************************************************00010500 C***** FORTRAN 77 00020500 C***** FM500 00030500 C***** BLKD1 - (260) 00040500 C***** THIS PROGRAM USES SN501 AND AN502 00050500 C***********************************************************************00060500 C***** TESTING OF BLOCK DATA SUBPROGRAMS FEATURES ANS REF 00070500 C***** IMPLICIT, PARAMETER, EXTERNAL, AND SAVE 16 00080500 C***** THIS SEGMENT USES BLOCK DATA PROGRAM 00090500 C***** AN502 AND SUBROUTINE SN501 00100500 C***** 00110500 C***** S P E C I F I C A T I O N S SEGMENT 260 00120500 EXTERNAL AN502 00130500 C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00140500 C***** PARAMETER (KPI = 2, LPI = 10) 00150500 C***** INTEGER FXVI 00160500 C***** REAL JX1S 00170500 C***** DOUBLE PRECISION AX1D, BX4D 00180500 C***** DIMENSION BX4D(KPI, KPI, KPI, KPI) 00190500 C***** COMPLEX AXVC, BX1C, CZ5C 00200500 C***** LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00210500 C***** CHARACTER*1 A1XVK, B1X1K, C1X7K 00220500 C***** CHARACTER*2 D2Z1K 00230500 C***** CHARACTER*4 E4XVK, G4X2K 00240500 C***** CHARACTER*(LPI) I10XVK 00250500 C***** 00260500 C***** COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00270500 C***** COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00280500 C***** COMMON /BLK3/ RXVD, AX1D(2), BX4D 00290500 C***** COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00300500 C***** COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00310500 C***** COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00320500 C***** S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00330500 C***** 00340500 CALL SN501 00350500 STOP 00360500 C***** END OF TEST SEGMENT 260 00370500 END 00380500 C***********************************************************************00010501 C***** FORTRAN 77 00020501 C***** FM501 SN501 - (251) 00030501 C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM500 00040501 C***********************************************************************00050501 C***** 00060501 C***** GENERAL PURPOSE 00070501 C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 250 00080501 C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090501 C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY 00100501 C***** VARIABLES 00110501 C***** 00120501 CBB** ********************** BBCCOMNT **********************************00130501 C**** 00140501 C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150501 C**** VERSION 2.1 00160501 C**** 00170501 C**** 00180501 C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190501 C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200501 C**** SOFTWARE STANDARDS VALIDATION GROUP 00210501 C**** BUILDING 225 RM A266 00220501 C**** GAITHERSBURG, MD 20899 00230501 C**** 00240501 C**** 00250501 C**** 00260501 CBE** ********************** BBCCOMNT **********************************00270501 SUBROUTINE SN501 00280501 C***** 00290501 IMPLICIT INTEGER (H) 00300501 IMPLICIT DOUBLE PRECISION (R) 00310501 IMPLICIT CHARACTER*2 (S) 00320501 C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00330501 PARAMETER (KPI = 2, LPI = 10) 00340501 INTEGER FXVI 00350501 REAL JX1S 00360501 DOUBLE PRECISION AX1D, BX4D, DVCORR 00370501 DIMENSION BX4D(KPI, KPI, KPI, KPI) 00380501 COMPLEX AXVC, BX1C, CZ5C 00390501 LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00400501 CHARACTER*1 A1XVK, B1X1K, C1X7K, CVNC01 00410501 CHARACTER*2 D2Z1K, CVNC02 00420501 CHARACTER*4 E4XVK, G4X2K, CVNC04 00430501 CHARACTER*(LPI) I10XVK, CVNC10 00440501 C***** 00450501 COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00460501 COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00470501 COMMON /BLK3/ RXVD, AX1D(2), BX4D 00480501 COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00490501 COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00500501 COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00510501 1 S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00520501 C***** 00530501 SAVE/BLK6/ 00540501 C***** 00550501 EQUIVALENCE (NYVI, EZVS) 00560501 C***** LOCAL DECLARATIONS 00570501 DOUBLE PRECISION AVD 00580501 COMPLEX AVC 00590501 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. 00600501 CBB** ********************** BBCINITA **********************************00610501 C**** SPECIFICATION STATEMENTS 00620501 C**** 00630501 CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00640501 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00650501 CBE** ********************** BBCINITA **********************************00660501 CBB** ********************** BBCINITB **********************************00670501 C**** INITIALIZE SECTION 00680501 DATA ZVERS, ZVERSD, ZDATE 00690501 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00700501 DATA ZCOMPL, ZNAME, ZTAPE 00710501 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00720501 DATA ZPROJ, ZTAPED, ZPROG 00730501 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00740501 DATA REMRKS /' '/ 00750501 C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00760501 C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00770501 C**** 00780501 CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00790501 CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00800501 CZ03 ZPROG = 'PROGRAM NAME' 00810501 CZ04 ZDATE = 'DATE OF TEST' 00820501 CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00830501 CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00840501 CZ07 ZNAME = 'NAME OF USER' 00850501 CZ08 ZTAPE = 'TAPE OWNER/ID' 00860501 CZ09 ZTAPED = 'DATE TAPE COPIED' 00870501 C 00880501 IVPASS = 0 00890501 IVFAIL = 0 00900501 IVDELE = 0 00910501 IVINSP = 0 00920501 IVTOTL = 0 00930501 IVTOTN = 0 00940501 ICZERO = 0 00950501 C 00960501 C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00970501 I01 = 05 00980501 C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00990501 I02 = 06 01000501 C 01010501 CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01020501 C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01030501 CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01040501 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01050501 C 01060501 CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01070501 C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01080501 CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01090501 C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01100501 C 01110501 CBE** ********************** BBCINITB **********************************01120501 NWVI = I02 01130501 IVTOTL = 37 01140501 ZPROG='FM500' 01150501 CBB** ********************** BBCHED0A **********************************01160501 C**** 01170501 C**** WRITE REPORT TITLE 01180501 C**** 01190501 WRITE (I02, 90002) 01200501 WRITE (I02, 90006) 01210501 WRITE (I02, 90007) 01220501 WRITE (I02, 90008) ZVERS, ZVERSD 01230501 WRITE (I02, 90009) ZPROG, ZPROG 01240501 WRITE (I02, 90010) ZDATE, ZCOMPL 01250501 CBE** ********************** BBCHED0A **********************************01260501 C***** 01270501 WRITE(NWVI,26000) 01280501 26000 FORMAT( / " BLKD1 - (260) BLOCK DATA SUBPROGRAMS --" / 01290501 1 " IMPLICIT, PARAMETER, EXTERNAL, SAVE" // 01300501 2 " ANS REF. - 16" ) 01310501 C***** 01320501 CBB** ********************** BBCHED0B **********************************01330501 C**** WRITE DETAIL REPORT HEADERS 01340501 C**** 01350501 WRITE (I02,90004) 01360501 WRITE (I02,90004) 01370501 WRITE (I02,90013) 01380501 WRITE (I02,90014) 01390501 WRITE (I02,90015) IVTOTL 01400501 CBE** ********************** BBCHED0B **********************************01410501 C**** TO DELETE A TEST USED CODE SHOWN IN TEST 1 01420501 C**** REPLACE THE DELETE COMMENT WITH DELETE CODE 01430501 CT001* TEST 1 INTEGER VARIABLE 01440501 IVTNUM=1 01450501 WRITE (NWVI,70140) 01460501 IVCORR=5 01470501 40010 IF (IXVI - 5) 20010,10010,20010 01480501 10010 IVPASS=IVPASS+1 01490501 WRITE (NWVI,80002) IVTNUM 01500501 GO TO 0011 01510501 20010 IVFAIL=IVFAIL+1 01520501 WRITE (NWVI,80008) IVTNUM 01530501 WRITE (NWVI,80024) IXVI 01540501 WRITE (NWVI,80026) IVCORR 01550501 0011 CONTINUE 01560501 CT002* TEST 2 INTEGER DECLARE VARIABLE 01570501 IVTNUM = 2 01580501 IVCORR=6 01590501 IF (FXVI - 6) 20020,10020,20020 01600501 10020 IVPASS=IVPASS+1 01610501 WRITE (NWVI,80002) IVTNUM 01620501 GO TO 0021 01630501 20020 IVFAIL=IVFAIL+1 01640501 WRITE (NWVI,80008) IVTNUM 01650501 WRITE (NWVI,80024) FXVI 01660501 WRITE (NWVI,80026) IVCORR 01670501 0021 CONTINUE 01680501 CT003* TEST 3 INTEGER ARRAY 01690501 IVTNUM = 3 01700501 IVCORR=8 01710501 IF (KX1I(2) - 8) 20030,10030,20030 01720501 10030 IVPASS=IVPASS+1 01730501 WRITE (NWVI,80002) IVTNUM 01740501 GO TO 0031 01750501 20030 IVFAIL=IVFAIL+1 01760501 WRITE (NWVI,80008) IVTNUM 01770501 WRITE (NWVI,80024) KX1I(2) 01780501 WRITE (NWVI,80026) IVCORR 01790501 0031 CONTINUE 01800501 CT004* TEST 4 IMPLICIT INTEGER ARRAY 01810501 IVTNUM = 4 01820501 IVCORR=1 01830501 IF (HX2I(1,2) - 1) 20040,10040,20040 01840501 10040 IVPASS=IVPASS+1 01850501 WRITE (NWVI,80002) IVTNUM 01860501 GO TO 0041 01870501 20040 IVFAIL=IVFAIL+1 01880501 WRITE (NWVI,80008) IVTNUM 01890501 WRITE (NWVI,80024) HX2I(1,2) 01900501 WRITE (NWVI,80026) IVCORR 01910501 0041 CONTINUE 01920501 CT005* TEST 5 01930501 IVTNUM = 5 01940501 IVCORR=5 01950501 IF (HX2I(2,2) - 5) 20050,10050,20050 01960501 10050 IVPASS=IVPASS+1 01970501 WRITE (NWVI,80002) IVTNUM 01980501 GO TO 0051 01990501 20050 IVFAIL=IVFAIL+1 02000501 WRITE (NWVI,80008) IVTNUM 02010501 WRITE (NWVI,80024) HX2I(2,2) 02020501 WRITE (NWVI,80026) IVCORR 02030501 0051 CONTINUE 02040501 CT006* TEST 6 DO INITIALIZE INTEGER ARRAY 02050501 IVTNUM = 6 02060501 IVINSP=IVINSP+1 02070501 WRITE (NWVI,80004) IVTNUM 02080501 DO 70101 KVI = 1, 2 02090501 IVI = MX2I(KVI, KVI) - 4 02100501 WRITE (NWVI, 70100) IVI 02110501 70101 CONTINUE 02120501 CT007* TEST 7 REAL VARIABLE 02130501 IVTNUM = 7 02140501 RVCORR=5.3 02150501 RVCOMP=0.0 02160501 RVCOMP=AXVS - 5.3 02170501 IF (RVCOMP + .00005) 20070,10070,40070 02180501 40070 IF (RVCOMP - .00005) 10070,10070,20070 02190501 10070 IVPASS=IVPASS+1 02200501 WRITE (NWVI,80002) IVTNUM 02210501 GO TO 0071 02220501 20070 IVFAIL=IVFAIL+1 02230501 WRITE (NWVI,80008) IVTNUM 02240501 WRITE (NWVI,80028) AXVS 02250501 WRITE (NWVI,80030) RVCORR 02260501 0071 CONTINUE 02270501 CT008* TEST 8 EXTENDED PRECISION REAL 02280501 IVTNUM = 8 02290501 AVS = BXVS - 1.23456789012345 02300501 RVCOMP=1.23456789012345 02310501 IF (AVS + .00005) 20080,10080,40080 02320501 40080 IF (AVS - .00005) 10080,10080,20080 02330501 10080 IVPASS=IVPASS+1 02340501 WRITE (NWVI,80002) IVTNUM 02350501 GO TO 0081 02360501 20080 IVFAIL=IVFAIL+1 02370501 WRITE (NWVI,80004) IVTNUM 02380501 70080 FORMAT (" ",16X,"COMPUTED: " ,E20.14) 02390501 WRITE (NWVI,70080) BXVS 02400501 70081 FORMAT (" ",16X,"CORRECT: " ,E20.14) 02410501 WRITE (NWVI, 70081) RVCOMP 02420501 0081 CONTINUE 02430501 CT009* TEST 9 DECLARED REAL ARRAY 02440501 IVTNUM = 9 02450501 RVCORR=2.45 02460501 RVCOMP=2.0 02470501 RVCOMP=(JX1S(1) - 2.45) 02480501 IF (RVCOMP + .00005) 20090,10090,40090 02490501 40090 IF (RVCOMP - .00005) 10090,10090,20090 02500501 10090 IVPASS=IVPASS+1 02510501 WRITE (NWVI,80002) IVTNUM 02520501 GO TO 0091 02530501 20090 IVFAIL=IVFAIL+1 02540501 WRITE (NWVI,80008) IVTNUM 02550501 WRITE (NWVI,80028) JX1S(1) 02560501 WRITE (NWVI,80030) RVCORR 02570501 0091 CONTINUE 02580501 CT010* TEST 10 02590501 IVTNUM = 10 02600501 RVCORR=4.58 02610501 RVCOMP=2.0 02620501 RVCOMP=(JX1S(2) - 4.58) 02630501 40100 IF (RVCOMP + .00005) 20100,10100,40101 02640501 40101 IF (RVCOMP - .00005) 10100,10100,20100 02650501 10100 IVPASS=IVPASS+1 02660501 WRITE (NWVI,80002) 02670501 GO TO 0100 02680501 20100 IVFAIL=IVFAIL+1 02690501 WRITE (NWVI,80008) IVTNUM 02700501 WRITE (NWVI,80028) JX1S(2) 02710501 WRITE (NWVI,80030) RVCORR 02720501 0100 CONTINUE 02730501 CT011* TEST 11 REAL ARRAY - NAME ONLY 02740501 IVTNUM = 11 02750501 IVINSP=IVINSP+1 02760501 WRITE (NWVI,80004) IVTNUM 02770501 DO 70103 KVI = 1, 2 02780501 AVS = CX2S(KVI, KVI) - 1.2 02790501 WRITE (NWVI, 70102) AVS 02800501 70103 CONTINUE 02810501 CT012* TEST 12 EQUIVALENCED REAL ARRAY 02820501 IVTNUM = 12 02830501 IVINSP=IVINSP+1 02840501 WRITE (NWVI,80004) IVTNUM 02850501 DO 70104 KVI=1,2 02860501 AVS = DZ3S(KVI, KVI, KVI) - 1.1 02870501 WRITE (NWVI, 70102) AVS 02880501 70104 CONTINUE 02890501 CT013* TEST 13 REAL VARIABLE - EQUIVALENCED INTEGER 02900501 IVTNUM = 13 02910501 IVCORR=34 02920501 IVI = NYVI - 34 02930501 40130 IF (IVI - 0) 20130,10130,20130 02940501 10130 IVPASS=IVPASS+1 02950501 WRITE (NWVI,80002) IVTNUM 02960501 GO TO 0131 02970501 20130 IVFAIL=IVFAIL+1 02980501 WRITE (NWVI,80008) IVTNUM 02990501 WRITE (NWVI,80028) NYVI 03000501 WRITE (NWVI,80026) IVCORR 03010501 0131 CONTINUE 03020501 CT014* TEST 14 DOUBLE PRECISION ARRAY 03030501 IVTNUM = 14 03040501 KVI=1 03050501 AVD = AX1D(KVI) - 1.456D3 03060501 DVCORR=1.456D3 03070501 IF (AVD + .0000000005) 20140,40141,40140 03080501 40140 IF (AVD - .0000000005) 40141,40141,20140 03090501 40141 KVI=2 03100501 AVD = AX1D(KVI) - 1.456D3 03110501 IF (AVD + .0000000005) 20140,10140,40142 03120501 40142 IF (AVD - .0000000005) 10140,10140,20140 03130501 10140 IVPASS=IVPASS+1 03140501 WRITE (NWVI,80002) IVTNUM 03150501 GO TO 0141 03160501 20140 IVFAIL=IVFAIL+1 03170501 WRITE (NWVI,80008) IVTNUM 03180501 WRITE (NWVI, 80033) AX1D(KVI) 03190501 WRITE (NWVI,80035) DVCORR 03200501 0141 CONTINUE 03210501 CT015* TEST 15 DIMENSION DOUBLE PRECISION ARRAY 03220501 IVTNUM = 15 03230501 AVD = BX4D(1,2,1,1) - 34.9D8 03240501 IF (AVD + .0000000005) 20150,10150,40150 03250501 40150 IF (AVD - .0000000005) 10150,10150,20150 03260501 10150 IVPASS=IVPASS+1 03270501 WRITE (NWVI,80002) IVTNUM 03280501 GO TO 0151 03290501 20150 IVFAIL=IVFAIL+1 03300501 DVCORR=34.9D8 03310501 WRITE (NWVI,80008) IVTNUM 03320501 WRITE (NWVI, 80033) BX4D(1,2,1,1) 03330501 WRITE (NWVI,80035) DVCORR 03340501 0151 CONTINUE 03350501 CT016* TEST 16 03360501 IVTNUM = 16 03370501 DVCORR=0.00 03380501 AVD = BX4D(1,2,1,2) - 2.123D0 03390501 IF (AVD + .0000000005) 20160,10160,40160 03400501 40160 IF (AVD - .0000000005) 10160,10160,20160 03410501 10160 IVPASS=IVPASS+1 03420501 WRITE (NWVI,80002) IVTNUM 03430501 GO TO 0161 03440501 20160 IVFAIL=IVFAIL+1 03450501 DVCORR=2.123D0 03460501 WRITE (NWVI,80008) IVTNUM 03470501 WRITE (NWVI, 80033) BX4D(1,2,1,2) 03480501 WRITE (NWVI,80035) DVCORR 03490501 0161 CONTINUE 03500501 CT017* TEST 17 03510501 IVTNUM = 17 03520501 DVCORR=0.00 03530501 AVD = BX4D(2,1,1,2) - 873.84D-1 03540501 IF (AVD + .0000000005) 20170,10170,40170 03550501 40170 IF (AVD - .0000000005) 10170,10170,20170 03560501 10170 IVPASS=IVPASS+1 03570501 WRITE (NWVI,80002) IVTNUM 03580501 GO TO 0171 03590501 20170 IVFAIL=IVFAIL+1 03600501 WRITE (NWVI,80008) IVTNUM 03610501 DVCORR=873.84D-1 03620501 WRITE (NWVI, 80033) BX4D(2,1,1,2) 03630501 WRITE (NWVI,80035) DVCORR 03640501 0171 CONTINUE 03650501 CT018* TEST 18 COMPLEX VARIABLE 03660501 IVTNUM = 18 03670501 AVC = AXVC - (1.5, 2.3) 03680501 IVINSP=IVINSP+1 03690501 WRITE (NWVI,80004) IVTNUM 03700501 WRITE (NWVI,70107) AVC 03710501 CT019* TEST 19 COMPLEX ARRAY 03720501 IVTNUM = 19 03730501 AVC = BX1C(1) - (1.1, 1.2) 03740501 IVINSP=IVINSP+1 03750501 WRITE (NWVI,80004) IVTNUM 03760501 WRITE (NWVI, 70107) AVC 03770501 CT020* TEST 20 03780501 IVTNUM = 20 03790501 AVC = BX1C(2) - (3.2, 2.3) 03800501 IVINSP=IVINSP+1 03810501 WRITE (NWVI,80004) IVTNUM 03820501 WRITE (NWVI, 70107) AVC 03830501 CT021* TEST 21 COMPLEX ARRAY - EQUIVALENCE 03840501 IVTNUM = 21 03850501 AVC = CZ5C(1,1,1,2,1) - (1.2, 2.1) 03860501 IVINSP=IVINSP+1 03870501 WRITE (NWVI,80004) IVTNUM 03880501 WRITE (NWVI, 70107) AVC 03890501 CT022* TEST 22 03900501 IVTNUM = 22 03910501 AVC = CZ5C(1,2,1,1,2) - (45.3, 2.1) 03920501 IVINSP=IVINSP+1 03930501 WRITE (NWVI,80004) IVTNUM 03940501 WRITE (NWVI, 70107) AVC 03950501 CT023* TEST 23 03960501 IVTNUM = 23 03970501 AVC = CZ5C(2,1,1,1,2) - (309.89, 102.1) 03980501 IVINSP=IVINSP+1 03990501 WRITE (NWVI,80004) IVTNUM 04000501 WRITE (NWVI, 70107) AVC 04010501 CT024* TEST 24 LOGICAL VARIABLE 04020501 IVTNUM = 24 04030501 IVCOMP=0 04040501 IF (AXVB) IVCOMP=1 04050501 40240 IF (IVCOMP-1) 20240,10240,20240 04060501 10240 IVPASS=IVPASS+1 04070501 WRITE (NWVI,80002) IVTNUM 04080501 GO TO 0241 04090501 20240 IVFAIL=IVFAIL+1 04100501 WRITE (NWVI,80008) IVTNUM 04110501 0241 CONTINUE 04120501 CT025* TEST 25 LOGICAL ARRAY - EQUIVALENCE 04130501 IVTNUM = 25 04140501 IVCOMP=0 04150501 IF (.NOT. BZ1B(2)) IVCOMP=1 04160501 40250 IF (IVCOMP-1) 20250,10250,20250 04170501 10250 IVPASS=IVPASS+1 04180501 WRITE (NWVI,80002) IVTNUM 04190501 GO TO 0251 04200501 20250 IVFAIL=IVFAIL+1 04210501 WRITE (NWVI,80008) IVTNUM 04220501 0251 CONTINUE 04230501 CT026* TEST 26 DECLARED LOGICAL ARRAY 04240501 IVTNUM = 26 04250501 IVCOMP=0 04260501 IF (CX6B(1,1,1,2,2,1)) IVCOMP=1 04270501 40260 IF (IVCOMP-1) 20260,10260,20260 04280501 10260 IVPASS=IVPASS+1 04290501 WRITE (NWVI,80002) IVTNUM 04300501 GO TO 0261 04310501 20260 IVFAIL=IVFAIL+1 04320501 WRITE (NWVI,80008) IVTNUM 04330501 0261 CONTINUE 04340501 CT027* TEST 27 1 CHARACTER VARIABLE 04350501 IVTNUM = 27 04360501 CVNC01='A' 04370501 IVCOMP=0 04380501 IF (A1XVK .EQ. 'A') IVCOMP=1 04390501 40270 IF (IVCOMP-1) 20270,10270,20270 04400501 10270 IVPASS=IVPASS+1 04410501 WRITE (NWVI,80002) IVTNUM 04420501 GO TO 0271 04430501 20270 IVFAIL=IVFAIL+1 04440501 WRITE (NWVI,80008) IVTNUM 04450501 WRITE (NWVI,80020) A1XVK 04460501 WRITE (NWVI,80022) CVNC01 04470501 0271 CONTINUE 04480501 CT028* TEST 28 1 CHARACTER ARRAY 04490501 IVTNUM = 28 04500501 CVNC01='K' 04510501 IVCOMP=0 04520501 IF (B1X1K(1) .EQ. 'K') IVCOMP=1 04530501 40280 IF (IVCOMP-1) 20280,10280,20280 04540501 10280 IVPASS=IVPASS+1 04550501 WRITE (NWVI,80002) IVTNUM 04560501 GO TO 0281 04570501 20280 IVFAIL=IVFAIL+1 04580501 WRITE (NWVI,80008) IVTNUM 04590501 WRITE (NWVI,80020) B1X1K(1) 04600501 WRITE (NWVI,80022) CVNC01 04610501 0281 CONTINUE 04620501 CT029* TEST 29 04630501 IVTNUM = 29 04640501 CVNC01='K' 04650501 IVCOMP=0 04660501 IF (B1X1K(2) .EQ. 'K') IVCOMP=1 04670501 IF (IVCOMP-1) 20290,10290,20290 04680501 10290 IVPASS=IVPASS+1 04690501 WRITE (NWVI,80002) IVTNUM 04700501 GO TO 0291 04710501 20290 IVFAIL=IVFAIL+1 04720501 WRITE (NWVI,80008) IVTNUM 04730501 WRITE (NWVI,80020) B1X1K(2) 04740501 WRITE (NWVI,80022) CVNC01 04750501 0291 CONTINUE 04760501 CT030* TEST 30 7 DIMENSION 1 CHARACTER ARRAY 04770501 IVTNUM = 30 04780501 CVNC01='X' 04790501 IVCOMP=0 04800501 KVI=1 04810501 IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1 04820501 40300 IF(IVCOMP-1) 20300,40301,20300 04830501 40301 KVI=2 04840501 IVCOMP=0 04850501 IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1 04860501 40302 IF (IVCOMP-1) 20300,40303,20300 04870501 40303 IVPASS=IVPASS+1 04880501 WRITE (NWVI,80002) IVTNUM 04890501 GO TO 0301 04900501 20300 IVFAIL=IVFAIL+1 04910501 WRITE (NWVI,80008) IVTNUM 04920501 WRITE (NWVI,80020) C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) 04930501 WRITE (NWVI,80022) CVNC01 04940501 0301 CONTINUE 04950501 CT031* TEST 31 IMPLICIT 2 CHARACTER VARIABLE 04960501 IVTNUM = 31 04970501 CVNC02='.,' 04980501 IVCOMP=0 04990501 IF (S2XVK .EQ. '.,') IVCOMP=1 05000501 40310 IF (IVCOMP-1) 20310,10310,20310 05010501 10310 IVPASS=IVPASS+1 05020501 WRITE (NWVI,80002) IVTNUM 05030501 GO TO 0311 05040501 20310 IVFAIL=IVFAIL+1 05050501 WRITE (NWVI,80008) IVTNUM 05060501 WRITE (NWVI,80020) S2XVK 05070501 WRITE (NWVI,80022) CVNC02 05080501 0311 CONTINUE 05090501 CT032* TEST 32 2 CHARACTER ARRAY - EQUIVALENCED 05100501 IVTNUM = 32 05110501 CVNC02='TE' 05120501 IVCOMP=0 05130501 IF (D2Z1K(1) .EQ. 'TE') IVCOMP=1 05140501 40320 IF (IVCOMP-1) 20320,10320,20320 05150501 10320 IVPASS=IVPASS+1 05160501 WRITE (NWVI,80002) IVTNUM 05170501 GO TO 0321 05180501 20320 IVFAIL=IVFAIL+1 05190501 WRITE (NWVI,80008) IVTNUM 05200501 WRITE (NWVI,80020) D2Z1K(1) 05210501 WRITE (NWVI,80022) CVNC02 05220501 0321 CONTINUE 05230501 CT033* TEST 33 05240501 IVTNUM = 33 05250501 CVNC02='ST' 05260501 IVCOMP=0 05270501 IF (D2Z1K(2) .EQ. 'ST') IVCOMP=1 05280501 40330 IF (IVCOMP-1) 20330,10330,20330 05290501 10330 IVPASS=IVPASS+1 05300501 WRITE (NWVI,80002) IVTNUM 05310501 GO TO 0331 05320501 20330 IVFAIL=IVFAIL+1 05330501 WRITE (NWVI,80008) IVTNUM 05340501 WRITE (NWVI,80020) D2Z1K(2) 05350501 WRITE (NWVI,80022) CVNC02 05360501 0331 CONTINUE 05370501 CT034* TEST 34 DECLARED 4 CHARACTER VARIABLE 05380501 IVTNUM = 34 05390501 CVNC04='ZXCV' 05400501 IVCOMP=0 05410501 IF (E4XVK .EQ. 'ZXCV') IVCOMP=1 05420501 40340 IF (IVCOMP-1) 20340,10340,20340 05430501 10340 IVPASS=IVPASS+1 05440501 WRITE (NWVI,80002) IVTNUM 05450501 GO TO 0341 05460501 20340 IVFAIL=IVFAIL+1 05470501 WRITE (NWVI,80008) IVTNUM 05480501 WRITE (NWVI,80020) E4XVK 05490501 WRITE (NWVI,80022) CVNC04 05500501 0341 CONTINUE 05510501 CT035* TEST 35 DECLARED 4 CHARACTER ARRAY 05520501 IVTNUM = 35 05530501 CVNC02='SO' 05540501 IVCOMP=0 05550501 IF (G4X2K(1,1) .EQ. 'SO') IVCOMP=1 05560501 40350 IF (IVCOMP-1) 20350,10350,20350 05570501 10350 IVPASS=IVPASS+1 05580501 WRITE (NWVI,80002) IVTNUM 05590501 GO TO 0351 05600501 20350 IVFAIL=IVFAIL+1 05610501 WRITE (NWVI,80008) IVTNUM 05620501 WRITE (NWVI,80020) G4X2K(1,1) 05630501 WRITE (NWVI,80022) CVNC02 05640501 0351 CONTINUE 05650501 CT036* TEST 36 05660501 IVTNUM = 36 05670501 CVNC02='OS' 05680501 IVCOMP=0 05690501 IF (G4X2K(2,1) .EQ. 'OS') IVCOMP=1 05700501 40360 IF (IVCOMP-1) 20360,10360,20360 05710501 10360 IVPASS=IVPASS+1 05720501 WRITE (NWVI,80002) IVTNUM 05730501 GO TO 0361 05740501 20360 IVFAIL=IVFAIL+1 05750501 WRITE (NWVI,80008) IVTNUM 05760501 WRITE (NWVI,80020) G4X2K(2,1) 05770501 WRITE (NWVI,80022) CVNC02 05780501 0361 CONTINUE 05790501 CT037* TEST 37 CHARACTER VARIABLE - PARAMTER LENGTH 05800501 IVTNUM = 37 05810501 CVNC10='FINAL TEST' 05820501 IVCOMP=0 05830501 IF (I10XVK .EQ. 'FINAL TEST') IVCOMP=1 05840501 40370 IF (IVCOMP-1) 20370, 10370, 20370 05850501 10370 IVPASS=IVPASS+1 05860501 WRITE (NWVI,80002) IVTNUM 05870501 GO TO 0371 05880501 20370 IVFAIL=IVFAIL+1 05890501 WRITE (NWVI,80008) IVTNUM 05900501 WRITE (NWVI,80020) I10XVK 05910501 WRITE (NWVI,80022) CVNC10 05920501 0371 CONTINUE 05930501 C***** 05940501 70100 FORMAT(" ",26X,I5) 05950501 70102 FORMAT(" ",26X,F7.2) 05960501 70106 FORMAT(" ",26X,F7.2) 05970501 70107 FORMAT(" ",26X,"(",F7.2,", ",F7.2,")",4X,"SHOULD BE ZERO" ) 05980501 70140 FORMAT (/49X,"ALL VISUAL ANSWERS SHOULD BE" 05990501 1 /49X,"ZERO FOR TEST SEGMENT TO BE" 06000501 2 /49X,"SUCCESSFUL" ) 06010501 CBB** ********************** BBCSUM0 **********************************06020501 C**** WRITE OUT TEST SUMMARY 06030501 C**** 06040501 IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 06050501 WRITE (I02, 90004) 06060501 WRITE (I02, 90014) 06070501 WRITE (I02, 90004) 06080501 WRITE (I02, 90020) IVPASS 06090501 WRITE (I02, 90022) IVFAIL 06100501 WRITE (I02, 90024) IVDELE 06110501 WRITE (I02, 90026) IVINSP 06120501 WRITE (I02, 90028) IVTOTN, IVTOTL 06130501 CBE** ********************** BBCSUM0 **********************************06140501 CBB** ********************** BBCFOOT0 **********************************06150501 C**** WRITE OUT REPORT FOOTINGS 06160501 C**** 06170501 WRITE (I02,90016) ZPROG, ZPROG 06180501 WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 06190501 WRITE (I02,90019) 06200501 CBE** ********************** BBCFOOT0 **********************************06210501 CBB** ********************** BBCFMT0A **********************************06220501 C**** FORMATS FOR TEST DETAIL LINES 06230501 C**** 06240501 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 06250501 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 06260501 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 06270501 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 06280501 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 06290501 1I6,/," ",15X,"CORRECT= " ,I6) 06300501 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06310501 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 06320501 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06330501 1A21,/," ",16X,"CORRECT= " ,A21) 06340501 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 06350501 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 06360501 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 06370501 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 06380501 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 06390501 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 06400501 80050 FORMAT (" ",48X,A31) 06410501 CBE** ********************** BBCFMT0A **********************************06420501 CBB** ********************** BBCFMAT1 **********************************06430501 C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 06440501 C**** 06450501 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06460501 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 06470501 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 06480501 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 06490501 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06500501 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06510501 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06520501 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06530501 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06540501 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 06550501 2"(",F12.5,", ",F12.5,")") 06560501 CBE** ********************** BBCFMAT1 **********************************06570501 CBB** ********************** BBCFMT0B **********************************06580501 C**** FORMAT STATEMENTS FOR PAGE HEADERS 06590501 C**** 06600501 90002 FORMAT ("1") 06610501 90004 FORMAT (" ") 06620501 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )06630501 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06640501 90008 FORMAT (" ",21X,A13,A17) 06650501 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 06660501 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 06670501 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 06680501 1 7X,"REMARKS",24X) 06690501 90014 FORMAT (" ","----------------------------------------------" , 06700501 1 "---------------------------------" ) 06710501 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 06720501 C**** 06730501 C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 06740501 C**** 06750501 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 06760501 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 06770501 1 A13) 06780501 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 06790501 C**** 06800501 C**** FORMAT STATEMENTS FOR RUN SUMMARY 06810501 C**** 06820501 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 06830501 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 06840501 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 06850501 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 06860501 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 06870501 CBE** ********************** BBCFMT0B **********************************06880501 C***** 06890501 RETURN 06900501 END 06910501 C***********************************************************************00010502 C***** FORTRAN 77 00020502 C***** FM502 AN502 00030502 C***** THIS BLOCK DATA SUBPROGRAM IS USED BY MIAN PROGRAM FM500 00040502 C***********************************************************************00050502 C***** 00060502 C***** GENERAL PURPOSE 00070502 C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS 00080502 C***** TO BE RUN WITH SEGMENT FM500 00090502 C***** THIS SEGMENT WILL USE IMPLICIT, PARAMETER, EXTERNAL 00100502 C***** AND SAVE STATEMENTS WITHIN IT. 00110502 C***** 00120502 BLOCK DATA AN502 00130502 C***** 00140502 IMPLICIT INTEGER (H) 00150502 IMPLICIT DOUBLE PRECISION (R) 00160502 IMPLICIT CHARACTER*2 (S) 00170502 C***** 00180502 SAVE/BLK6/ 00190502 C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00200502 PARAMETER (KPI = 2, LPI = 10) 00210502 INTEGER FXVI 00220502 REAL JX1S 00230502 DOUBLE PRECISION AX1D, BX4D 00240502 DIMENSION BX4D(KPI, KPI, KPI, KPI) 00250502 COMPLEX AXVC, BX1C, CZ5C 00260502 LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00270502 CHARACTER*1 A1XVK, B1X1K, C1X7K 00280502 CHARACTER*2 D2Z1K 00290502 CHARACTER*4 E4XVK, G4X2K 00300502 CHARACTER*(LPI) I10XVK 00310502 C***** 00320502 COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00330502 COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00340502 COMMON /BLK3/ RXVD, AX1D(2), BX4D 00350502 COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00360502 COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00370502 COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00380502 1 S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00390502 C***** DECLARATION OF VARIABLES FOR EQUIVALENCE STATEMENTS 00400502 DIMENSION AY3S(2,2,2) 00410502 COMPLEX AY5C (2,2,2,2,2) 00420502 LOGICAL AY1B(2) 00430502 CHARACTER*2 A2Y1K(2) 00440502 CHARACTER*1 APK 00450502 PARAMETER (IPI = 5, APS = 5.3, JPI = 2, APK = 'X', MPI = 128) 00460502 C***** 00470502 EQUIVALENCE (AY3S, DZ3S) 00480502 EQUIVALENCE (NYVI, EZVS) 00490502 EQUIVALENCE (AY5C, CZ5C) 00500502 EQUIVALENCE (AY1B, BZ1B) 00510502 EQUIVALENCE (A2Y1K, D2Z1K) 00520502 C***** 00530502 DATA IXVI, FXVI, KX1I(2), HX2I(1,2), HX2I(2,2), 00540502 1 ((MX2I(IVI, JVI), IVI=1,2), JVI=1,2) /IPI, 6, 8, 1, 5, 4*4/ 00550502 DATA AXVS, BXVS, JX1S(1), JX1S(2), CX2S /APS, 1.23456789012345, 00560502 1 2.45, 4.58, 4*1.2/ 00570502 DATA AY3S / 8*1.1/ 00580502 DATA NYVI /34/ 00590502 DATA AX1D, BX4D(1,2,1,1), BX4D(1,2,1,2), BX4D(2,1,1,2) 00600502 1 /JPI*1.456D3, 34.9D8, 2.123D0, 873.84D-1/ 00610502 DATA AXVC /(1.5, 2.3)/ 00620502 DATA AY5C(1,1,1,2,1), AY5C(1,2,1,1,2), AY5C(2,1,1,1,2) 00630502 1 /(1.2, 2.1), (45.3, 2.1), (309.89, 102.1)/ 00640502 DATA BX1C(1), BX1C(2), AXVB /(1.1, 1.2), (3.2, 2.3), .TRUE./ 00650502 DATA AY1B(2), CX6B(1,1,1,2,2,1) /.FALSE., .TRUE./ 00660502 DATA A1XVK, C1X7K, S2XVK, A2Y1K(1), A2Y1K(2), E4XVK, G4X2K(1,1),00670502 1 G4X2K(2,1), I10XVK, (B1X1K(IVI), IVI=1,2) 00680502 2 /'A', MPI*APK, '.,', 'TE', 'ST', 'ZXCV', 'SO', 'OS', 00690502 3 'FINAL TEST', 2*'K'/ 00700502 C***** 00710502 END 00720502