| PROGRAM FM802 |
| |
| C***********************************************************************00010802 |
| C***** FORTRAN 77 00020802 |
| C***** FM802 YDABS - (157) 00030802 |
| C***** 00040802 |
| C***********************************************************************00050802 |
| C***** GENERAL PURPOSE ANS REF 00060802 |
| C***** TEST INTRINSIC FUNCTION DABS (ABSOLUTE VALUE OF 15.3 00070802 |
| C***** A DOUBLE PRECISION ARGUMENT) (TABLE 5)00080802 |
| CBB** ********************** BBCCOMNT **********************************00090802 |
| C**** 00100802 |
| C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00110802 |
| C**** VERSION 2.1 00120802 |
| C**** 00130802 |
| C**** 00140802 |
| C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00150802 |
| C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00160802 |
| C**** SOFTWARE STANDARDS VALIDATION GROUP 00170802 |
| C**** BUILDING 225 RM A266 00180802 |
| C**** GAITHERSBURG, MD 20899 00190802 |
| C**** 00200802 |
| C**** 00210802 |
| C**** 00220802 |
| CBE** ********************** BBCCOMNT **********************************00230802 |
| C***** 00240802 |
| C***** S P E C I F I C A T I O N S SEGMENT 157 00250802 |
| DOUBLE PRECISION DOAVD, DOBVD, DODVD, DOEVD, DVCORR 00260802 |
| C***** 00270802 |
| CBB** ********************** BBCINITA **********************************00280802 |
| C**** SPECIFICATION STATEMENTS 00290802 |
| C**** 00300802 |
| CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310802 |
| 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320802 |
| CBE** ********************** BBCINITA **********************************00330802 |
| CBB** ********************** BBCINITB **********************************00340802 |
| C**** INITIALIZE SECTION 00350802 |
| DATA ZVERS, ZVERSD, ZDATE 00360802 |
| 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370802 |
| DATA ZCOMPL, ZNAME, ZTAPE 00380802 |
| 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390802 |
| DATA ZPROJ, ZTAPED, ZPROG 00400802 |
| 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410802 |
| DATA REMRKS /' '/ 00420802 |
| C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430802 |
| C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440802 |
| C**** 00450802 |
| CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460802 |
| CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470802 |
| CZ03 ZPROG = 'PROGRAM NAME' 00480802 |
| CZ04 ZDATE = 'DATE OF TEST' 00490802 |
| CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500802 |
| CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510802 |
| CZ07 ZNAME = 'NAME OF USER' 00520802 |
| CZ08 ZTAPE = 'TAPE OWNER/ID' 00530802 |
| CZ09 ZTAPED = 'DATE TAPE COPIED' 00540802 |
| C 00550802 |
| IVPASS = 0 00560802 |
| IVFAIL = 0 00570802 |
| IVDELE = 0 00580802 |
| IVINSP = 0 00590802 |
| IVTOTL = 0 00600802 |
| IVTOTN = 0 00610802 |
| ICZERO = 0 00620802 |
| C 00630802 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640802 |
| I01 = 05 00650802 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660802 |
| I02 = 06 00670802 |
| C 00680802 |
| CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690802 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700802 |
| CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710802 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720802 |
| C 00730802 |
| CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740802 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750802 |
| CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760802 |
| C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770802 |
| C 00780802 |
| CBE** ********************** BBCINITB **********************************00790802 |
| NUVI = I02 00800802 |
| IVTOTL = 6 00810802 |
| ZPROG = 'FM802' 00820802 |
| CBB** ********************** BBCHED0A **********************************00830802 |
| C**** 00840802 |
| C**** WRITE REPORT TITLE 00850802 |
| C**** 00860802 |
| WRITE (I02, 90002) 00870802 |
| WRITE (I02, 90006) 00880802 |
| WRITE (I02, 90007) 00890802 |
| WRITE (I02, 90008) ZVERS, ZVERSD 00900802 |
| WRITE (I02, 90009) ZPROG, ZPROG 00910802 |
| WRITE (I02, 90010) ZDATE, ZCOMPL 00920802 |
| CBE** ********************** BBCHED0A **********************************00930802 |
| C***** 00940802 |
| C***** HEADER FOR SEGMENT 157 WRITTEN 00950802 |
| WRITE (NUVI,15701) 00960802 |
| 15701 FORMAT (" "//1X,"YDABS - (157) INTRINSIC FUNCTION--" //16X, 00970802 |
| 1 "DABS (ABSOLUTE VALUE ) " // 2X, 00980802 |
| 2 "ANS REF. - 15.3" ) 00990802 |
| CBB** ********************** BBCHED0B **********************************01000802 |
| C**** WRITE DETAIL REPORT HEADERS 01010802 |
| C**** 01020802 |
| WRITE (I02,90004) 01030802 |
| WRITE (I02,90004) 01040802 |
| WRITE (I02,90013) 01050802 |
| WRITE (I02,90014) 01060802 |
| WRITE (I02,90015) IVTOTL 01070802 |
| CBE** ********************** BBCHED0B **********************************01080802 |
| C***** 01090802 |
| CT001* TEST 1 THE VALUE ZERO 01100802 |
| IVTNUM = 1 01110802 |
| DOBVD = 0.0D0 01120802 |
| DOAVD = DABS(DOBVD) 01130802 |
| IF (DOAVD + 5.0D-10) 20010, 10010, 40010 01140802 |
| 40010 IF (DOAVD - 5.0D-10) 10010, 10010, 20010 01150802 |
| 10010 IVPASS = IVPASS + 1 01160802 |
| WRITE (NUVI, 80002) IVTNUM 01170802 |
| GO TO 0011 01180802 |
| 20010 IVFAIL = IVFAIL + 1 01190802 |
| DVCORR = 0.0D0 01200802 |
| WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01210802 |
| 0011 CONTINUE 01220802 |
| CT002* TEST 2 ZERO PREFIXED WITH A MINUS SIGN 01230802 |
| IVTNUM = 2 01240802 |
| DOBVD = 0.0D0 01250802 |
| DOAVD = DABS(-DOBVD) 01260802 |
| IF (DOAVD + 5.0D-10) 20020, 10020, 40020 01270802 |
| 40020 IF (DOAVD - 5.0D-10) 10020, 10020, 20020 01280802 |
| 10020 IVPASS = IVPASS + 1 01290802 |
| WRITE (NUVI, 80002) IVTNUM 01300802 |
| GO TO 0021 01310802 |
| 20020 IVFAIL = IVFAIL + 1 01320802 |
| DVCORR = 0.0D1 01330802 |
| WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01340802 |
| 0021 CONTINUE 01350802 |
| CT003* TEST 3 A POSITIVE NON-INTEGRAL VALUE 01360802 |
| IVTNUM = 3 01370802 |
| DOBVD = 0.35875D2 01380802 |
| DOAVD = DABS(DOBVD) 01390802 |
| IF (DOAVD - 0.3587499998D2) 20030, 10030, 40030 01400802 |
| 40030 IF (DOAVD - 0.3587500002D2) 10030, 10030, 20030 01410802 |
| 10030 IVPASS = IVPASS + 1 01420802 |
| WRITE (NUVI, 80002) IVTNUM 01430802 |
| GO TO 0031 01440802 |
| 20030 IVFAIL = IVFAIL + 1 01450802 |
| DVCORR = 0.35875D2 01460802 |
| WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01470802 |
| 0031 CONTINUE 01480802 |
| CT004* TEST 4 A NEGATIVE NON-INTEGRAL VALUE 01490802 |
| IVTNUM = 4 01500802 |
| DOBVD = -0.35875D2 01510802 |
| DOAVD = DABS(DOBVD) 01520802 |
| IF (DOAVD - 0.3587499998D2) 20040, 10040, 40040 01530802 |
| 40040 IF (DOAVD - 0.3587500002D2) 10040, 10040, 20040 01540802 |
| 10040 IVPASS = IVPASS + 1 01550802 |
| WRITE (NUVI, 80002) IVTNUM 01560802 |
| GO TO 0041 01570802 |
| 20040 IVFAIL = IVFAIL + 1 01580802 |
| DVCORR = 0.35875D2 01590802 |
| WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01600802 |
| 0041 CONTINUE 01610802 |
| CT005* TEST 5 A POSITIVE INTEGRAL VALUE 01620802 |
| IVTNUM = 5 01630802 |
| DOBVD = 7.0D1 01640802 |
| DOAVD = DABS(DOBVD) 01650802 |
| IF (DOAVD - 6.999999996D1) 20050, 10050, 40050 01660802 |
| 40050 IF (DOAVD - 7.000000004D1) 10050, 10050, 20050 01670802 |
| 10050 IVPASS = IVPASS + 1 01680802 |
| WRITE (NUVI, 80002) IVTNUM 01690802 |
| GO TO 0051 01700802 |
| 20050 IVFAIL = IVFAIL + 1 01710802 |
| DVCORR = 7.0D1 01720802 |
| WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01730802 |
| 0051 CONTINUE 01740802 |
| CT006* TEST 6 ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 01750802 |
| IVTNUM = 6 01760802 |
| DODVD = 2.625D0 01770802 |
| DOEVD = 3.0D0 01780802 |
| DOAVD = DABS((-DODVD) - DOEVD ** 3) 01790802 |
| IF (DOAVD - 29.62499998D0) 20060, 10060, 40060 01800802 |
| 40060 IF (DOAVD - 29.62500002D0) 10060, 10060, 20060 01810802 |
| 10060 IVPASS = IVPASS + 1 01820802 |
| WRITE (NUVI, 80002) IVTNUM 01830802 |
| GO TO 0061 01840802 |
| 20060 IVFAIL = IVFAIL + 1 01850802 |
| DVCORR = 29.625D0 01860802 |
| WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01870802 |
| 0061 CONTINUE 01880802 |
| C***** 01890802 |
| CBB** ********************** BBCSUM0 **********************************01900802 |
| C**** WRITE OUT TEST SUMMARY 01910802 |
| C**** 01920802 |
| IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01930802 |
| WRITE (I02, 90004) 01940802 |
| WRITE (I02, 90014) 01950802 |
| WRITE (I02, 90004) 01960802 |
| WRITE (I02, 90020) IVPASS 01970802 |
| WRITE (I02, 90022) IVFAIL 01980802 |
| WRITE (I02, 90024) IVDELE 01990802 |
| WRITE (I02, 90026) IVINSP 02000802 |
| WRITE (I02, 90028) IVTOTN, IVTOTL 02010802 |
| CBE** ********************** BBCSUM0 **********************************02020802 |
| CBB** ********************** BBCFOOT0 **********************************02030802 |
| C**** WRITE OUT REPORT FOOTINGS 02040802 |
| C**** 02050802 |
| WRITE (I02,90016) ZPROG, ZPROG 02060802 |
| WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02070802 |
| WRITE (I02,90019) 02080802 |
| CBE** ********************** BBCFOOT0 **********************************02090802 |
| CBB** ********************** BBCFMT0A **********************************02100802 |
| C**** FORMATS FOR TEST DETAIL LINES 02110802 |
| C**** 02120802 |
| 80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02130802 |
| 80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02140802 |
| 80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02150802 |
| 80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02160802 |
| 80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02170802 |
| 1I6,/," ",15X,"CORRECT= " ,I6) 02180802 |
| 80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02190802 |
| 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02200802 |
| 80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02210802 |
| 1A21,/," ",16X,"CORRECT= " ,A21) 02220802 |
| 80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02230802 |
| 80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02240802 |
| 80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02250802 |
| 80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02260802 |
| 80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02270802 |
| 80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02280802 |
| 80050 FORMAT (" ",48X,A31) 02290802 |
| CBE** ********************** BBCFMT0A **********************************02300802 |
| CBB** ********************** BBCFMAT1 **********************************02310802 |
| C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02320802 |
| C**** 02330802 |
| 80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02340802 |
| 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02350802 |
| 80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02360802 |
| 80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02370802 |
| 80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02380802 |
| 80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02390802 |
| 80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02400802 |
| 80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02410802 |
| 80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02420802 |
| 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02430802 |
| 2"(",F12.5,", ",F12.5,")") 02440802 |
| CBE** ********************** BBCFMAT1 **********************************02450802 |
| CBB** ********************** BBCFMT0B **********************************02460802 |
| C**** FORMAT STATEMENTS FOR PAGE HEADERS 02470802 |
| C**** 02480802 |
| 90002 FORMAT ("1") 02490802 |
| 90004 FORMAT (" ") 02500802 |
| 90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02510802 |
| 90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02520802 |
| 90008 FORMAT (" ",21X,A13,A17) 02530802 |
| 90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02540802 |
| 90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02550802 |
| 90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02560802 |
| 1 7X,"REMARKS",24X) 02570802 |
| 90014 FORMAT (" ","----------------------------------------------" , 02580802 |
| 1 "---------------------------------" ) 02590802 |
| 90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02600802 |
| C**** 02610802 |
| C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02620802 |
| C**** 02630802 |
| 90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02640802 |
| 90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02650802 |
| 1 A13) 02660802 |
| 90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02670802 |
| C**** 02680802 |
| C**** FORMAT STATEMENTS FOR RUN SUMMARY 02690802 |
| C**** 02700802 |
| 90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02710802 |
| 90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02720802 |
| 90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02730802 |
| 90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02740802 |
| 90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02750802 |
| CBE** ********************** BBCFMT0B **********************************02760802 |
| C***** 02770802 |
| C***** END OF TEST SEGMENT 157 02780802 |
| STOP 02790802 |
| END 02800802 |
| 02810802 |