| PROGRAM FM506 |
| |
| C***********************************************************************00010506 |
| C***** FORTRAN 77 00020506 |
| C***** FM506 00030506 |
| C***** BLKD3 - (262) 00040506 |
| C***** USES BLOCK DATA SUBPROGRAM AN507 AND SUBROUTINE SN508 00050506 |
| C***********************************************************************00060506 |
| C***** TESTING OF BLOCK DATA SUBPROGRAMS ANS REF 00070506 |
| C***** VARYING CHARACTER VARIABLE LENGTHS 16 00080506 |
| C***** THIS SEGMENT USES SEGMENTS 704 AND 705, BLOCK DATA PROGRAM 00090506 |
| C***** AN507 AND SUBROUTINE SN508 00100506 |
| C***** 00110506 |
| CBB** ********************** BBCCOMNT **********************************00120506 |
| C**** 00130506 |
| C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140506 |
| C**** VERSION 2.1 00150506 |
| C**** 00160506 |
| C**** 00170506 |
| C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180506 |
| C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190506 |
| C**** SOFTWARE STANDARDS VALIDATION GROUP 00200506 |
| C**** BUILDING 225 RM A266 00210506 |
| C**** GAITHERSBURG, MD 20899 00220506 |
| C**** 00230506 |
| C**** 00240506 |
| C**** 00250506 |
| CBE** ********************** BBCCOMNT **********************************00260506 |
| C***** 00270506 |
| C***** S P E C I F I C A T I O N S SEGMENT 262 00280506 |
| C***** 00290506 |
| C***** CHARACTER*3 C3XVK, F3XVK 00300506 |
| C***** CHARACTER*2 D2XVK 00310506 |
| C***** CHARACTER*5 E5XVK 00320506 |
| C***** COMMON /BLK8/ C3XVK, D2XVK, E5XVK, F3XVK 00330506 |
| C***** 00340506 |
| NUVI = 4 00350506 |
| C***** 00360506 |
| CALL SN508(NUVI) 00370506 |
| C***** 00380506 |
| C***** END OF TEST SEGMENT 262 00390506 |
| STOP 00400506 |
| END 00410506 |
| |
| C***********************************************************************00010507 |
| C***** FORTRAN 77 00020507 |
| C***** FM507 BDS3 - (704) 00030507 |
| C***** BLOCK DATA SUBPROGRAM AN507 USED BY FM506 00040507 |
| C***********************************************************************00050507 |
| C***** 00060507 |
| C***** GENERAL PURPOSE 00070507 |
| C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS 00080507 |
| C***** TO BE RUN WITH TEST SEGMENT FM506 (262) 00090507 |
| C***** THIS SEGMENT WILL TEST CHARACTER VARIABLES WITH VARYING 00100507 |
| C***** LENGHTS IN COMMON AREAS 00110507 |
| C***** 00120507 |
| CBB** ********************** BBCCOMNT **********************************00130507 |
| C**** 00140507 |
| C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150507 |
| C**** VERSION 2.1 00160507 |
| C**** 00170507 |
| C**** 00180507 |
| C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190507 |
| C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200507 |
| C**** SOFTWARE STANDARDS VALIDATION GROUP 00210507 |
| C**** BUILDING 225 RM A266 00220507 |
| C**** GAITHERSBURG, MD 20899 00230507 |
| C**** 00240507 |
| C**** 00250507 |
| C**** 00260507 |
| CBE** ********************** BBCCOMNT **********************************00270507 |
| BLOCK DATA AN507 00280507 |
| C***** 00290507 |
| CHARACTER*3 C3XVK, F3XVK 00300507 |
| CHARACTER*2 D2XVK 00310507 |
| CHARACTER*5 E5XVK 00320507 |
| COMMON /BLK8/ C3XVK, D2XVK, E5XVK, F3XVK 00330507 |
| DATA C3XVK, D2XVK, E5XVK, F3XVK /'123', 'GH', 'LONGS', 'END'/ 00340507 |
| C***** 00350507 |
| END 00360507 |
| |
| C***********************************************************************00010508 |
| C***** FORTRAN 77 00020508 |
| C***** FM508 BLKD3Q - (705) 00030508 |
| C***** THIS SUBROUTINE IS CALLED BY FM506 00040508 |
| C***********************************************************************00050508 |
| C***** 00060508 |
| C***** GENERAL PURPOSE 00070508 |
| C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 262 00080508 |
| C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090508 |
| C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED CHARACTER 00100508 |
| C***** VARIABLES INTERMIXED WITH DIFFERENT LENGTHS 00110508 |
| C***** 00120508 |
| SUBROUTINE SN508 (NWVI) 00130508 |
| C***** 00140508 |
| CBB** ********************** BBCCOMNT **********************************00150508 |
| C**** 00160508 |
| C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00170508 |
| C**** VERSION 2.1 00180508 |
| C**** 00190508 |
| C**** 00200508 |
| C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00210508 |
| C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00220508 |
| C**** SOFTWARE STANDARDS VALIDATION GROUP 00230508 |
| C**** BUILDING 225 RM A266 00240508 |
| C**** GAITHERSBURG, MD 20899 00250508 |
| C**** 00260508 |
| C**** 00270508 |
| C**** 00280508 |
| CBE** ********************** BBCCOMNT **********************************00290508 |
| CHARACTER*3 C3XVK, F3XVK 00300508 |
| CHARACTER*2 D2XVK 00310508 |
| CHARACTER*5 E5XVK, CVCORR 00320508 |
| COMMON /BLK8/ C3XVK, D2XVK, E5XVK, F3XVK 00330508 |
| CBB** ********************** BBCINITA **********************************00340508 |
| C**** SPECIFICATION STATEMENTS 00350508 |
| C**** 00360508 |
| CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00370508 |
| 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00380508 |
| CBE** ********************** BBCINITA **********************************00390508 |
| CBB** ********************** BBCINITB **********************************00400508 |
| C**** INITIALIZE SECTION 00410508 |
| DATA ZVERS, ZVERSD, ZDATE 00420508 |
| 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00430508 |
| DATA ZCOMPL, ZNAME, ZTAPE 00440508 |
| 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00450508 |
| DATA ZPROJ, ZTAPED, ZPROG 00460508 |
| 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00470508 |
| DATA REMRKS /' '/ 00480508 |
| C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00490508 |
| C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00500508 |
| C**** 00510508 |
| CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00520508 |
| CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00530508 |
| CZ03 ZPROG = 'PROGRAM NAME' 00540508 |
| CZ04 ZDATE = 'DATE OF TEST' 00550508 |
| CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00560508 |
| CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00570508 |
| CZ07 ZNAME = 'NAME OF USER' 00580508 |
| CZ08 ZTAPE = 'TAPE OWNER/ID' 00590508 |
| CZ09 ZTAPED = 'DATE TAPE COPIED' 00600508 |
| C 00610508 |
| IVPASS = 0 00620508 |
| IVFAIL = 0 00630508 |
| IVDELE = 0 00640508 |
| IVINSP = 0 00650508 |
| IVTOTL = 0 00660508 |
| IVTOTN = 0 00670508 |
| ICZERO = 0 00680508 |
| C 00690508 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00700508 |
| I01 = 05 00710508 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00720508 |
| I02 = 06 00730508 |
| C 00740508 |
| CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00750508 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00760508 |
| CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00770508 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00780508 |
| C 00790508 |
| CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00800508 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00810508 |
| CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00820508 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00830508 |
| C 00840508 |
| CBE** ********************** BBCINITB **********************************00850508 |
| NUVI = I02 00860508 |
| IVTOTL = 4 00870508 |
| ZPROG = 'FM506' 00880508 |
| CBB** ********************** BBCHED0A **********************************00890508 |
| C**** 00900508 |
| C**** WRITE REPORT TITLE 00910508 |
| C**** 00920508 |
| WRITE (I02, 90002) 00930508 |
| WRITE (I02, 90006) 00940508 |
| WRITE (I02, 90007) 00950508 |
| WRITE (I02, 90008) ZVERS, ZVERSD 00960508 |
| WRITE (I02, 90009) ZPROG, ZPROG 00970508 |
| WRITE (I02, 90010) ZDATE, ZCOMPL 00980508 |
| CBE** ********************** BBCHED0A **********************************00990508 |
| C***** 01000508 |
| WRITE(NUVI,26200) 01010508 |
| 26200 FORMAT( " ", / " BLKD3 - (262) BLOCK DATA SUBPROGRAM --" // 01020508 |
| 1 " VARYING CHARACTER VARIABLE LENGTHS" // 01030508 |
| 2 " ANS REF. - 16" ) 01040508 |
| CBB** ********************** BBCHED0B **********************************01050508 |
| C**** WRITE DETAIL REPORT HEADERS 01060508 |
| C**** 01070508 |
| WRITE (I02,90004) 01080508 |
| WRITE (I02,90004) 01090508 |
| WRITE (I02,90013) 01100508 |
| WRITE (I02,90014) 01110508 |
| WRITE (I02,90015) IVTOTL 01120508 |
| CBE** ********************** BBCHED0B **********************************01130508 |
| C***** 01140508 |
| CT001* TEST 1 3 CHARACTER VARIABLE 01150508 |
| IVTNUM = 1 01160508 |
| IVCOMP = 0 01170508 |
| IF (C3XVK.EQ.'123') IVCOMP = 1 01180508 |
| IF (IVCOMP - 1) 20010, 10010, 20010 01190508 |
| 10010 IVPASS = IVPASS + 1 01200508 |
| WRITE (NUVI, 80002) IVTNUM 01210508 |
| GO TO 0011 01220508 |
| 20010 IVFAIL = IVFAIL + 1 01230508 |
| CVCORR = '123' 01240508 |
| WRITE (NUVI, 80018) IVTNUM, C3XVK, CVCORR 01250508 |
| 0011 CONTINUE 01260508 |
| CT002* TEST 2 2 CHARACTER VARIABLE 01270508 |
| IVTNUM = 2 01280508 |
| IVCOMP = 0 01290508 |
| IF (D2XVK.EQ.'GH') IVCOMP = 1 01300508 |
| IF (IVCOMP - 1) 20020, 10020, 20020 01310508 |
| 10020 IVPASS = IVPASS + 1 01320508 |
| WRITE (NUVI, 80002) IVTNUM 01330508 |
| GO TO 0021 01340508 |
| 20020 IVFAIL = IVFAIL + 1 01350508 |
| CVCORR = 'GH' 01360508 |
| WRITE (NUVI, 80018) IVTNUM, D2XVK, CVCORR 01370508 |
| 0021 CONTINUE 01380508 |
| CT003* TEST 3 5 CHARACTER VARIABLE 01390508 |
| IVTNUM = 3 01400508 |
| IVCOMP = 0 01410508 |
| IF (E5XVK.EQ.'LONGS') IVCOMP = 1 01420508 |
| IF (IVCOMP - 1) 20030, 10030, 20030 01430508 |
| 10030 IVPASS = IVPASS + 1 01440508 |
| WRITE (NUVI, 80002) IVTNUM 01450508 |
| GO TO 0031 01460508 |
| 20030 IVFAIL = IVFAIL + 1 01470508 |
| CVCORR = 'LONGS' 01480508 |
| WRITE (NUVI, 80018) IVTNUM, E5XVK, CVCORR 01490508 |
| 0031 CONTINUE 01500508 |
| CT004* TEST 4 3 CHARACTER VARIABLE 01510508 |
| IVTNUM = 4 01520508 |
| IVCOMP = 0 01530508 |
| IF (F3XVK.EQ.'END') IVCOMP = 1 01540508 |
| IF (IVCOMP - 1) 20040, 10040, 20040 01550508 |
| 10040 IVPASS = IVPASS + 1 01560508 |
| WRITE (NUVI, 80002) IVTNUM 01570508 |
| GO TO 0041 01580508 |
| 20040 IVFAIL = IVFAIL + 1 01590508 |
| CVCORR = 'END' 01600508 |
| WRITE (NUVI, 80018) IVTNUM, F3XVK, CVCORR 01610508 |
| 0041 CONTINUE 01620508 |
| C***** 01630508 |
| CBB** ********************** BBCSUM0 **********************************01640508 |
| C**** WRITE OUT TEST SUMMARY 01650508 |
| C**** 01660508 |
| IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01670508 |
| WRITE (I02, 90004) 01680508 |
| WRITE (I02, 90014) 01690508 |
| WRITE (I02, 90004) 01700508 |
| WRITE (I02, 90020) IVPASS 01710508 |
| WRITE (I02, 90022) IVFAIL 01720508 |
| WRITE (I02, 90024) IVDELE 01730508 |
| WRITE (I02, 90026) IVINSP 01740508 |
| WRITE (I02, 90028) IVTOTN, IVTOTL 01750508 |
| CBE** ********************** BBCSUM0 **********************************01760508 |
| CBB** ********************** BBCFOOT0 **********************************01770508 |
| C**** WRITE OUT REPORT FOOTINGS 01780508 |
| C**** 01790508 |
| WRITE (I02,90016) ZPROG, ZPROG 01800508 |
| WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 01810508 |
| WRITE (I02,90019) 01820508 |
| CBE** ********************** BBCFOOT0 **********************************01830508 |
| CBB** ********************** BBCFMT0A **********************************01840508 |
| C**** FORMATS FOR TEST DETAIL LINES 01850508 |
| C**** 01860508 |
| 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 01870508 |
| 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 01880508 |
| 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 01890508 |
| 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 01900508 |
| 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 01910508 |
| 1I6,/," ",15X,"CORRECT= " ,I6) 01920508 |
| 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01930508 |
| 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 01940508 |
| 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01950508 |
| 1A21,/," ",16X,"CORRECT= " ,A21) 01960508 |
| 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 01970508 |
| 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 01980508 |
| 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 01990508 |
| 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02000508 |
| 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02010508 |
| 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02020508 |
| 80050 FORMAT (" ",48X,A31) 02030508 |
| CBE** ********************** BBCFMT0A **********************************02040508 |
| CBB** ********************** BBCFMAT1 **********************************02050508 |
| C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02060508 |
| C**** 02070508 |
| 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02080508 |
| 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02090508 |
| 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02100508 |
| 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02110508 |
| 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02120508 |
| 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02130508 |
| 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02140508 |
| 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02150508 |
| 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02160508 |
| 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02170508 |
| 2"(",F12.5,", ",F12.5,")") 02180508 |
| CBE** ********************** BBCFMAT1 **********************************02190508 |
| CBB** ********************** BBCFMT0B **********************************02200508 |
| C**** FORMAT STATEMENTS FOR PAGE HEADERS 02210508 |
| C**** 02220508 |
| 90002 FORMAT ("1") 02230508 |
| 90004 FORMAT (" ") 02240508 |
| 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02250508 |
| 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02260508 |
| 90008 FORMAT (" ",21X,A13,A17) 02270508 |
| 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02280508 |
| 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02290508 |
| 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02300508 |
| 1 7X,"REMARKS",24X) 02310508 |
| 90014 FORMAT (" ","----------------------------------------------" , 02320508 |
| 1 "---------------------------------" ) 02330508 |
| 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02340508 |
| C**** 02350508 |
| C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02360508 |
| C**** 02370508 |
| 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02380508 |
| 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02390508 |
| 1 A13) 02400508 |
| 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02410508 |
| C**** 02420508 |
| C**** FORMAT STATEMENTS FOR RUN SUMMARY 02430508 |
| C**** 02440508 |
| 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02450508 |
| 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02460508 |
| 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02470508 |
| 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02480508 |
| 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02490508 |
| CBE** ********************** BBCFMT0B **********************************02500508 |
| C***** 02510508 |
| END 02520508 |
