| PROGRAM FM261 |
| |
| C***********************************************************************00010261 |
| C***** FORTRAN 77 00020261 |
| C***** FM261 00030261 |
| C***** BLKIF4 - (303) 00040261 |
| C***** THIS PROGRAM CALLS SUBROUTINES SN262, SN263 AND INTEGER 00050261 |
| C FUNCTION IF264 00060261 |
| C***********************************************************************00070261 |
| C***** GENERAL PURPOSE SUBSET REF 00080261 |
| C***** TEST BLOCK IF STATEMENTS 11.6 - 11.900090261 |
| C***** WITH SUBROUTINE CALLS 15.6 00100261 |
| C***** USES SUBROUTINES SN262 (750), SN263 (751) 00110261 |
| C***** AND FUNCTION IF264 (752) 00120261 |
| CBB** ********************** BBCCOMNT **********************************00130261 |
| C**** 00140261 |
| C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150261 |
| C**** VERSION 2.1 00160261 |
| C**** 00170261 |
| C**** 00180261 |
| C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190261 |
| C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200261 |
| C**** SOFTWARE STANDARDS VALIDATION GROUP 00210261 |
| C**** BUILDING 225 RM A266 00220261 |
| C**** GAITHERSBURG, MD 20899 00230261 |
| C**** 00240261 |
| C**** 00250261 |
| C**** 00260261 |
| CBE** ********************** BBCCOMNT **********************************00270261 |
| CBB** ********************** BBCINITA **********************************00280261 |
| C**** SPECIFICATION STATEMENTS 00290261 |
| C**** 00300261 |
| CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310261 |
| 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320261 |
| CBE** ********************** BBCINITA **********************************00330261 |
| CBB** ********************** BBCINITB **********************************00340261 |
| C**** INITIALIZE SECTION 00350261 |
| DATA ZVERS, ZVERSD, ZDATE 00360261 |
| 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370261 |
| DATA ZCOMPL, ZNAME, ZTAPE 00380261 |
| 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390261 |
| DATA ZPROJ, ZTAPED, ZPROG 00400261 |
| 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410261 |
| DATA REMRKS /' '/ 00420261 |
| C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430261 |
| C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440261 |
| C**** 00450261 |
| CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460261 |
| CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470261 |
| CZ03 ZPROG = 'PROGRAM NAME' 00480261 |
| CZ04 ZDATE = 'DATE OF TEST' 00490261 |
| CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500261 |
| CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510261 |
| CZ07 ZNAME = 'NAME OF USER' 00520261 |
| CZ08 ZTAPE = 'TAPE OWNER/ID' 00530261 |
| CZ09 ZTAPED = 'DATE TAPE COPIED' 00540261 |
| C 00550261 |
| IVPASS = 0 00560261 |
| IVFAIL = 0 00570261 |
| IVDELE = 0 00580261 |
| IVINSP = 0 00590261 |
| IVTOTL = 0 00600261 |
| IVTOTN = 0 00610261 |
| ICZERO = 0 00620261 |
| C 00630261 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640261 |
| I01 = 05 00650261 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660261 |
| I02 = 06 00670261 |
| C 00680261 |
| CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690261 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700261 |
| CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710261 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720261 |
| C 00730261 |
| CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740261 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750261 |
| CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760261 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770261 |
| C 00780261 |
| CBE** ********************** BBCINITB **********************************00790261 |
| NUVI = I02 00800261 |
| ZPROG = 'FM261' 00810261 |
| CBB** ********************** BBCHED0A **********************************00820261 |
| C**** 00830261 |
| C**** WRITE REPORT TITLE 00840261 |
| C**** 00850261 |
| WRITE (I02, 90002) 00860261 |
| WRITE (I02, 90006) 00870261 |
| WRITE (I02, 90007) 00880261 |
| WRITE (I02, 90008) ZVERS, ZVERSD 00890261 |
| WRITE (I02, 90009) ZPROG, ZPROG 00900261 |
| WRITE (I02, 90010) ZDATE, ZCOMPL 00910261 |
| CBE** ********************** BBCHED0A **********************************00920261 |
| C***** TOTAL NUMBER OF EXPECTED TESTS 00930261 |
| IVTOTL = 2 00940261 |
| C***** HEADER FOR SEGMENT 303 00950261 |
| WRITE(NUVI,30300) 00960261 |
| 30300 FORMAT(" ",/" BLKIF4 - (303) BLOCK IF" // 00970261 |
| 1 " BLOCK IF WITH SUBPROGRAM CALL" // 00980261 |
| 2 " SUBSET REF. 11.6 - 11.9, 15.6" ) 00990261 |
| CBB** ********************** BBCHED0B **********************************01000261 |
| C**** WRITE DETAIL REPORT HEADERS 01010261 |
| C**** 01020261 |
| WRITE (I02,90004) 01030261 |
| WRITE (I02,90004) 01040261 |
| WRITE (I02,90013) 01050261 |
| WRITE (I02,90014) 01060261 |
| WRITE (I02,90015) IVTOTL 01070261 |
| CBE** ********************** BBCHED0B **********************************01080261 |
| C***** 01090261 |
| WRITE (NUVI, 30325) 01100261 |
| CT001* TEST 1 BLOCK IF WITH SUBROUTINE CALLS 01110261 |
| IVTNUM = 1 01120261 |
| IVINSP = IVINSP + 1 01130261 |
| WRITE (NUVI, 80004) IVTNUM 01140261 |
| IVI = 3 01150261 |
| CALL SN262 (IVI) 01160261 |
| IF (IVI .GT. 0) THEN 01170261 |
| CALL SN262 (IVI) 01180261 |
| ELSE 01190261 |
| CALL SN263 (IVI) 01200261 |
| ENDIF 01210261 |
| LVI = 7 - IVI 01220261 |
| WRITE (NUVI, 30301) LVI 01230261 |
| C***** CONTINUE 01240261 |
| CT002* TEST 2 CALL OF FUNCTION CONTAINING BLOCK IF 01250261 |
| IVTNUM = 2 01260261 |
| IVINSP = IVINSP + 1 01270261 |
| WRITE (NUVI, 80004) IVTNUM 01280261 |
| IVI = 7 01290261 |
| IVI = IF264 (IVI .GT. 0) 01300261 |
| LVI = 8 - IVI 01310261 |
| WRITE (NUVI, 30301) LVI 01320261 |
| IVI = IF264 (LVI .NE. 0) 01330261 |
| LVI = 6 - IVI 01340261 |
| WRITE (NUVI, 30301) LVI 01350261 |
| C***** 01360261 |
| 30325 FORMAT (/49X,'TEST 1 (1 COMPUTED RESULT)'/ 01370261 |
| 1 49X,'TEST 2 (2 COMPUTED RESULTS)'/ 01380261 |
| 2 49X,'ALL ANSWERS SHOULD BE ZERO') 01390261 |
| 30301 FORMAT (" ",26X,I10) 01400261 |
| C***** 01410261 |
| CBB** ********************** BBCSUM0 **********************************01420261 |
| C**** WRITE OUT TEST SUMMARY 01430261 |
| C**** 01440261 |
| IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01450261 |
| WRITE (I02, 90004) 01460261 |
| WRITE (I02, 90014) 01470261 |
| WRITE (I02, 90004) 01480261 |
| WRITE (I02, 90020) IVPASS 01490261 |
| WRITE (I02, 90022) IVFAIL 01500261 |
| WRITE (I02, 90024) IVDELE 01510261 |
| WRITE (I02, 90026) IVINSP 01520261 |
| WRITE (I02, 90028) IVTOTN, IVTOTL 01530261 |
| CBE** ********************** BBCSUM0 **********************************01540261 |
| CBB** ********************** BBCFOOT0 **********************************01550261 |
| C**** WRITE OUT REPORT FOOTINGS 01560261 |
| C**** 01570261 |
| WRITE (I02,90016) ZPROG, ZPROG 01580261 |
| WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 01590261 |
| WRITE (I02,90019) 01600261 |
| CBE** ********************** BBCFOOT0 **********************************01610261 |
| CBB** ********************** BBCFMT0A **********************************01620261 |
| C**** FORMATS FOR TEST DETAIL LINES 01630261 |
| C**** 01640261 |
| 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 01650261 |
| 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 01660261 |
| 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 01670261 |
| 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 01680261 |
| 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 01690261 |
| 1I6,/," ",15X,"CORRECT= " ,I6) 01700261 |
| 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01710261 |
| 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 01720261 |
| 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01730261 |
| 1A21,/," ",16X,"CORRECT= " ,A21) 01740261 |
| 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 01750261 |
| 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 01760261 |
| 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 01770261 |
| 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 01780261 |
| 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 01790261 |
| 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 01800261 |
| 80050 FORMAT (" ",48X,A31) 01810261 |
| CBE** ********************** BBCFMT0A **********************************01820261 |
| CBB** ********************** BBCFMT0B **********************************01830261 |
| C**** FORMAT STATEMENTS FOR PAGE HEADERS 01840261 |
| C**** 01850261 |
| 90002 FORMAT ("1") 01860261 |
| 90004 FORMAT (" ") 01870261 |
| 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )01880261 |
| 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 01890261 |
| 90008 FORMAT (" ",21X,A13,A17) 01900261 |
| 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 01910261 |
| 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 01920261 |
| 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 01930261 |
| 1 7X,"REMARKS",24X) 01940261 |
| 90014 FORMAT (" ","----------------------------------------------" , 01950261 |
| 1 "---------------------------------" ) 01960261 |
| 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 01970261 |
| C**** 01980261 |
| C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 01990261 |
| C**** 02000261 |
| 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02010261 |
| 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02020261 |
| 1 A13) 02030261 |
| 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02040261 |
| C**** 02050261 |
| C**** FORMAT STATEMENTS FOR RUN SUMMARY 02060261 |
| C**** 02070261 |
| 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02080261 |
| 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02090261 |
| 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02100261 |
| 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02110261 |
| 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02120261 |
| CBE** ********************** BBCFMT0B **********************************02130261 |
| C***** END OF TEST SEGMENT 303 02140261 |
| STOP 02150261 |
| END 02160261 |
| |
| C***********************************************************************00010262 |
| C***** FORTRAN 77 00020262 |
| C***** FM262 00030262 |
| C***** SN262 SN262 - (750) 00040262 |
| C***** SUBROUTINE CALLED BY FM261 00050262 |
| C***********************************************************************00060262 |
| C***** 00070262 |
| SUBROUTINE SN262 (IWVI) 00080262 |
| C***** 00090262 |
| IWVI = IWVI + 2 00100262 |
| C***** 00110262 |
| RETURN 00120262 |
| END 00130262 |
| |
| C***********************************************************************00010263 |
| C***** FORTRAN 77 00020263 |
| C***** FM263 00030263 |
| C***** SN263 SN263 - (751) 00040263 |
| C***** SUBROUTINE CALLED BY FM261 00050263 |
| C***********************************************************************00060263 |
| C***** 00070263 |
| SUBROUTINE SN263 (IWVI) 00080263 |
| C***** 00090263 |
| IWVI = IWVI * (-10) 00100263 |
| C***** 00110263 |
| RETURN 00120263 |
| END 00130263 |
| |
| C***********************************************************************00010264 |
| C***** FORTRAN 77 00020264 |
| C***** FM264 00030264 |
| C***** IF264 IF264 - (752) 00040264 |
| C***** INTEGER FUNCTION CALLED BY FM261 00050264 |
| C***********************************************************************00060264 |
| C***** 00070264 |
| INTEGER FUNCTION IF264 (AWVB) 00080264 |
| LOGICAL AWVB 00090264 |
| C***** 00100264 |
| IF (AWVB) THEN 00110264 |
| IF264 = 8 00120264 |
| RETURN 00130264 |
| ELSE 00140264 |
| IF264 = 6 00150264 |
| ENDIF 00160264 |
| C***** 00170264 |
| RETURN 00180264 |
| END 00190264 |
